Subversion Repositories gelsvn

Rev

Rev 107 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 107 Rev 217
Line 9... Line 9...
9 
# ************************************************************
 9 
# ************************************************************
10 
# Pragmas
 10 
# Pragmas
11 
# ************************************************************
 11 
# ************************************************************
12 
 
 12 
 
13 
use strict;
 13 
use strict;
14 
use File::Basename;
 - 
 
15 
 
 14 
 
16 
use Options;
 15 
use Options;
17 
use Parser;
 16 
use Parser;
18 
use Version;
 17 
use Version;
19 
 
 18 
 
Line 39... Line 38...
39 
  my($name)     = shift;
 38 
  my($name)     = shift;
40 
  my(@creators) = @_;
 39 
  my(@creators) = @_;
41 
  my($self)     = $class->SUPER::new();
 40 
  my($self)     = $class->SUPER::new();
42 
 
 41 
 
43 
  $self->{'path'}     = $path;
 42 
  $self->{'path'}     = $path;
- 
 
 43 
  $self->{'basepath'} = ::getBasePath();
44 
  $self->{'name'}     = $name;
 44 
  $self->{'name'}     = $name;
45 
  $self->{'types'}    = {};
 45 
  $self->{'types'}    = {};
46 
  $self->{'creators'} = \@creators;
 46 
  $self->{'creators'} = \@creators;
47 
  $self->{'default'}  = $creators[0];
 47 
  $self->{'default'}  = $creators[0];
48 
  $self->{'reldefs'}  = {};
 48 
  $self->{'reldefs'}  = {};
Line 50... Line 50...
50 
 
 50 
 
51 
  return $self;
 51 
  return $self;
52 
}
 52 
}
53 
 
 53 
 
54 
 
 54 
 
55 
sub convert_slashes {
 - 
 
56 
  #my($self) = shift;
 - 
 
57 
  return 0;
 - 
 
58 
}
 - 
 
59 
 
 - 
 
60 
 
 - 
 
