Subversion Repositories gelsvn

Rev

Rev 107 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
107 bj 1
package Driver;
2
 
3
# ************************************************************
4
# Description   : Functionality to call a workspace or project creator
5
# Author        : Chad Elliott
6
# Create Date   : 5/28/2002
7
# ************************************************************
8
 
9
# ************************************************************
10
# Pragmas
11
# ************************************************************
12
 
13
use strict;
14
 
15
use Options;
16
use Parser;
17
use Version;
18
 
19
use vars qw(@ISA);
20
@ISA = qw(Parser Options);
21
 
22
# ************************************************************
23
# Data Section
24
# ************************************************************
25
 
26
my($index)    = 0;
27
my(@progress) = ('|', '/', '-', '\\');
28
my($cmdenv)   = 'MPC_COMMANDLINE';
29
my($minperl)  = 5.006;
30
 
31
# ************************************************************
32
# Subroutine Section
33
# ************************************************************
34
 
35
sub new {
36
  my($class)    = shift;
37
  my($path)     = shift;
38
  my($name)     = shift;
39
  my(@creators) = @_;
40
  my($self)     = $class->SUPER::new();
41
 
42
  $self->{'path'}     = $path;
217 bj 43
  $self->{'basepath'} = ::getBasePath();
107 bj 44
  $self->{'name'}     = $name;
45
  $self->{'types'}    = {};
46
  $self->{'creators'} = \@creators;
47
  $self->{'default'}  = $creators[0];
48
  $self->{'reldefs'}  = {};
49
  $self->{'relorder'} = [];
50
 
51
  return $self;
52
}
53
 
54
 
55
sub parse_line {
56
  my($self)        = shift;
57
  my($ih)          = shift;
58
  my($line)        = shift;
59
  my($status)      = 1;
60
  my($errorString) = undef;
61
 
62
  if ($line eq '') {
63
  }
64
  elsif ($line =~ /^([\w\*]+)(\s*,\s*(.*))?$/) {
65
    my($name)  = $1;
66
    my($value) = $3;
67
    if (defined $value) {
68
      $value =~ s/^\s+//;
69
      $value =~ s/\s+$//;
70
    }
217 bj 71
    if ($name =~ s/\*/.*/g) {
107 bj 72
      foreach my $key (keys %ENV) {
73
        if ($key =~ /^$name$/ && !exists $self->{'reldefs'}->{$key}) {
74
          ## Put this value at the front since it doesn't need
75
          ## to be built up from anything else.  It is a stand-alone
76
          ## relative definition.
77
          $self->{'reldefs'}->{$key} = undef;
78
          unshift(@{$self->{'relorder'}}, $key);
79
        }
80
      }
81
    }
82
    else {
83
      $self->{'reldefs'}->{$name} = $value;
84
      if (defined $value) {
85
        ## This relative definition may need to be built up from an
86
        ## existing value, so it needs to be put at the end.
87
        push(@{$self->{'relorder'}}, $name);
88
      }
89
      else {
90
        ## Put this value at the front since it doesn't need
91
        ## to be built up from anything else.  It is a stand-alone
92
        ## relative definition.
93
        unshift(@{$self->{'relorder'}}, $name);
94
      }
95
    }
96
  }
97
  else {
98
    $status = 0;
99
    $errorString = "Unrecognized line: $line";
100
  }
101
 
102
  return $status, $errorString;
103
}
104
 
105
 
106
sub optionError {
107
  my($self) = shift;
108
  my($line) = shift;
109
 
110
  $self->printUsage($line, $self->{'name'}, Version::get(),
111
                    $self->extractType($self->{'default'}),
112
                    keys %{$self->{'types'}});
113
  exit(0);
114
}
115
 
116
 
117
sub run {
118
  my($self) = shift;
119
  my(@args) = @_;
120
 
121
  ## If the minimum version of perl is not met, then it is an error
122
  if ($] < $minperl) {
123
    $self->error("Perl version $minperl is required.");
124
    return 1;
125
  }
126
 
127
  ## Dynamically load in each perl module and set up
128
  ## the type tags and project creators
129
  my($creators) = $self->{'creators'};
130
  foreach my $creator (@$creators) {
131
    my($tag) = $self->extractType($creator);
132
    $self->{'types'}->{$tag} = $creator;
133
  }
134
 
135
  ## Before we process the arguments, we will prepend the $cmdenv
136
  ## environment variable.
137
  if (defined $ENV{$cmdenv}) {
138
    my($envargs) = $self->create_array($ENV{$cmdenv});
139
    unshift(@args, @$envargs);
140
  }
