modules/Driver.pm

   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 mpc_debug;
  16 use Options;
  17 use Parser;
  18 use Version;
  19 use ConfigParser;
  20
  21 use vars qw(@ISA);
  22 @ISA = qw(Parser Options);
  23
  24 # ************************************************************
  25 # Data Section
  26 # ************************************************************
  27
  28 my $index     = 0;
  29 my @progress  = ('|', '/', '-', '\\');
  30 my %valid_cfg = ('command_line'     => 1,
  31                  'default_type'     => 1,
  32                  'dynamic_types'    => 1,
  33                  'includes'         => 1,
  34                  'logging'          => 1,
  35                  'main_functions'   => 1,
  36                  'verbose_ordering' => 1,
  37                 );
  38 my @intype    = ('mwc.pl', 'mpc.pl');
  39
  40 # ************************************************************
  41 # Subroutine Section
  42 # ************************************************************
  43
  44 sub new {
  45   my $class    = shift;
  46   my $path     = shift;
  47   my $name     = shift;
  48   my @creators = @_;
  49   my $self = $class->SUPER::new();
  50
  51   $self->{'path'}     = $path;
  52   $self->{'basepath'} = ::getBasePath();
  53   $self->{'name'}     = $name;
  54   $self->{'type'}     = (lc($self->{'name'}) eq $intype[0] ?
  55                                 'WorkspaceCreator' : 'ProjectCreator');
  56   $self->{'types'}    = {};
  57   $self->{'creators'} = \@creators;
  58   $self->{'reldefs'}  = {};
  59   $self->{'relorder'} = [];
  60
  61   return $self;
  62 }
  63
  64
  65 sub workspaces {
  66   return $intype[0];
  67 }
  68
  69
  70 sub projects {
  71   return $intype[1];
  72 }
  73
  74
  75 sub locate_default_type {
  76   my $self = shift;
  77   my $name = lc(shift) . lc($self->{'type'}) . '.pm';
  78   my $fh = new FileHandle();
  79
  80   foreach my $dir (@INC) {
  81     if (opendir($fh, $dir)) {
  82       foreach my $file (readdir($fh)) {
  83         if (lc($file) eq $name) {
  84           $file =~ s/\.pm$//;
  85           return $file;
  86         }
  87       }
  88       closedir($fh);
  89     }
  90   }
  91
  92   return undef;
  93 }
  94
  95
  96 sub locate_dynamic_directories {
  97   my($self, $cfg, $label) = @_;
  98   my $dtypes = $cfg->get_value($label);
  99
 100   if (defined $dtypes) {
 101     my $count = 0;
 102     my @directories;
 103     my @unprocessed = split(/\s*,\s*/, $cfg->get_unprocessed($label));
 104     foreach my $dir (split(/\s*,\s*/, $dtypes)) {
 105       if (-d $dir) {
 106         if (-d "$dir/modules" || -d "$dir/config" || -d "$dir/templates") {
 107           push(@directories, $dir);
 108         }
 109       }
 110       elsif (!(defined $unprocessed[$count] &&
 111                $unprocessed[$count] =~ s/\$[\(\w\)]+//g &&
 112                $unprocessed[$count] eq $dir)) {
 113         $self->diagnostic("'$label' directory $dir not found.");
 114       }
 115       $count++;
 116     }
 117     return \@directories;
 118   }
 119
 120   return undef;
 121 }
 122
 123
 124 sub add_dynamic_creators {
 125   my($self, $dirs) = @_;
 126   my $type = $self->{'type'};
 127
 128   foreach my $dir (@$dirs) {
 129     my $fh = new FileHandle();
 130     if (opendir($fh, "$dir/modules")) {
 131       foreach my $file (readdir($fh)) {
 132         if ($file =~ /(.+$type)\.pm$/i) {
 133           my $name = $1;
 134           if (DirectoryManager::onVMS()) {
 135             my $fh = new FileHandle();
 136             if (open($fh, $dir . "/modules/" . $file)) {
 137               my $line = <$fh>;
 138               if ($line =~ /^\s*package\s+(.+);/) {
 139                 $name = $1;
 140               }
 141               close($fh);
 142             }
 143           }
 144           $self->debug("Pulling in $name");
 145           push(@{$self->{'creators'}}, $name);
 146         }
 147       }
 148       closedir($fh);
 149     }
 150   }
 151 }
 152
 153 sub parse_line {
 154   my($self, $ih, $line) = @_;
 155   my $status = 1;
 156   my $errorString;
 157
 158   if ($line eq '') {
 159   }
 160   elsif ($line =~ /^([\w\*]+)(\s*,\s*(.*))?$/) {
 161     my $name  = $1;
 162     my $value = $3;
 163     if (defined $value) {
 164       $value =~ s/^\s+//;
 165       $value =~ s/\s+$//;
 166     }
 167     if ($name =~ s/\*/.*/g) {
 168       foreach my $key (keys %ENV) {
 169         if ($key =~ /^$name$/ && !exists $self->{'reldefs'}->{$key}) {
 170           ## Put this value at the front since it doesn't need
 171           ## to be built up from anything else.  It is a stand-alone
 172           ## relative definition.
 173           $self->{'reldefs'}->{$key} = undef;
 174           unshift(@{$self->{'relorder'}}, $key);
 175         }
 176       }
 177     }
 178     else {
 179       $self->{'reldefs'}->{$name} = $value;
 180       if (defined $value) {
 181         ## This relative definition may need to be built up from an
 182         ## existing value, so it needs to be put at the end.
 183         push(@{$self->{'relorder'}}, $name);
 184       }
 185       else {
 186         ## Put this value at the front since it doesn't need
 187         ## to be built up from anything else.  It is a stand-alone
 188         ## relative definition.
 189         unshift(@{$self->{'relorder'}}, $name);
 190       }
 191     }
 192   }
 193   else {
 194     $status = 0;
 195     $errorString = "Unrecognized line: $line";
 196   }
 197
 198   return $status, $errorString;
 199 }
 200
 201
 202 sub optionError {
 203   my($self, $line) = @_;
 204
 205   $self->printUsage($line, $self->{'name'}, Version::get(),
 206                     keys %{$self->{'types'}});
 207   exit(defined $line ? 1 : 0);
 208 }
 209
 210
 211 sub find_file {
 212   my($self, $includes, $file) = @_;
 213
 214   foreach my $inc (@$includes) {
 215     if (-r $inc . '/' . $file) {
 216       $self->debug("$file found in $inc");
 217       return $inc . '/' . $file;
 218     }
 219   }
 220   return undef;
 221 }
 222
 223
 224 sub determine_cfg_file {
 225   my($self, $cfg, $odir) = @_;
 226   my $ci = $self->case_insensitive();
 227
 228   $odir = lc($odir) if ($ci);
 229   foreach my $name (@{$cfg->get_names()}) {
 230     my $value = $cfg->get_value($name);
 231     if (index($odir, ($ci ? lc($name) : $name)) == 0) {
 232       $self->warning("$value does not exist.") if (!-d $value);
 233       my $cfgfile = $value . '/MPC.cfg';
 234       return $cfgfile if (-e $cfgfile);
 235     }
 236   }
 237
 238   return undef;
 239 }
 240
 241
 242 sub run {
 243   my $self = shift;
 244   my @args = @_;
 245   my $cfgfile;
 246
 247   ## Save the original directory outside of the loop
 248   ## to avoid calling it multiple times.
 249   my $orig_dir = $self->getcwd();
 250
 251   ## Read the code base config file from the config directory
 252   ## under $MPC_ROOT
 253   my $cbcfg  = new ConfigParser();
 254   my $cbfile = "$self->{'basepath'}/config/base.cfg";
 255   if (-r $cbfile) {
 256     my($status, $error) = $cbcfg->read_file($cbfile);
 257     if (!$status) {
 258       $self->error("$error at line " . $cbcfg->get_line_number() .
 259                    " of $cbfile");
 260       return 1;
 261     }
 262     $cfgfile = $self->determine_cfg_file($cbcfg, $orig_dir);
 263   }
 264
 265   ## If no MPC config file was found and
 266   ## there is one in the config directory, we will use that.
 267   if (!defined $cfgfile) {
 268     $cfgfile = $self->{'path'} . '/config/MPC.cfg';
 269     $cfgfile = $self->{'basepath'} . '/config/MPC.cfg' if (!-e $cfgfile);
 270     $cfgfile = undef if (!-e $cfgfile);
 271   }
 272
 273   ## Read the MPC config file
 274   my $cfg = new ConfigParser(\%valid_cfg);
 275   if (defined $cfgfile) {
 276     my $ellipses = $cfgfile;
 277     $ellipses =~ s!.*(/[^/]+/[^/]+/[^/]+/[^/]+/[^/]+/[^/]+)!...$1!;
 278     $self->diagnostic("Using $ellipses");
 279     my($status, $error) = $cfg->read_file($cfgfile);
 280     if (!$status) {
 281       $self->error("$error at line " . $cfg->get_line_number() .
 282                    " of $cfgfile");
 283       return 1;
 284     }
 285     OutputMessage::set_levels($cfg->get_value('logging'));
 286   }
 287
 288   ## Assembling a string from an array can be time consuming.  If we're
 289   ## not debugging, then skip it.
 290   $self->debug("CMD: $0 @ARGV") if ($self->get_debug_level());
 291
 292   ## After we read the config file, see if the user has provided
 293   ## dynamic types
 294   my $dynamic = $self->locate_dynamic_directories($cfg, 'dynamic_types');
 295   if (defined $dynamic) {
 296     ## If so, add in the creators found in the dynamic directories
 297     $self->add_dynamic_creators($dynamic);
 298
 299     ## Add the each dynamic path to the include paths
 300     foreach my $dynpath (@$dynamic) {
 301       unshift(@INC, $dynpath . '/modules');
 302       unshift(@args, '-include', "$dynpath/config",
 303                      '-include', "$dynpath/templates");
 304     }
 305   }
 306
 307   ## Add in the creators found in the main MPC/modules directory
 308   $self->add_dynamic_creators([$self->{'basepath'}]);
 309
 310   ## Dynamically load in each perl module and set up
 311   ## the type tags and project creators
 312   my $creators = $self->{'creators'};
 313   foreach my $creator (@$creators) {
 314     my $tag = $self->extractType($creator);
 315     $self->{'types'}->{$tag} = $creator;
 316   }
 317
 318   ## Before we process the arguments, we will prepend the command_line
 319   ## config variable.
 320   my $cmd = $cfg->get_value('command_line');
 321   if (defined $cmd) {
 322     my $envargs = $self->create_array($cmd);
 323     unshift(@args, @$envargs);
 324   }
 325
 326   ## Now add in the includes to the command line arguments.
 327   ## It is done this way to allow the Options module to process
 328   ## the include path as it does all others.
 329   my $incs = $cfg->get_value('includes');
 330   if (defined $incs) {
 331     foreach my $inc (split(/\s*,\s*/, $incs)) {
 332       ## We must add it to the front so that options provided at the end
 333       ## that require a parameter (but are not given one) do not gobble
 334       ## up the -include option.
 335       unshift(@args, '-include', $inc);
 336     }
 337   }
 338
 339   my $options = $self->options($self->{'name'},
 340                                $self->{'types'},
 341                                1,
 342                                @args);
 343
 344   ## If options are not defined, that means that calling options
 345   ## took care of whatever functionality that was required and
 346   ## we can now return with a good status.
 347   return 0 if (!defined $options);
 348
 349   ## Set up a hash that we can use to keep track of what
 350   ## has been 'required'
 351   my %loaded;
 352
 353   ## Set up the default creator, if no type is selected
 354   if (!defined $options->{'creators'}->[0]) {
 355     my $utype = $cfg->get_value('default_type');
 356     if (defined $utype) {
 357       my $default = $self->locate_default_type($utype);
 358       if (defined $default) {
 359         push(@{$options->{'creators'}}, $default);
 360       }
 361       else {
 362         $self->error("Unable to locate the module that corresponds to " .
 363                      "the '$utype' type.");
 364         return 1;
 365       }
 366     }
 367   }
 368
 369   ## If there's still no default, issue an error
 370   if (!defined $options->{'creators'}->[0]) {
 371     $self->error('There is no longer a default project type.  Please ' .
 372                  'specify one in MPC.cfg or use the -type option.');
 373     return 1;
 374   }
 375
 376   ## Set up additional main functions to recognize
 377   my $val = $cfg->get_value('main_functions');
 378   if (defined $val) {
 379     foreach my $main (split(/\s*,\s*/, $val)) {
 380       my $err = ProjectCreator::add_main_function($main);
 381       if (defined $err) {
 382         $self->error("$err at line " . $cfg->get_line_number() .
 383                      " of $cfgfile");
 384         return 1;
 385       }
 386     }
 387   }
 388
 389   if ($options->{'recurse'}) {
 390     if (defined $options->{'input'}->[0]) {
 391       ## This is an error.
 392       ## -recurse was used and input files were specified.
 393       $self->optionError('No files should be ' .
 394                          'specified when using -recurse');
 395     }
 396     else {
 397       ## We have to load at least one creator here in order
 398       ## to call the generate_recursive_input_list virtual function.
 399       my $name = $options->{'creators'}->[0];
 400       if (!$loaded{$name}) {
 401         require "$name.pm";
 402         $loaded{$name} = 1;
 403       }
 404
 405       ## Generate the recursive input list
 406       my $creator = $name->new();
 407       my @input = $creator->generate_recursive_input_list(
 408                                              '.', $options->{'exclude'});
 409       $options->{'input'} = \@input;
 410
 411       ## If no files were found above, then we issue a warning
 412       ## that we are going to use the default input
 413       if (!defined $options->{'input'}->[0]) {
 414         $self->information('No files were found using the -recurse option. ' .
 415                            'Using the default input.');
 416       }
 417     }
 418   }
 419
 420   ## Add the default include paths.  If the user has used the dynamic
 421   ## types method of adding types to MPC, we need to push the paths
 422   ## on.  Otherwise, we unshift them onto the front.
 423   if ($self->{'path'} ne $self->{'basepath'}) {
 424     unshift(@{$options->{'include'}}, $self->{'path'} . '/config',
 425                                       $self->{'path'} . '/templates');
 426   }
 427   push(@{$options->{'include'}}, $self->{'basepath'} . '/config',
 428                                  $self->{'basepath'} . '/templates');
 429
 430   ## All includes (except the current directory) have been added by this
 431   ## time.  Both of the following can be time consuming, so we'll only do
 432   ## it if we know we're debugging.
 433   if ($self->get_debug_level()) {
 434     $self->debug("INCLUDES: @{$options->{'include'}}");
 435     $self->dump_base_projects($options->{'include'});
 436   }
 437
 438   ## Set the global feature file
 439   my $global_feature_file = (defined $options->{'gfeature_file'} &&
 440                              -r $options->{'gfeature_file'} ?
 441                                 $options->{'gfeature_file'} : undef);
 442   if (defined $global_feature_file) {
 443     ## If the specified path is relative, expand it based on
 444     ## the current working directory.
 445     if ($global_feature_file !~ /^[\/\\]/ &&
 446         $global_feature_file !~ /^[A-Za-z]:[\/\\]?/) {
 447       $global_feature_file = DirectoryManager::getcwd() . '/' .
 448                              $global_feature_file;
 449     }
 450   }
 451   else {
 452     my $gf = 'global.features';
 453     $global_feature_file = $self->find_file($options->{'include'}, $gf);
 454     if (!defined $global_feature_file) {
 455       $global_feature_file = $self->{'basepath'} . '/config/' . $gf;
 456     }
 457   }
 458
 459   ## Set up default values
 460   push(@{$options->{'input'}}, '') if (!defined $options->{'input'}->[0]);
 461   $options->{'feature_file'} = $self->find_file($options->{'include'},
 462                                                 'default.features')
 463                                  if (!defined $options->{'feature_file'});
 464
 465   $options->{'global'} = $self->find_file($options->{'include'},
 466                                           'global.mpb')
 467                                  if (!defined $options->{'global'});
 468
 469   ## Set the relative
 470   my $relative_file = (defined $options->{'relative_file'} &&
 471                              -r $options->{'relative_file'} ?
 472                                 $options->{'relative_file'} : undef);
 473   if (!defined $relative_file) {
 474     my $gf = 'default.rel';
 475     $relative_file = $self->find_file($options->{'include'}, $gf);
 476     if (!defined $relative_file) {
 477       $relative_file = $self->{'basepath'} . '/config/' . $gf;
 478     }
 479   }
 480   if ($options->{'reldefs'}) {
 481     ## Only try to read the file if it exists
 482     if (defined $relative_file) {
 483       my($srel, $errorString) = $self->read_file($relative_file);
 484       if (!$srel) {
 485         $self->error("$errorString\nin $relative_file");
 486         return 1;
 487       }
 488
 489       foreach my $key (@{$self->{'relorder'}}) {
 490         if (defined $ENV{$key} &&
 491             !defined $options->{'relative'}->{$key}) {
 492           $options->{'relative'}->{$key} = $ENV{$key};
 493         }
 494         if (defined $self->{'reldefs'}->{$key} &&
 495             !defined $options->{'relative'}->{$key}) {
 496           my $value = $self->{'reldefs'}->{$key};
 497           if ($value =~ /\$(\w+)(.*)?/) {
 498             my $var   = $1;
 499             my $extra = $2;
 500             $options->{'relative'}->{$key} =
 501                        (defined $options->{'relative'}->{$var} ?
 502                                 $options->{'relative'}->{$var} : '') .
 503                        (defined $extra ? $extra : '');
 504           }
 505           else {
 506             $options->{'relative'}->{$key} = $value;
 507           }
 508         }
 509
 510         ## If a relative path is defined, remove all trailing slashes
 511         ## and replace any two or more slashes with a single slash.
 512         if (defined $options->{'relative'}->{$key}) {
 513           $options->{'relative'}->{$key} =~ s/([\/\\])[\/\\]+/$1/g;
 514           $options->{'relative'}->{$key} =~ s/[\/\\]$//g;
 515         }
 516       }
 517     }
 518
 519     ## Remove MPC_ROOT since we never want to expand it
 520     delete $options->{'relative'}->{'MPC_ROOT'};
 521   }
 522
 523   ## Always add the current path to the include paths
 524   unshift(@{$options->{'include'}}, $orig_dir);
 525
 526   ## Set up un-buffered output for the progress callback
 527   $| = 1;
 528
 529   ## Keep the starting time for the total output
 530   my $startTime = time();
 531   my $loopTimes = 0;
 532
 533   ## Generate the files
 534   my $status = 0;
 535   foreach my $cfile (@{$options->{'input'}}) {
 536     ## To correctly reference any pathnames in the input file, chdir to
 537     ## its directory if there's any directory component to the specified path.
 538     ## mpc_basename() always expects UNIX file format.
 539     $cfile =~ s/\\/\//g;
 540     my $base = ($cfile eq '' ? '' : $self->mpc_basename($cfile));
 541
 542     $base = '' if (-d $cfile);
 543
 544     foreach my $name (@{$options->{'creators'}}) {
 545       ++$loopTimes;
 546
 547       if (!$loaded{$name}) {
 548         mpc_debug::chkpnt_pre_creator_load($name);
 549         require "$name.pm";
 550         mpc_debug::chkpnt_post_creator_load($name);
 551         $loaded{$name} = 1;
 552       }
 553       my $file = $cfile;
 554       mpc_debug::chkpnt_pre_creator_create($name);
 555       my $creator = $name->new($options->{'global'},
 556                                $options->{'include'},
 557                                $options->{'template'},
 558                                $options->{'ti'},
 559                                $options->{'dynamic'},
 560                                $options->{'static'},
 561                                $options->{'relative'},
 562                                $options->{'addtemp'},
 563                                $options->{'addproj'},
 564                                (-t 1 ? \&progress : undef),
 565                                $options->{'toplevel'},
 566                                $options->{'baseprojs'},
 567                                $global_feature_file,
 568                                $options->{'relative_file'},
 569                                $options->{'feature_file'},
 570                                $options->{'features'},
 571                                $options->{'hierarchy'},
 572                                $options->{'exclude'},
 573                                $options->{'make_coexistence'},
 574                                $options->{'name_modifier'},
 575                                $options->{'apply_project'},
 576                                $options->{'genins'},
 577                                $options->{'into'},
 578                                $options->{'language'},
 579                                $options->{'use_env'},
 580                                $options->{'expand_vars'},
 581                                $options->{'gendot'},
 582                                $options->{'comments'},
 583                                $options->{'for_eclipse'},
 584                                $options->{'workers'},
 585                                $options->{'workers_dir'},
 586                                $options->{'workers_port'});
 587
 588       mpc_debug::chkpnt_post_creator_create($name);
 589
 590       ## Update settings based on the configuration file
 591       my $verbose_ordering = $cfg->get_value('verbose_ordering');
 592       $creator->set_verbose_ordering($verbose_ordering) if defined $verbose_ordering;
 593
 594       if ($base ne $file) {
 595         my $dir = ($base eq '' ? $file : $self->mpc_dirname($file));
 596         if (!$creator->cd($dir)) {
 597           $self->error("Unable to change to directory: $dir");
 598           $status++;
 599           last;
 600         }
 601         $file = $base;
 602       }
 603       my $diag = 'Generating \'' . $self->extractType($name) .
 604                  '\' output using ';
 605       if ($file eq '') {
 606         $diag .= 'default input';
 607       }
 608       else {
 609         my $partial  = $self->getcwd();
 610         my $oescaped = $self->escape_regex_special($orig_dir) . '(/)?';
 611         $partial =~ s!\\!/!g;
 612         $partial =~ s/^$oescaped//;
 613         $diag .= ($partial ne '' ? "$partial/" : '') . $file;
 614       }
 615       $self->diagnostic($diag);
 616       my $start = time();
 617       if (!$creator->generate($file)) {
 618         $self->error("Unable to process: " .
 619                      ($file eq '' ? 'default input' : $file));
 620         $status++;
 621         last;
 622       }
 623       my $total = time() - $start;
 624       $self->diagnostic('Generation Time: ' .
 625                         (int($total / 60) > 0 ? int($total / 60) . 'm ' : '') .
 626                         ($total % 60) . 's');
 627       $creator->cd($orig_dir);
 628     }
 629     last if ($status);
 630   }
 631
 632   ## If we went through the loop more than once, we need to print
 633   ## out the total amount of time
 634   if ($loopTimes > 1) {
 635     my $total = time() - $startTime;
 636     $self->diagnostic('     Total Time: ' .
 637                       (int($total / 60) > 0 ? int($total / 60) . 'm ' : '') .
 638                       ($total % 60) . 's');
 639   }
 640
 641   return $status;
 642 }
 643
 644
 645 sub progress {
 646   ## This method will be called before each output file is written.
 647   print "$progress[$index]\r";
 648   $index++;
 649   $index = 0 if ($index > $#progress);
 650 }
 651
 652
 653 1;