WebSVN – gelsvn – Diff – /trunk/MPC/modules/Driver.pm


package Driver;
 
# ************************************************************
# Description   : Functionality to call a workspace or project creator
# Author        : Chad Elliott
# Create Date   : 5/28/2002
# ************************************************************
 
# ************************************************************
# Pragmas
# ************************************************************
 
use strict;
 
 
use Options;
use Parser;
use Version;
 
use vars qw(@ISA);
@ISA = qw(Parser Options);
 
# ************************************************************
# Data Section
# ************************************************************
 
my($index)    = 0;
my(@progress) = ('|', '/', '-', '\\');
my($cmdenv)   = 'MPC_COMMANDLINE';
my($minperl)  = 5.006;
 
# ************************************************************
# Subroutine Section
# ************************************************************
 
sub new {
  my($class)    = shift;
  my($path)     = shift;
  my($name)     = shift;
  my(@creators) = @_;
  my($self)     = $class->SUPER::new();
 
  $self->{'path'}     = $path;
  $self->{'basepath'} = ::getBasePath();
  $self->{'name'}     = $name;
  $self->{'types'}    = {};
  $self->{'creators'} = \@creators;
  $self->{'default'}  = $creators[0];
  $self->{'reldefs'}  = {};
  $self->{'relorder'} = [];
 
  return $self;
}
 
 
 
 
 
 
 
 
sub parse_line {
  my($self)        = shift;
  my($ih)          = shift;
  my($line)        = shift;
  my($status)      = 1;
  my($errorString) = undef;
 
  if ($line eq '') {
  }
  elsif ($line =~ /^([\w\*]+)(\s*,\s*(.*))?$/) {
    my($name)  = $1;
    my($value) = $3;
    if (defined $value) {
      $value =~ s/^\s+//;
      $value =~ s/\s+$//;
    }
    if ($name =~ s/\*/.*/g) {
 
      foreach my $key (keys %ENV) {
        if ($key =~ /^$name$/ && !exists $self->{'reldefs'}->{$key}) {
          ## Put this value at the front since it doesn't need
          ## to be built up from anything else.  It is a stand-alone
          ## relative definition.
          $self->{'reldefs'}->{$key} = undef;
          unshift(@{$self->{'relorder'}}, $key);
        }
      }
    }
    else {
      $self->{'reldefs'}->{$name} = $value;
      if (defined $value) {
        ## This relative definition may need to be built up from an
        ## existing value, so it needs to be put at the end.
        push(@{$self->{'relorder'}}, $name);
      }
      else {
        ## Put this value at the front since it doesn't need
        ## to be built up from anything else.  It is a stand-alone
        ## relative definition.
        unshift(@{$self->{'relorder'}}, $name);
      }
    }
  }
  else {
    $status = 0;
    $errorString = "Unrecognized line: $line";
  }
 
  return $status, $errorString;
}
 
 
sub optionError {
  my($self) = shift;
  my($line) = shift;
 
  $self->printUsage($line, $self->{'name'}, Version::get(),
                    $self->extractType($self->{'default'}),
                    keys %{$self->{'types'}});
  exit(0);
}
 
 
sub run {
  my($self) = shift;
  my(@args) = @_;
 
  ## If the minimum version of perl is not met, then it is an error
  if ($] < $minperl) {
    $self->error("Perl version $minperl is required.");
    return 1;
  }
 
  ## Dynamically load in each perl module and set up
  ## the type tags and project creators
  my($creators) = $self->{'creators'};
  foreach my $creator (@$creators) {
    my($tag) = $self->extractType($creator);
    $self->{'types'}->{$tag} = $creator;
  }
 
  ## Before we process the arguments, we will prepend the $cmdenv
  ## environment variable.
  if (defined $ENV{$cmdenv}) {
    my($envargs) = $self->create_array($ENV{$cmdenv});
    unshift(@args, @$envargs);
  }
 
  my($options) = $self->options($self->{'name'},
                                $self->{'types'},
                                1,
                                @args);
  if (!defined $options) {
    ## If options are not defined, that means that calling options
    ## took care of whatever functionality that was required and
    ## we can now return with a good status.
    return 0;
  }
 
  ## Set up a hash that we can use to keep track of what
  ## has been 'required'
  my(%loaded) = ();
 
  ## Set up the default creator, if no type is selected
  if (!defined $options->{'creators'}->[0]) {
    push(@{$options->{'creators'}}, $self->{'default'});
  }
 
  if ($options->{'recurse'}) {
    if (defined $options->{'input'}->[0]) {
      ## This is an error.
      ## -recurse was used and input files were specified.
      $self->optionError('No files should be ' .
                         'specified when using -recurse');
    }
    else {
      ## We have to load at least one creator here in order
      ## to call the generate_recursive_input_list virtual function.
      my($name) = $options->{'creators'}->[0];
      if (!$loaded{$name}) {
        require "$name.pm";
        $loaded{$name} = 1;
      }
 
      ## Generate the recursive input list
      my($creator) = $name->new();
      my(@input) = $creator->generate_recursive_input_list(
                                              '.', $options->{'exclude'});
      $options->{'input'} = \@input;
 
      ## If no files were found above, then we issue a warning
      ## that we are going to use the default input
      if (!defined $options->{'input'}->[0]) {
        $self->information('No files were found using the -recurse option. ' .
                           'Using the default input.');
      }
    }
  }
 
  ## Set the global feature file
  my($cgf) = '/config/global.features';
  my($global_feature_file) = (defined $options->{'gfeature_file'} &&
                              -r $options->{'gfeature_file'} ?
                                 $options->{'gfeature_file'} :
                                 -r $self->{'path'} . $cgf ?
                                    $self->{'path'} . $cgf :
                                    $self->{'basepath'} . $cgf
                                 );
 
  ## Set up default values
  if (!defined $options->{'input'}->[0]) {
    push(@{$options->{'input'}}, '');
  }
  if (!defined $options->{'feature_file'}) {
    my($cdf) = '/config/default.features';
    $options->{'feature_file'} = (-r $self->{'path'} . $cdf ?
                                     $self->{'path'} . $cdf :
                                     -r $self->{'basepath'} . $cdf ?
                                        $self->{'basepath'} . $cdf :
                                        undef);
 
  }
  if (!defined $options->{'global'}) {
    my($cgm) = '/config/global.mpb';
    $options->{'global'} = (-r $self->{'path'} . $cgm ?
                                     $self->{'path'} . $cgm :
                                     -r $self->{'basepath'} . $cgm ?
                                        $self->{'basepath'} . $cgm :
                                        undef);
 
  }
  ## Save the original directory outside of the loop
  ## to avoid calling it multiple times.
  my($orig_dir) = $self->getcwd();
 
  ## Always add the default include paths
  unshift(@{$options->{'include'}}, $orig_dir);
  unshift(@{$options->{'include'}}, $self->{'path'} . '/templates');
  unshift(@{$options->{'include'}}, $self->{'path'} . '/config');
 
  if ($options->{'reldefs'}) {
    ## Only try to read the file if it exists
    my($cdr) = '/config/default.rel';
    my($rel) = (-r $self->{'path'} . $cdr ?
                   $self->{'path'} . $cdr :
                   -r $self->{'basepath'} . $cdr ?
                      $self->{'basepath'} . $cdr :
                      undef);
    if (defined $rel) {
      my($srel, $errorString) = $self->read_file($rel);
      if (!$srel) {
        $self->error("$errorString\nin $rel");
        return 1;
      }
    }
 
    foreach my $key (@{$self->{'relorder'}}) {
      if (defined $ENV{$key} &&
          !defined $options->{'relative'}->{$key}) {
        $options->{'relative'}->{$key} = $ENV{$key};
      }
      if (defined $self->{'reldefs'}->{$key} &&
          !defined $options->{'relative'}->{$key}) {
        my($value) = $self->{'reldefs'}->{$key};
        if ($value =~ /\$(\w+)(.*)?/) {
          my($var)   = $1;
          my($extra) = $2;
          $options->{'relative'}->{$key} =
                     (defined $options->{'relative'}->{$var} ?
                              $options->{'relative'}->{$var} : '') .
                     (defined $extra ? $extra : '');
        }
        else {
          $options->{'relative'}->{$key} = $value;
        }
      }
 
      ## If a relative path is defined, remove all trailing slashes
      ## and replace any two or more slashes with a single slash.
      if (defined $options->{'relative'}->{$key}) {
        $options->{'relative'}->{$key} =~ s/([\/\\])[\/\\]+/$1/g;
        $options->{'relative'}->{$key} =~ s/[\/\\]$//g;
      }
    }
  }
 
  ## Set up un-buffered output for the progress callback
  $| = 1;
 
  ## Keep the starting time for the total output
  my($startTime) = time();
  my($loopTimes) = 0;
 
  ## Generate the files
  my($status) = 0;
  foreach my $cfile (@{$options->{'input'}}) {
    ## To correctly reference any pathnames in the input file, chdir to
    ## its directory if there's any directory component to the specified path.
    my($base) = ($cfile eq '' ? '' : $self->mpc_basename($cfile));
 
    if (-d $cfile) {
      $base = '';
    }
 
    foreach my $name (@{$options->{'creators'}}) {
      ++$loopTimes;
 
      if (!$loaded{$name}) {
        require "$name.pm";
        $loaded{$name} = 1;
      }
      my($file) = $cfile;
      my($creator) = $name->new($options->{'global'},
                                $options->{'include'},
                                $options->{'template'},
                                $options->{'ti'},
                                $options->{'dynamic'},
                                $options->{'static'},
                                $options->{'relative'},
                                $options->{'addtemp'},
                                $options->{'addproj'},
                                (-t 1 ? \&progress : undef),
                                $options->{'toplevel'},
                                $options->{'baseprojs'},
                                $global_feature_file,
                                $options->{'feature_file'},
                                $options->{'features'},
                                $options->{'hierarchy'},
                                $options->{'exclude'},
                                $options->{'coexistence'},
                                $options->{'name_modifier'},
                                $options->{'apply_project'},
                                $options->{'genins'},
                                $options->{'into'},
                                $options->{'language'},
                                $options->{'use_env'},
                                $options->{'expand_vars'});
      if ($base ne $file) {
        my($dir) = ($base eq '' ? $file : $self->mpc_dirname($file));
        if (!$creator->cd($dir)) {
          $self->error("Unable to change to directory: $dir");
          $status++;
          last;
        }
        $file = $base;
      }
      my($diag) = 'Generating ' . $self->extractType($name) . ' output using ';
      if ($file eq '') {
        $diag .= 'default input';
      }
      else {
        my($partial)  = $self->getcwd();
        my($oescaped) = $self->escape_regex_special($orig_dir) . '(/)?';
        $partial =~ s!\\!/!g;
        $partial =~ s/^$oescaped//;
        $diag .= ($partial ne '' ? "$partial/" : '') . $file;
      }
      $self->diagnostic($diag);
      my($start) = time();
      if (!$creator->generate($file)) {
        $self->error("Unable to process: " .
                     ($file eq '' ? 'default input' : $file));
        $status++;
        last;
      }
      my($total) = time() - $start;
      $self->diagnostic('Generation Time: ' .
                        (int($total / 60) > 0 ? int($total / 60) . 'm ' : '') .
                        ($total % 60) . 's');
      $creator->cd($orig_dir);
    }
    if ($status) {
      last;
    }
  }
 
  ## If we went through the loop more than once, we need to print
  ## out the total amount of time
  if ($loopTimes > 1) {
    my($total) = time() - $startTime;
    $self->diagnostic('     Total Time: ' .
                      (int($total / 60) > 0 ? int($total / 60) . 'm ' : '') .
                      ($total % 60) . 's');
  }
 
  return $status;
}
 
 
sub progress {
  ## This method will be called before each output file is written.
  print "$progress[$index]\r";
  $index++;
  if ($index > $#progress) {
    $index = 0;
  }
}
 
 
1;
 

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

Subversion Repositories gelsvn

(root)/trunk/MPC/modules/Driver.pm @ 242 – Rev 107 → 217