141
 
142
  my($options) = $self->options($self->{'name'},
143
                                $self->{'types'},
144
                                1,
145
                                @args);
146
  if (!defined $options) {
147
    ## If options are not defined, that means that calling options
148
    ## took care of whatever functionality that was required and
149
    ## we can now return with a good status.
150
    return 0;
151
  }
152
 
153
  ## Set up a hash that we can use to keep track of what
154
  ## has been 'required'
155
  my(%loaded) = ();
156
 
157
  ## Set up the default creator, if no type is selected
158
  if (!defined $options->{'creators'}->[0]) {
159
    push(@{$options->{'creators'}}, $self->{'default'});
160
  }
161
 
162
  if ($options->{'recurse'}) {
163
    if (defined $options->{'input'}->[0]) {
164
      ## This is an error.
165
      ## -recurse was used and input files were specified.
166
      $self->optionError('No files should be ' .
167
                         'specified when using -recurse');
168
    }
169
    else {
170
      ## We have to load at least one creator here in order
171
      ## to call the generate_recursive_input_list virtual function.
172
      my($name) = $options->{'creators'}->[0];
173
      if (!$loaded{$name}) {
174
        require "$name.pm";
175
        $loaded{$name} = 1;
176
      }
177
 
178
      ## Generate the recursive input list
179
      my($creator) = $name->new();
180
      my(@input) = $creator->generate_recursive_input_list(
181
                                              '.', $options->{'exclude'});
182
      $options->{'input'} = \@input;
183
 
184
      ## If no files were found above, then we issue a warning
185
      ## that we are going to use the default input
186
      if (!defined $options->{'input'}->[0]) {
187
        $self->information('No files were found using the -recurse option. ' .
188
                           'Using the default input.');
189
      }
190
    }
191
  }
192
 
193
  ## Set the global feature file
217 bj 194
  my($cgf) = '/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
                                 );
107 bj 202
 
203
  ## Set up default values
204
  if (!defined $options->{'input'}->[0]) {
205
    push(@{$options->{'input'}}, '');
206
  }
207
  if (!defined $options->{'feature_file'}) {
217 bj 208
    my($cdf) = '/config/default.features';
209
    $options->{'feature_file'} = (-r $self->{'path'} . $cdf ?
210
                                     $self->{'path'} . $cdf :
211
                                     -r $self->{'basepath'} . $cdf ?
212
                                        $self->{'basepath'} . $cdf :
213
                                        undef);
107 bj 214
  }
215
  if (!defined $options->{'global'}) {
217 bj 216
    my($cgm) = '/config/global.mpb';
217
    $options->{'global'} = (-r $self->{'path'} . $cgm ?
218
                                     $self->{'path'} . $cgm :
219
                                     -r $self->{'basepath'} . $cgm ?
220
                                        $self->{'basepath'} . $cgm :
221
                                        undef);
107 bj 222
  }
223
  ## Save the original directory outside of the loop
224
  ## to avoid calling it multiple times.
225
  my($orig_dir) = $self->getcwd();
226
 
227
  ## Always add the default include paths
228
  unshift(@{$options->{'include'}}, $orig_dir);
229
  unshift(@{$options->{'include'}}, $self->{'path'} . '/templates');
230
  unshift(@{$options->{'include'}}, $self->{'path'} . '/config');
231
 
232
  if ($options->{'reldefs'}) {
233
    ## Only try to read the file if it exists
217 bj 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);
240
    if (defined $rel) {
107 bj 241
      my($srel, $errorString) = $self->read_file($rel);
242
      if (!$srel) {
243
        $self->error("$errorString\nin $rel");
244
        return 1;
245
      }
246
    }
247
 
248
    foreach my $key (@{$self->{'relorder'}}) {
249
      if (defined $ENV{$key} &&
250
          !defined $options->{'relative'}->{$key}) {
251
        $options->{'relative'}->{$key} = $ENV{$key};
252
      }
253
      if (defined $self->{'reldefs'}->{$key} &&
254
          !defined $options->{'relative'}->{$key}) {
255
        my($value) = $self->{'reldefs'}->{$key};
256
        if ($value =~ /\$(\w+)(.*)?/) {
257
          my($var)   = $1;
258
          my($extra) = $2;
259
          $options->{'relative'}->{$key} =
260
                     (defined $options->{'relative'}->{$var} ?
261
                              $options->{'relative'}->{$var} : '') .
262
                     (defined $extra ? $extra : '');
263
        }
264
        else {
265
          $options->{'relative'}->{$key} = $value;
266
        }
267
      }
268
 
269
      ## If a relative path is defined, remove all trailing slashes
270
      ## and replace any two or more slashes with a single slash.
271
      if (defined $options->{'relative'}->{$key}) {
272
        $options->{'relative'}->{$key} =~ s/([\/\\])[\/\\]+/$1/g;
273
        $options->{'relative'}->{$key} =~ s/[\/\\]$//g;
274
      }
275
    }