61 
sub parse_line {
 55 
sub parse_line {
62 
  my($self)        = shift;
 56 
  my($self)        = shift;
63 
  my($ih)          = shift;
 57 
  my($ih)          = shift;
64 
  my($line)        = shift;
 58 
  my($line)        = shift;
65 
  my($status)      = 1;
 59 
  my($status)      = 1;
Line 72... Line 66...
72 
    my($value) = $3;
 66 
    my($value) = $3;
73 
    if (defined $value) {
 67 
    if (defined $value) {
74 
      $value =~ s/^\s+//;
 68 
      $value =~ s/^\s+//;
75 
      $value =~ s/\s+$//;
 69 
      $value =~ s/\s+$//;
76 
    }
 70 
    }
77 
    if ($name =~ /\*/) {
 71 
    if ($name =~ s/\*/.*/g) {
78 
      $name =~ s/\*/.*/g;
 - 
 
79 
      foreach my $key (keys %ENV) {
 72 
      foreach my $key (keys %ENV) {
80 
        if ($key =~ /^$name$/ && !exists $self->{'reldefs'}->{$key}) {
 73 
        if ($key =~ /^$name$/ && !exists $self->{'reldefs'}->{$key}) {
81 
          ## Put this value at the front since it doesn't need
 74 
          ## Put this value at the front since it doesn't need
82 
          ## to be built up from anything else.  It is a stand-alone
 75 
          ## to be built up from anything else.  It is a stand-alone
83 
          ## relative definition.
 76 
          ## relative definition.
Line 196... Line 189...
196 
      }
 189 
      }
197 
    }
 190 
    }
198 
  }
 191 
  }
199 
 
 192 
 
200 
  ## Set the global feature file
 193 
  ## Set the global feature file
- 
 
 194 
  my($cgf) = '/config/global.features';
201 
  my($global_feature_file) = $self->{'path'} . '/config/global.features';
 195 
  my($global_feature_file) = (defined $options->{'gfeature_file'} &&
- 
 
 196 
                              -r $options->{'gfeature_file'} ?
- 
 
 197 
                                 $options->{'gfeature_file'} :
- 
 
 198 
                                 -r $self->{'path'} . $cgf ?
- 
 
 199 
                                    $self->{'path'} . $cgf :
- 
 
 200 
                                    $self->{'basepath'} . $cgf
- 
 
 201 
                                 );
202 
 
 202 
 
203 
  ## Set up default values
 203 
  ## Set up default values
204 
  if (!defined $options->{'input'}->[0]) {
 204 
  if (!defined $options->{'input'}->[0]) {
205 
    push(@{$options->{'input'}}, '');
 205 
    push(@{$options->{'input'}}, '');
206 
  }
 206 
  }
207 
  if (!defined $options->{'feature_file'}) {
 207 
  if (!defined $options->{'feature_file'}) {
208 
    my($feature_file) = $self->{'path'} . '/config/default.features';
 208 
    my($cdf) = '/config/default.features';
209 
    if (-r $feature_file) {
 209 
    $options->{'feature_file'} = (-r $self->{'path'} . $cdf ?
- 
 
 210 
                                     $self->{'path'} . $cdf :
- 
 
 211 
                                     -r $self->{'basepath'} . $cdf ?
- 
 
 212 
                                        $self->{'basepath'} . $cdf :
210 
      $options->{'feature_file'} = $feature_file;
 213 
                                        undef);
211 
    }
 - 
 
212 
  }
 214 
  }
213 
  if (!defined $options->{'global'}) {
 215 
  if (!defined $options->{'global'}) {
214 
    my($global) = $self->{'path'} . '/config/global.mpb';
 216 
    my($cgm) = '/config/global.mpb';
215 
    if (-r $global) {
 217 
    $options->{'global'} = (-r $self->{'path'} . $cgm ?
- 
 
 218 
                                     $self->{'path'} . $cgm :
- 
 
 219 
                                     -r $self->{'basepath'} . $cgm ?
- 
 
 220 
                                        $self->{'basepath'} . $cgm :
216 
      $options->{'global'} = $global;
 221 
                                        undef);
217 
    }
 - 
 
218 
  }
 222 
  }
219 
  ## Save the original directory outside of the loop
 223 
  ## Save the original directory outside of the loop
220 
  ## to avoid calling it multiple times.
 224 
  ## to avoid calling it multiple times.
221 
  my($orig_dir) = $self->getcwd();
 225 
  my($orig_dir) = $self->getcwd();
222 
 
 226 
 
Line 225... Line 229...
225 
  unshift(@{$options->{'include'}}, $self->{'path'} . '/templates');
 229 
  unshift(@{$options->{'include'}}, $self->{'path'} . '/templates');
226 
  unshift(@{$options->{'include'}}, $self->{'path'} . '/config');
 230 
  unshift(@{$options->{'include'}}, $self->{'path'} . '/config');
227 
 
 231 
 
228 
  if ($options->{'reldefs'}) {
 232 
  if ($options->{'reldefs'}) {
229 
    ## Only try to read the file if it exists
 233 
    ## Only try to read the file if it exists
230 
    my($rel) = $self->{'path'} . '/config/default.rel';
 234 
    my($cdr) = '/config/default.rel';
- 
 
 235 
    my($rel) = (-r $self->{'path'} . $cdr ?
- 
 
 236 
                   $self->{'path'} . $cdr :
- 
 
 237 
                   -r $self->{'basepath'} . $cdr ?
- 
 
 238 
                      $self->{'basepath'} . $cdr :
- 
 
 239 
                      undef);
231 
    if (-r $rel) {
 240 
    if (defined $rel) {
232 
      my($srel, $errorString) = $self->read_file($rel);
 241 
      my($srel, $errorString) = $self->read_file($rel);
233 
      if (!$srel) {
 242 
      if (!$srel) {
234 
        $self->error("$errorString\nin $rel");
 243 
        $self->error("$errorString\nin $rel");
235 
        return 1;
 244 
        return 1;
236 
      }
 245 
      }
Line 276... Line 285...
276 
  ## Generate the files
 285 
  ## Generate the files
277 
  my($status) = 0;
 286 
  my($status) = 0;
278 
  foreach my $cfile (@{$options->{'input'}}) {
 287 
  foreach my $cfile (@{$options->{'input'}}) {
279 
    ## To correctly reference any pathnames in the input file, chdir to
 288 
    ## To correctly reference any pathnames in the input file, chdir to
280 
    ## its directory if there's any directory component to the specified path.
 289 
    ## its directory if there's any directory component to the specified path.
281 
    my($base) = basename($cfile);
 290 
    my($base) = ($cfile eq '' ? '' : $self->mpc_basename($cfile));
282 
 
 291 
 
283 
    if (-d $cfile) {
 292 
    if (-d $cfile) {
284 
      $base = '';
 293 
      $base = '';
285 
    }
 294 
    }
286 
 
 295 
 
Line 331... Line 340...
331 
        $diag .= 'default input';
 340 
        $diag .= 'default input';
332 
      }
 341 
      }
333 
      else {
 342 
      else {
334 
        my($partial)  = $self->getcwd();
 343 
        my($partial)  = $self->getcwd();
335 
        my($oescaped) = $self->escape_regex_special($orig_dir) . '(/)?';
 344 
        my($oescaped) = $self->escape_regex_special($orig_dir) . '(/)?';
- 
 
 345 
        $partial =~ s!\\!/!g;
336 
        $partial =~ s/^$oescaped//;
 346 
        $partial =~ s/^$oescaped//;
337 
        $diag .= ($partial ne '' ? "$partial/" : '') . $file;
 347 
        $diag .= ($partial ne '' ? "$partial/" : '') . $file;
338 
      }
 348 
      }
339 
      $self->diagnostic($diag);
 349 
      $self->diagnostic($diag);
340 
      my($start) = time();
 350 
      my($start) = time();