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