276
  }
277
 
278
  ## Set up un-buffered output for the progress callback
279
  $| = 1;
280
 
281
  ## Keep the starting time for the total output
282
  my($startTime) = time();
283
  my($loopTimes) = 0;
284
 
285
  ## Generate the files
286
  my($status) = 0;
287
  foreach my $cfile (@{$options->{'input'}}) {
288
    ## To correctly reference any pathnames in the input file, chdir to
289
    ## its directory if there's any directory component to the specified path.
217 bj 290
    my($base) = ($cfile eq '' ? '' : $self->mpc_basename($cfile));
107 bj 291
 
292
    if (-d $cfile) {
293
      $base = '';
294
    }
295
 
296
    foreach my $name (@{$options->{'creators'}}) {
297
      ++$loopTimes;
298
 
299
      if (!$loaded{$name}) {
300
        require "$name.pm";
301
        $loaded{$name} = 1;
302
      }
303
      my($file) = $cfile;
304
      my($creator) = $name->new($options->{'global'},
305
                                $options->{'include'},
306
                                $options->{'template'},
307
                                $options->{'ti'},
308
                                $options->{'dynamic'},
309
                                $options->{'static'},
310
                                $options->{'relative'},
311
                                $options->{'addtemp'},
312
                                $options->{'addproj'},
313
                                (-t 1 ? \&progress : undef),
314
                                $options->{'toplevel'},
315
                                $options->{'baseprojs'},
316
                                $global_feature_file,
317
                                $options->{'feature_file'},
318
                                $options->{'features'},
319
                                $options->{'hierarchy'},
320
                                $options->{'exclude'},
321
                                $options->{'coexistence'},
322
                                $options->{'name_modifier'},
323
                                $options->{'apply_project'},
324
                                $options->{'genins'},
325
                                $options->{'into'},
326
                                $options->{'language'},
327
                                $options->{'use_env'},
328
                                $options->{'expand_vars'});
329
      if ($base ne $file) {
330
        my($dir) = ($base eq '' ? $file : $self->mpc_dirname($file));
331
        if (!$creator->cd($dir)) {
332
          $self->error("Unable to change to directory: $dir");
333
          $status++;
334
          last;
335
        }
336
        $file = $base;
337
      }
338
      my($diag) = 'Generating ' . $self->extractType($name) . ' output using ';
339
      if ($file eq '') {
340
        $diag .= 'default input';
341
      }
342
      else {
343
        my($partial)  = $self->getcwd();
344
        my($oescaped) = $self->escape_regex_special($orig_dir) . '(/)?';
217 bj 345
        $partial =~ s!\\!/!g;
107 bj 346
        $partial =~ s/^$oescaped//;
347
        $diag .= ($partial ne '' ? "$partial/" : '') . $file;
348
      }
349
      $self->diagnostic($diag);
350
      my($start) = time();
351
      if (!$creator->generate($file)) {
352
        $self->error("Unable to process: " .
353
                     ($file eq '' ? 'default input' : $file));
354
        $status++;
355
        last;
356
      }
357
      my($total) = time() - $start;
358
      $self->diagnostic('Generation Time: ' .
359
                        (int($total / 60) > 0 ? int($total / 60) . 'm ' : '') .
360
                        ($total % 60) . 's');
361
      $creator->cd($orig_dir);
362
    }
363
    if ($status) {
364
      last;
365
    }
366
  }
367
 
368
  ## If we went through the loop more than once, we need to print
369
  ## out the total amount of time
370
  if ($loopTimes > 1) {
371
    my($total) = time() - $startTime;
372
    $self->diagnostic('     Total Time: ' .
373
                      (int($total / 60) > 0 ? int($total / 60) . 'm ' : '') .
374
                      ($total % 60) . 's');
375
  }
376
 
377
  return $status;
378
}
379
 
380
 
381
sub progress {
382
  ## This method will be called before each output file is written.
383
  print "$progress[$index]\r";
384
  $index++;
385
  if ($index > $#progress) {
386
    $index = 0;
387
  }
388
}
389
 
390
 
391
1;