diff options
author | jonesc <jonesc@a3e5c962-4219-0410-a828-e124f845ac39> | 2012-01-17 05:24:59 +0000 |
---|---|---|
committer | jonesc <jonesc@a3e5c962-4219-0410-a828-e124f845ac39> | 2012-01-17 05:24:59 +0000 |
commit | 5b077cd62c68fd3be08bc888d4ad2568d87e375e (patch) | |
tree | 64c4f08f54233e3f22376c893a38fa411e9c1f85 | |
parent | 66a603f159951e2600813df7f2be31744d5c6047 (diff) | |
download | MPC-5b077cd62c68fd3be08bc888d4ad2568d87e375e.tar.gz |
Mon Jan 16 22:01:41 UTC 2012 Chip Jones <jonesc@ociweb.com>
* modules/Creator.pm:
Modifications to support multiprocess MPC.
* modules/Depgen/DependencyEditor.pm:
* modules/Depgen/Driver.pm:
Modified dependency generator to support appending to existing
files and generating dependencies for IDL files.
* modules/Driver.pm:
* modules/Options.pm:
* modules/Parser.pm:
* modules/ProjectCreator.pm:
* modules/TemplateParser.pm:
* modules/WorkspaceCreator.pm:
Modified MPC to generate projects in separate processes.
This experimental feature is enabled with the
command-line option '-workers.' It's behavior can
be modified with the '-workers_dir' and '-workers_port'
directives.
This is a merge of work done in the 'mpc_performance' branch.
-rw-r--r-- | modules/Creator.pm | 11 | ||||
-rw-r--r-- | modules/Depgen/DependencyEditor.pm | 39 | ||||
-rw-r--r-- | modules/Depgen/Driver.pm | 30 | ||||
-rw-r--r-- | modules/Driver.pm | 6 | ||||
-rw-r--r-- | modules/Options.pm | 53 | ||||
-rw-r--r-- | modules/Parser.pm | 1 | ||||
-rw-r--r-- | modules/ProjectCreator.pm | 43 | ||||
-rw-r--r-- | modules/TemplateParser.pm | 9 | ||||
-rw-r--r-- | modules/WorkspaceCreator.pm | 1257 |
9 files changed, 1171 insertions, 278 deletions
diff --git a/modules/Creator.pm b/modules/Creator.pm index 5c2f2ab6..af024214 100644 --- a/modules/Creator.pm +++ b/modules/Creator.pm @@ -66,7 +66,14 @@ my $onVMS = DirectoryManager::onVMS(); # ************************************************************ sub new { - my($class, $global, $inc, $template, $ti, $dynamic, $static, $relative, $addtemp, $addproj, $progress, $toplevel, $baseprojs, $feature, $features, $hierarchy, $nmodifier, $applypj, $into, $language, $use_env, $expandvars, $type) = @_; + my($class, $global, $inc, $template, + $ti, $dynamic, $static, $relative, + $addtemp, $addproj, $progress, + $toplevel, $baseprojs, $feature, + $features, $hierarchy, $nmodifier, + $applypj, $into, $language, $use_env, + $expandvars, $type) = @_; + my $self = Parser::new($class, $inc); $self->{'relative'} = $relative; @@ -105,7 +112,6 @@ sub new { return $self; } - sub preprocess_line { my($self, $fh, $line) = @_; @@ -195,7 +201,6 @@ sub generate { return $status; } - # split an inheritance list like ": a,b, c" into components sub parse_parents { my($parents, $errorStringRef, $statusRef) = @_; diff --git a/modules/Depgen/DependencyEditor.pm b/modules/Depgen/DependencyEditor.pm index 954dd5c9..9fd45f63 100644 --- a/modules/Depgen/DependencyEditor.pm +++ b/modules/Depgen/DependencyEditor.pm @@ -27,13 +27,14 @@ sub new { sub process { my($self, $output, $type, $noinline, $macros, - $ipaths, $replace, $exclude, $files) = @_; + $ipaths, $replace, $exclude, $files, + $append) = @_; ## Back up the original file and receive the contents my $contents; if (-s $output) { $contents = []; - if (!$self->backup($output, $contents)) { + if (!$self->backup($output, $contents, $append)) { print STDERR "ERROR: Unable to backup $output\n"; return 1; } @@ -48,13 +49,24 @@ sub process { } } - ## Write out the new dependency marker - print $fh "# DO NOT DELETE THIS LINE -- depgen.pl uses it.\n", - "# DO NOT PUT ANYTHING AFTER THIS LINE, IT WILL GO AWAY.\n\n"; + if (!$append) { + ## Write out the new dependency marker + print $fh "# DO NOT DELETE THIS LINE -- depgen.pl uses it.\n", + "# DO NOT PUT ANYTHING AFTER THIS LINE, IT WILL GO AWAY.\n\n"; + } + else { + ## Write start append comment + print $fh "# DO NOT DELETE THIS LINE -- depgen.pl appended ", + "the following.\n", + "# APPENDED DEPENDENCY RULES " , + "by depgen.pl.\n\n"; + } ## Generate the new dependencies and write them to the file my $dep = new DependencyGenerator($macros, $ipaths, $replace, - $type, $noinline, $exclude); + $type, $noinline, + $exclude); + ## Sort the files so the dependencies are reproducible foreach my $file (sort @$files) { ## In some situations we may be passed a directory as part of an @@ -77,13 +89,22 @@ sub process { sub backup { - my($self, $source, $contents) = @_; + my($self, $source, $contents, $append) = @_; my $status; my $fh = new FileHandle(); my $backup = "$source.bak"; ## Back up the file. While doing so, keep track of the contents of the - ## file and keep everything except the old dependencies. + ## file and keep everything except the old dependencies or keep + ## everything if appending. + my $search_string; + if (!$append) { + $search_string = 'DO NOT DELETE'; + } + else { + $search_string = 'IF YOU PUT ANYTHING HERE IT WILL GO AWAY'; + } + if (open($fh, $source)) { my $oh = new FileHandle(); if (open($oh, ">$backup")) { @@ -92,7 +113,7 @@ sub backup { while(<$fh>) { print $oh $_; if ($record) { - if (index($_, 'DO NOT DELETE') >= 0) { + if (index($_, $search_string) >= 0) { $record = undef; } else { diff --git a/modules/Depgen/Driver.pm b/modules/Depgen/Driver.pm index 27b8b7fd..a5e715aa 100644 --- a/modules/Depgen/Driver.pm +++ b/modules/Depgen/Driver.pm @@ -111,6 +111,7 @@ sub usageAndExit { print "-D This option sets a macro to an optional value.\n" . "-I The -I option adds an include directory.\n" . "-R Replace \$VARNAME paths with \$(VARNAME).\n" . + "-a Append to existing dependencies. Useful with -t gnuidl.\n" . "-e Exclude dependencies generated by <file>, but not <file> " . "itself.\n" . "-f Specifies the output file. This file will be edited if it " . @@ -157,7 +158,7 @@ sub run { my $type = $defaults{$os}; my $output = '-'; my $needsrc = 1; - my($noinline, @files, %macros, @ipaths, %replace, %exclude); + my($noinline, @files, %macros, @ipaths, %replace, %exclude, $append); for(my $i = 0; $i < $argc; ++$i) { my $arg = $$args[$i]; @@ -165,7 +166,25 @@ sub run { $macros{$1} = $3; } elsif ($arg =~ /^\-I(.*)/) { - push(@ipaths, File::Spec->canonpath($1)); + # support '-Idir' and '-I dir' + if ('' ne $1) { + push(@ipaths, File::Spec->canonpath($1)); + } + else { + # get next arg + if (++$i < $argc) { + $arg = $$args[$i]; + if ($arg =~ /^\-/) { + $self->usageAndExit('Invalid use of -I'); + } + + push(@ipaths, File::Spec->canonpath($arg)); + + } + else { + $self->usageAndExit('Invalid use of -I'); + } + } } elsif ($arg eq '-A') { foreach my $auto (@{$self->{'automatic'}}) { @@ -205,6 +224,9 @@ sub run { $self->usageAndExit('Invalid use of -f'); } } + elsif ($arg eq '-a') { + $append = 1; + } elsif ($arg eq '-i') { $needsrc = undef; } @@ -240,6 +262,6 @@ sub run { } my $editor = new DependencyEditor(); - return $editor->process($output, $type, $noinline, \%macros, - \@ipaths, \%replace, \%exclude, \@files); + return $editor->process($output, $type, $noinline, \%macros, \@ipaths, + \%replace, \%exclude, \@files, $append); } diff --git a/modules/Driver.pm b/modules/Driver.pm index 90da577d..b3ddc0f1 100644 --- a/modules/Driver.pm +++ b/modules/Driver.pm @@ -581,7 +581,11 @@ sub run { $options->{'expand_vars'}, $options->{'gendot'}, $options->{'comments'}, - $options->{'for_eclipse'}); + $options->{'for_eclipse'}, + $options->{'workers'}, + $options->{'workers_dir'}, + $options->{'workers_port'}); + mpc_debug::chkpnt_post_creator_create($name); ## Update settings based on the configuration file diff --git a/modules/Options.pm b/modules/Options.pm index b76f14e3..ae8aab3c 100644 --- a/modules/Options.pm +++ b/modules/Options.pm @@ -44,6 +44,7 @@ sub printUsage { $spaces . "[-apply_project] [-version] [-into <directory>]\n" . $spaces . "[-gfeature_file <file name>] [-nocomments]\n" . $spaces . "[-relative_file <file name>] [-for_eclipse]\n" . + $spaces . "[-workers <#>] [-workers_dir <dir> | -workers_port <#>]\n" . $spaces . "[-language <"; my $olen = length($spaces) + 12; @@ -157,6 +158,15 @@ sub printUsage { " -static Specifies that only static projects will be generated.\n", " By default, only dynamic projects are generated.\n", " -template Specifies the template name (with no extension).\n", +" -workers Specifies number of child processes to use to generate\n", +" projects.\n", +" -workers_dir The directory for storing temporary output files\n", +" from the child processes. The default is '/tmp/mpc'\n", +" If neither -workers_dir nor -workers_port is used,\n", +" -workers_dir is assumed.\n", +" -workers_port The port number for the parent listener. If neither\n", +" -workers_dir nor -workers_port is used, -workers_dir\n", +" is assumed.\n", " -ti Specifies the template input file (with no extension)\n", " for the specific type (ex. -ti dll_exe:vc8exe).\n", " -type Specifies the type of project file to generate. This\n", @@ -165,7 +175,7 @@ sub printUsage { " -use_env Use environment variables for all uses of \$() instead\n", " of the relative replacement values.\n", " -value_project This option allows modification of a project variable\n", -" assignment . Use += to add VAL to the NAME's value.\n", +" assignment. Use += to add VAL to the NAME's value.\n", " Use -= to subtract and = to override the value.\n", " This can be used to introduce new name value pairs to\n", " a project. However, it must be a valid project\n", @@ -262,6 +272,9 @@ sub options { my $genins = ($defaults ? 0 : undef); my $gendot = ($defaults ? 0 : undef); my $foreclipse = ($defaults ? 0 : undef); + my $workers = ($defaults ? 0 : undef); + my $workers_dir ; + my $workers_port; ## Process the command line arguments for(my $i = 0; $i <= $#args; $i++) { @@ -474,6 +487,41 @@ sub options { } } } + elsif ($arg eq '-workers') { + $i++; + $workers = $args[$i]; + + if (!defined $workers) { + $self->optionError('-workers requires an argument'); + } + } + elsif ($arg eq '-workers_dir') { + $i++; + $workers_dir = $args[$i]; + + if (!defined $workers_dir) { + $self->optionError('-workers_dir requires an argument'); + } + + if (! -d $workers_dir) { + $self->diagnostic("Creating temp directory $workers_dir"); + unless (mkdir $workers_dir) { + $self->optionError("Unable to create temp directory $workers_dir"); + } + } + } + elsif ($arg eq '-workers_port') { + $i++; + $workers_port = $args[$i]; + + if (!defined $workers_port) { + $self->optionError('-workers_port requires an argument'); + } + + if ($workers_port < 0 || $workers_port > 65535) { + $self->optionError('valid -workers_port range is between 0 and 65535'); + } + } elsif ($arg eq '-ti') { $i++; my $tmpi = $args[$i]; @@ -583,6 +631,9 @@ sub options { 'static' => $static, 'relative' => \%relative, 'reldefs' => $reldefs, + 'workers' => $workers, + 'workers_dir' => $workers_dir, + 'workers_port' => $workers_port, 'toplevel' => $toplevel, 'recurse' => $recurse, 'addtemp' => \%addtemp, diff --git a/modules/Parser.pm b/modules/Parser.pm index d722681d..6da79bf7 100644 --- a/modules/Parser.pm +++ b/modules/Parser.pm @@ -149,6 +149,7 @@ sub cached_file_read { $self->{'line_number'} = 0; foreach my $line (@$lines) { ++$self->{'line_number'}; + ## Since we're "reading" a cached file, we must pass undef as the ## file handle to parse_line(). ($status, $error) = $self->parse_line(undef, $line); diff --git a/modules/ProjectCreator.pm b/modules/ProjectCreator.pm index 7308e6e2..113902eb 100644 --- a/modules/ProjectCreator.pm +++ b/modules/ProjectCreator.pm @@ -22,6 +22,9 @@ use TemplateParser; use FeatureParser; use CommandHelper; +use Data::Dumper; +#use Tie::IxHash; + use vars qw(@ISA); @ISA = qw(Creator); @@ -299,7 +302,7 @@ my %mains; # ************************************************************ sub new { - my($class, $global, $inc, $template, $ti, $dynamic, $static, $relative, $addtemp, $addproj, $progress, $toplevel, $baseprojs, $gfeature, $relative_f, $feature, $features, $hierarchy, $exclude, $makeco, $nmod, $applypj, $genins, $into, $language, $use_env, $expandvars, $gendot, $comments, $foreclipse) = @_; + my($class, $global, $inc, $template, $ti, $dynamic, $static, $relative, $addtemp, $addproj, $progress, $toplevel, $baseprojs, $gfeature, $relative_f, $feature, $features, $hierarchy, $exclude, $makeco, $nmod, $applypj, $genins, $into, $language, $use_env, $expandvars, $gendot, $comments, $foreclipse, $pid) = @_; my $self = $class->SUPER::new($global, $inc, $template, $ti, $dynamic, $static, $relative, $addtemp, $addproj, @@ -351,6 +354,9 @@ sub new { $self->add_default_matching_assignments(); $self->reset_generating_types(); + $self->{'pid'} = $pid; + $self->{'llctr'} = 0; # counts the hash insertion order for mp-mpc + return $self; } @@ -872,8 +878,16 @@ sub parse_line { elsif (index($cwd, $start) == 0) { $amount = length($start) + 1; } - $self->{'lib_locations'}->{$val} = + if ($self->{'pid'} eq 'child') { + $self->{'lib_locations'}->{$val} = + ++$self->{'llctr'} . '|' . substr($cwd, $amount); + } + else { + + $self->{'lib_locations'}->{$val} = + substr($cwd, $amount); + } last; } } @@ -1475,6 +1489,10 @@ sub parse_components { } $$comps{$current} = [] if (!defined $$comps{$current}); + # preserve order + #tie %$names, "Tie::IxHash"; + #tie %$comps, "Tie::IxHash"; + my $count = 0; while(<$fh>) { my $line = $self->preprocess_line($fh, $_); @@ -2571,7 +2589,6 @@ sub add_generated_files { ## This method is called by list_default_generated. It performs the ## actual file insertion and grouping. - ## Get the generated filenames my @added; foreach my $file (keys %$arr) { @@ -3320,6 +3337,8 @@ sub list_default_generated { if (defined $self->{$gentype}) { ## Build up the list of files my %arr; + #tie %arr, "Tie::IxHash"; # preserve insertion order. + my $names = $self->{$gentype}; my $group; foreach my $name (keys %$names) { @@ -4999,7 +5018,6 @@ sub write_project { if (!$status) { return $status, $error; } - ## We don't need to pass a file name here. write_output_file() ## will determine the file name for itself. ($status, $error) = $self->write_output_file($webapp); @@ -5034,7 +5052,22 @@ sub get_project_info { sub get_lib_locations { - return $_[0]->{'lib_locations'}; + if ($_[0]->{'pid'} eq 'child') { + my $lib_locs; + for my $k (sort { substr($a, 0 , index ($a, '|')) <=> + substr ($b, 0, index ($b, '|')) } keys %{$_[0]->{'lib_locations'}}) { + + # if we are a worker, we need to strip leading 'number|' + my $x = $_[0]->{'lib_locations'}->{$k}; + $x =~ s/\d+\|//; + + $lib_locs->{substr ($k, index ($k, '|') + 1)} = $x; + } + return $lib_locs + } + else { + return $_[0]->{'lib_locations'}; + } } diff --git a/modules/TemplateParser.pm b/modules/TemplateParser.pm index 83eb7065..3a429dfe 100644 --- a/modules/TemplateParser.pm +++ b/modules/TemplateParser.pm @@ -104,6 +104,10 @@ my %arrow_op_ref = ('custom_type' => 'custom types', 'feature' => 'features', ); +# optmized regex +my $parse_line_re1 = qr/^[ ]*<%(\w+)(?:\((?:(?:\w+\s*,\s*)*[!]?\w+\(.+\)|[^\)]+)\))?%>$/; +my $process_name_re1 = qr/([^%\(]+)(\(([^%]+)\))?%>/; + # ************************************************************ # Subroutine Section # ************************************************************ @@ -1990,7 +1994,7 @@ sub process_name { my $errorString; ## Split the line into a name and value - if ($line =~ /([^%\(]+)(\(([^%]+)\))?%>/) { + if ($line =~ /$process_name_re1/) { my $name = lc($1); my $val = $3; $length += length($name); @@ -2168,8 +2172,7 @@ sub parse_line { ## contains a keyword, then we do ## not need to add a newline to the end. if ($self->{'foreach'}->{'processing'} == 0 && !$self->{'eval'} && - ($line !~ /^[ ]*<%(\w+)(?:\((?:(?:\w+\s*,\s*)*[!]?\w+\(.+\)|[^\)]+)\))?%>$/ || - !defined $keywords{$1})) { + ($line !~ /$parse_line_re1/ || !defined $keywords{$1})) { $line .= $self->{'crlf'}; } diff --git a/modules/WorkspaceCreator.pm b/modules/WorkspaceCreator.pm index d8bfb489..45f089b8 100644 --- a/modules/WorkspaceCreator.pm +++ b/modules/WorkspaceCreator.pm @@ -19,6 +19,9 @@ use Creator; use Options; use WorkspaceHelper; +use IO::Socket; +use Data::Dumper; + use vars qw(@ISA); @ISA = qw(Creator Options); @@ -26,6 +29,11 @@ use vars qw(@ISA); # Data Section # ************************************************************ +## process stuff +our $num_workers = 0; # single-process +our $wdir; # tmp directory +our $wport; + my $wsext = 'mwc'; my $wsbase = 'mwb'; @@ -52,7 +60,14 @@ my $onVMS = DirectoryManager::onVMS(); # ************************************************************ sub new { - my($class, $global, $inc, $template, $ti, $dynamic, $static, $relative, $addtemp, $addproj, $progress, $toplevel, $baseprojs, $gfeature, $relative_f, $feature, $features, $hierarchy, $exclude, $makeco, $nmod, $applypj, $genins, $into, $language, $use_env, $expandvars, $gendot, $comments, $foreclipse) = @_; + my($class, $global, $inc, $template, $ti, $dynamic, + $static, $relative, $addtemp, $addproj, $progress, + $toplevel, $baseprojs, $gfeature, $relative_f, $feature, + $features, $hierarchy, $exclude, $makeco, $nmod, $applypj, + $genins, $into, $language, $use_env, $expandvars, $gendot, + $comments, $foreclipse, $workers, $workers_dir, + $workers_port) = @_; + my $self = Creator::new($class, $global, $inc, $template, $ti, $dynamic, $static, $relative, $addtemp, $addproj, @@ -62,6 +77,12 @@ sub new { $into, $language, $use_env, $expandvars, 'workspace'); + $self->{'pid'} = 'parent'; + + # implicit dependency order counter. this is + # incremented in the children. + $self->{'imp_dep_ctr'}; + ## These need to be reset at the end of each ## workspace processed within a .mwc file $self->{'workspace_name'} = undef; @@ -92,6 +113,7 @@ sub new { ## These are static throughout processing $self->{'coexistence'} = $self->requires_make_coexistence() ? 1 : $makeco; $self->{'for_eclipse'} = $foreclipse; + $self->{'workers'} = $workers; $self->{'generate_dot'} = $gendot; $self->{'generate_ins'} = $genins; $self->{'verbose_ordering'} = $self->default_verbose_ordering(); @@ -105,8 +127,7 @@ sub new { } push(@{$self->{'exclude'}->{$type}}, @$exclude); $self->{'orig_exclude'} = $self->{'exclude'}; - } - else { + } else { $self->{'orig_exclude'} = {}; } @@ -124,9 +145,16 @@ sub new { $self->warning("Using the -make_coexistence option has " . "no effect on the " . $self->{'wctype'} . " type."); } + + ## multi-process config + $num_workers = $workers if $workers > $num_workers; + $wdir = $workers_dir; + $wport = $workers_port; + return $self; } + sub default_cacheok { return 1; } @@ -158,12 +186,69 @@ sub parse_line { ## End of workspace; Have subclass write out the file ## Generate the project files - my($gstat, $creator, $err) = $self->generate_project_files(); + my($gstat, $creator, $err); + if ($num_workers > 0) { + if (!defined ($wport)) { + ## use temp files for multiprocess mpc + ## Lock the temp directory before generating project files. + my $lock = 'mpc-worker.lock'; + + ## check for valid temp directory + if (!$wdir) { + if ($^O eq 'MSWin32') { + $wdir = $ENV{TEMP}; + } + else { + $wdir = '/tmp/mpc'; + } + } + + ## shouldn't happen + if (!$wdir) { + die "Error: No temporary directory found. Supply one with \"-worker_dir\" option.\n"; + } + + $self->diagnostic("Multiprocess MPC using \"$wdir\" for temporary files."); + + unless (-d $wdir) { + mkdir $wdir || die "Error: Can't find or create directory $wdir\n" + } + + ## lock the directory + if (-e "$wdir/$lock") { + die "Error: Another instance of MPC is using $wdir, or a previous session failed to remove the lock file $lock\n"; + } + else { + open (FDL, ">$wdir/$lock") || die "Error reating lock file $lock in $wdir\n"; + print FDL "File generated by MPC process ", $$, " on ", scalar (localtime(time())), "\n"; + close FDL; + + $self->diagnostic("Multiprocess MPC created lock file $wdir/$lock"); + } + + ## generate the project files + ($gstat, $creator, $err) = $self->generate_project_files_fork(); + + ## Release temp directory lock; + if (!unlink("$wdir/$lock")) { + $self->error("Multiprocess MPC unable to remove lock file $wdir/$lock"); + } + else { + $self->diagnostic("Multiprocess MPC removed $wdir/$lock"); + } + + } else { + ## Socket-based Multiprocess MPC + ($gstat, $creator, $err) = $self->generate_project_files_fork_socket(); + } + } else { + ($gstat, $creator, $err) = $self->generate_project_files(); + } if ($gstat) { + #exit(1); ($status, $error) = $self->write_workspace($creator, 1); $self->{'assign'} = {}; - } - else { + } else { $error = $err; $status = 0; } @@ -181,8 +266,7 @@ sub parse_line { $self->{'mpc_to_output'} = {}; } $self->{$self->{'type_check'}} = 0; - } - else { + } else { ## Workspace Beginning ## Deal with the inheritance hierarchy first if (defined $values[2]) { @@ -199,8 +283,7 @@ sub parse_line { pop(@{$self->{'reading_parent'}}); $error = "Invalid parent: $parent" if (!$status); - } - else { + } else { $status = 0; $error = "Unable to locate parent: $parent"; } @@ -212,17 +295,16 @@ sub parse_line { if ($name =~ /[\/\\]/) { $status = 0; $error = 'Workspaces can not have a slash ' . - 'or a back slash in the name'; - } - else { + 'or a back slash in the name'; + } else { $name =~ s/^\(\s*//; $name =~ s/\s*\)$//; ## Replace any *'s with the default name if (index($name, '*') >= 0) { $name = $self->fill_type_name( - $name, - $self->get_default_workspace_name()); + $name, + $self->get_default_workspace_name()); } $self->{'workspace_name'} = $name; @@ -230,17 +312,14 @@ sub parse_line { } $self->{$self->{'type_check'}} = 1; } - } - elsif ($values[0] eq '0') { + } elsif ($values[0] eq '0') { if (defined $validNames{$values[1]}) { $self->process_assignment($values[1], $values[2], $flags); - } - else { + } else { $error = "Invalid assignment name: '$values[1]'"; $status = 0; } - } - elsif ($values[0] eq '1') { + } elsif ($values[0] eq '1') { if (defined $validNames{$values[1]}) { ## This code only runs when there is a non-scoped assignment. As ## such, we can safely replace all environment variables here so @@ -248,47 +327,40 @@ sub parse_line { ## workspaces. $self->replace_env_vars(\$values[2]) if ($values[2] =~ /\$/); $self->process_assignment_add($values[1], $values[2], $flags); - } - else { + } else { $error = "Invalid addition name: $values[1]"; $status = 0; } - } - elsif ($values[0] eq '-1') { + } elsif ($values[0] eq '-1') { if (defined $validNames{$values[1]}) { $self->process_assignment_sub($values[1], $values[2], $flags); - } - else { + } else { $error = "Invalid subtraction name: $values[1]"; $status = 0; } - } - elsif ($values[0] eq 'component') { + } elsif ($values[0] eq 'component') { my %copy = %{defined $flags ? $flags : $self->get_assignment_hash()}; ($status, $error) = $self->parse_scope($ih, $values[1], $values[2], \%validNames, \%copy); - } - else { + } else { $error = "Unrecognized line: $line"; $status = 0; } - } - elsif ($status == -1) { + } elsif ($status == -1) { ## If the line contains a variable, try to replace it with an actual ## value. $line = $self->relative($line) if (index($line, '$') >= 0); foreach my $expfile ($line =~ /[\?\*\[\]]/ ? $self->mpc_glob($line) : - $line) { + $line) { if ($expfile =~ /\.$wsext$/) { my %copy = %{defined $flags ? $flags : $self->get_assignment_hash()}; ($status, $error) = $self->aggregated_workspace($expfile, \%copy); last if (!$status); - } - else { + } else { push(@{$self->{'project_files'}}, $expfile); $status = 1; } @@ -323,7 +395,7 @@ sub aggregated_workspace { ## not match up with itself later on where scoped_basedir is used. $self->{'scoped_basedir'} = undef if ($self->{'scoped_basedir'} eq '.'); - while(<$fh>) { + while (<$fh>) { my $line = $self->preprocess_line($fh, $_); ($status, $error, @values) = $self->parse_known($line, $fh); @@ -336,24 +408,21 @@ sub aggregated_workspace { $name =~ s/\.[^\.]+$//; $status = 0; $error = 'Aggregated workspace (' . $name . - ') can not inherit from another workspace'; - } - else { + ') can not inherit from another workspace'; + } else { ($status, $error) = $self->parse_scope($fh, '', $aggregated, \%validNames, $flags); } - } - else { + } else { $status = 0; $error = 'Unable to aggregate ' . $file; } last; } - } - else { + } else { last; } } @@ -361,7 +430,7 @@ sub aggregated_workspace { if ($status) { $self->{'aggregated_assign'}->{$file} = - $self->clone($self->get_assignment_hash()); + $self->clone($self->get_assignment_hash()); $self->{'assign'} = $prev_assign; } @@ -387,14 +456,11 @@ sub parse_scope { if ($name eq 'exclude') { return $self->parse_exclude($fh, $type, $flags); - } - elsif ($name eq 'associate') { + } elsif ($name eq 'associate') { return $self->parse_associate($fh, $type); - } - elsif ($name eq 'specific') { + } elsif ($name eq 'specific') { return $self->parse_specific($fh, $type, $validNames, $flags, $elseflags); - } - else { + } else { return $self->SUPER::parse_scope($fh, $name, $type, $validNames, $flags, $elseflags); } @@ -418,8 +484,7 @@ sub process_types { ## Remove the original property from the types. delete $types{$key}; - } - elsif ($key =~ /^!prop:\s*(\w+)/) { + } elsif ($key =~ /^!prop:\s*(\w+)/) { ## Negate the property. $props{$1} = 0; @@ -437,12 +502,10 @@ sub process_types { if (exists $$wcprops{$key}) { if ($$wcprops{$key} == 1 and $$wcprops{$key} == $val) { $types{$self->{wctype}} = 1; - } - else { + } else { delete $types{$self->{wctype}}; } - } - elsif ($val == 0) { + } elsif ($val == 0) { $types{$self->{wctype}} = 1; } } @@ -473,31 +536,26 @@ sub parse_exclude { my @exclude; if (exists $$types{$self->{wctype}}) { - while(<$fh>) { + while (<$fh>) { my $line = $self->preprocess_line($fh, $_); if ($line eq '') { - } - elsif ($line =~ /^}(.*)$/) { + } elsif ($line =~ /^}(.*)$/) { --$count; if (defined $1 && $1 ne '') { $status = 0; $errorString = "Trailing characters found: '$1'"; - } - else { + } else { $status = 1; $errorString = undef; } last if ($count == 0); - } - else { + } else { if ($line =~ /^(\w+)\s*(\([^\)]+\))?\s*{$/) { ++$count; - } - elsif ($self->parse_assignment($line, [], $fh)) { + } elsif ($self->parse_assignment($line, [], $fh)) { ## Ignore all assignments - } - else { + } else { if ($line =~ /^"([^"]+)"$/) { $line = $1; } @@ -512,8 +570,7 @@ sub parse_exclude { } if ($line =~ /[\?\*\[\]]/) { push(@exclude, $self->mpc_glob($line)); - } - else { + } else { push(@exclude, $line); } } @@ -526,32 +583,28 @@ sub parse_exclude { } push(@{$self->{'exclude'}->{$type}}, @exclude); } - } - else { + } else { if ($negated) { ($status, $errorString) = $self->SUPER::parse_scope($fh, 'exclude', $typestr, \%validNames, $flags); - } - else { + } else { ## If this exclude block didn't match the current type and the ## exclude wasn't negated, we need to eat the exclude block so that ## these lines don't get included into the workspace. - while(<$fh>) { + while (<$fh>) { my $line = $self->preprocess_line($fh, $_); if ($line =~ /^(\w+)\s*(\([^\)]+\))?\s*{$/) { ++$count; - } - elsif ($line =~ /^}(.*)$/) { + } elsif ($line =~ /^}(.*)$/) { --$count; if (defined $1 && $1 ne '') { $status = 0; $errorString = "Trailing characters found: '$1'"; - } - else { + } else { $status = 1; $errorString = undef; } @@ -576,33 +629,28 @@ sub parse_associate { $self->{'associated'}->{$assoc_key} = {}; } - while(<$fh>) { + while (<$fh>) { my $line = $self->preprocess_line($fh, $_); if ($line eq '') { - } - elsif ($line =~ /^}(.*)$/) { + } elsif ($line =~ /^}(.*)$/) { --$count; if (defined $1 && $1 ne '') { $errorString = "Trailing characters found: '$1'"; last; - } - else { + } else { $status = 1; $errorString = undef; } last if ($count == 0); - } - else { + } else { if ($line =~ /^(\w+)\s*(\([^\)]+\))?\s*{$/) { ++$count; - } - elsif ($self->parse_assignment($line, [], $fh)) { + } elsif ($self->parse_assignment($line, [], $fh)) { $errorString = 'Assignments are not ' . - 'allowed within an associate scope'; + 'allowed within an associate scope'; last; - } - else { + } else { if ($line =~ /^"([^"]+)"$/) { $line = $1; } @@ -619,8 +667,7 @@ sub parse_associate { foreach my $file ($self->mpc_glob($line)) { $self->{'associated'}->{$assoc_key}->{$file} = 1; } - } - else { + } else { $self->{'associated'}->{$assoc_key}->{$line} = 1; } } @@ -715,8 +762,7 @@ sub handle_scoped_unknown { $self->{$self->{'type_check'}} = 1; ($status, $error, @values) = $self->parse_line($fh, $line, $flags); $self->{$self->{'type_check'}} = $tc; - } - else { + } else { $status = 0; $error = 'Unhandled line: ' . $line; } @@ -727,13 +773,11 @@ sub handle_scoped_unknown { ## value. if (index($line, '$') >= 0) { $line = $self->relative($line); - } - elsif (defined $self->{'scoped_basedir'}) { + } elsif (defined $self->{'scoped_basedir'}) { if ($self->path_is_relative($line)) { if ($line eq '.') { $line = $self->{'scoped_basedir'}; - } - else { + } else { ## This is a relative path and the project may have been added ## previously without a relative path. We need to convert the ## relative path into an absolute path and, if possible, remove @@ -783,7 +827,7 @@ sub handle_scoped_unknown { do { $exc = $self->mpc_dirname($exc); $remove{$exc} = 1; - } while($exc ne '.' && $exc !~ /[a-z]:[\/\\]/i); + } while ($exc ne '.' && $exc !~ /[a-z]:[\/\\]/i); } } @@ -797,16 +841,14 @@ sub handle_scoped_unknown { foreach my $file (@files) { $self->add_aggregated_mpc($file, $dupchk, $flags); } - } - else { + } else { foreach my $expfile ($line =~ /[\?\*\[\]]/ ? $self->mpc_glob($line) : - $line) { + $line) { if ($expfile =~ /\.$wsext$/) { ## An aggregated workspace within an aggregated workspace or scope. ($status, $error) = $self->aggregated_workspace($expfile, $flags); last if (!$status); - } - else { + } else { $self->add_aggregated_mpc($expfile, $dupchk, $flags); } } @@ -823,8 +865,7 @@ sub add_aggregated_mpc { if (defined $dupchk && exists $$dupchk{$file}) { $self->information("Duplicate mpc file ($file) added by an " . 'aggregate workspace. It will be ignored.'); - } - else { + } else { $self->{'scoped_assign'}->{$file} = $flags; push(@{$self->{'project_files'}}, $file); push(@{$self->{'aggregated_mpc'}->{$self->{'current_aggregated'}}}, @@ -841,9 +882,9 @@ sub search_for_files { foreach my $file (@$files) { if (-d $file) { my @f = $self->generate_default_file_list( - $file, - $self->{'exclude'}->{$self->{'wctype'}}, - \$excluded); + $file, + $self->{'exclude'}->{$self->{'wctype'}}, + \$excluded); $self->search_for_files(\@f, $array, $impl); if ($impl) { $file =~ s/^\.\///; @@ -853,8 +894,7 @@ sub search_for_files { unshift(@$array, $file); } - } - elsif ($file =~ /\.mpc$/) { + } elsif ($file =~ /\.mpc$/) { $file =~ s/^\.\///; # Strip out ^ symbols @@ -872,7 +912,7 @@ sub remove_duplicate_projects { my($self, $list) = @_; my $count = scalar(@$list); - for(my $i = 0; $i < $count; ++$i) { + for (my $i = 0; $i < $count; ++$i) { my $file = $$list[$i]; foreach my $inner (@$list) { if ($file ne $inner && @@ -899,15 +939,14 @@ sub generate_default_components { if (-d $file) { my @found; my @gen = $self->generate_default_file_list( - $file, - $self->{'exclude'}->{$self->{'wctype'}}); + $file, + $self->{'exclude'}->{$self->{'wctype'}}); $self->search_for_files(\@gen, \@found, $impl); push(@built, @found); if ($impl || $self->{'scoped_assign'}->{$file}->{'implicit'}) { push(@built, $file); } - } - else { + } else { push(@built, $file); } } @@ -919,8 +958,7 @@ sub generate_default_components { ## Set the project files $self->{'project_files'} = \@built; - } - else { + } else { ## Add all of the wanted files in this directory ## and in the subdirectories. $excluded |= $self->search_for_files($files, $pjf, $impl); @@ -943,8 +981,7 @@ sub get_default_workspace_name { if ($name eq '') { $name = $self->base_directory(); - } - else { + } else { ## Since files on UNIX can have back slashes, we transform them ## into underscores. $name =~ s/\\/_/g; @@ -980,9 +1017,9 @@ sub generate_defaults { my $excluded = 0; my @files = $self->generate_default_file_list( - '.', - $self->{'exclude'}->{$self->{'wctype'}}, - \$excluded); + '.', + $self->{'exclude'}->{$self->{'wctype'}}, + \$excluded); ## Generate default components $self->generate_default_components(\@files, @@ -1036,8 +1073,7 @@ sub write_and_compare_file { close($fh); $different = 0 if ($status && !$self->files_are_different($name, $tmp)); - } - else { + } else { $status = 0; $errorString = "Unable to open $tmp for output."; } @@ -1050,19 +1086,16 @@ sub write_and_compare_file { $status = 0; $errorString = "Unable to open $name for output"; } - } - else { + } else { ## There is no need to rename, so remove our temp file. unlink($tmp); } } - } - else { + } else { if (open($fh, ">$name")) { &$func($self, $fh, @params); close($fh); - } - else { + } else { $status = 0; $errorString = "Unable to open $name for output."; } @@ -1072,12 +1105,14 @@ sub write_and_compare_file { } sub write_workspace { + my($self, $creator, $addfile) = @_; my $status = 1; my $errorString; my $duplicates = 0; if ($self->get_toplevel()) { + ## There is usually a progress indicator callback provided, but if ## the output is being redirected, there will be no progress ## indicator. @@ -1085,6 +1120,7 @@ sub write_workspace { &$progress() if (defined $progress); if ($addfile) { + ## To be consistent across multiple project types, we disallow ## duplicate project names for all types, not just VC6. ## Note that these name are handled case-insensitive by VC6 @@ -1097,13 +1133,11 @@ sub write_workspace { "Look in " . $self->mpc_dirname($project) . " and " . $self->mpc_dirname($names{$name}) . " for project name conflicts."); - } - else { + } else { $names{$name} = $project; } } - } - else { + } else { $self->{'per_project_workspace_name'} = 1; } @@ -1113,10 +1147,9 @@ sub write_workspace { if ($duplicates > 0) { $abort_creation = 1; $errorString = "Duplicate case-insensitive project names are " . - "not allowed within a workspace."; + "not allowed within a workspace."; $status = 0; - } - else { + } else { if (!defined $self->{'projects'}->[0]) { $self->information('No projects were created.'); $abort_creation = 1; @@ -1131,21 +1164,21 @@ sub write_workspace { if ($addfile || !$self->file_written($name)) { ($status, $errorString) = $self->write_and_compare_file( - undef, $name, - sub { - my($self, $fh) = @_; - $self->pre_workspace($fh, $creator, $addfile); - my($status, $errorString) = $self->write_comps($fh, $creator, $addfile); - ## If write_comps() does't return a status, set status to true. - $status = 1 if (!defined $status || $status eq ""); - if ($status) { - my $wsHelper = WorkspaceHelper::get($self); - $wsHelper->perform_custom_processing($fh, $creator, $addfile); - - $self->post_workspace($fh, $creator, $addfile); - } - return $status, $errorString; - }); + undef, $name, + sub { + my($self, $fh) = @_; + $self->pre_workspace($fh, $creator, $addfile); + my($status, $errorString) = $self->write_comps($fh, $creator, $addfile); + ## If write_comps() does't return a status, set status to true. + $status = 1 if (!defined $status || $status eq ""); + if ($status) { + my $wsHelper = WorkspaceHelper::get($self); + $wsHelper->perform_custom_processing($fh, $creator, $addfile); + + $self->post_workspace($fh, $creator, $addfile); + } + return $status, $errorString; + }); $self->add_file_written($name) if ($status && $addfile); } @@ -1171,15 +1204,14 @@ sub write_workspace { my $pname = $self->{'project_info'}->{$project}->[ProjectCreator::PROJECT_NAME]; foreach my $number (@{$targnum{$project}}) { print $dh " $pname -> ", - $self->{'project_info'}->{$list[$number]}->[ProjectCreator::PROJECT_NAME], - ";\n"; + $self->{'project_info'}->{$list[$number]}->[ProjectCreator::PROJECT_NAME], + ";\n"; } } } print $dh "}\n"; close($dh); - } - else { + } else { $self->warning("Unable to write to $wsname.dot."); } } @@ -1251,8 +1283,7 @@ sub generate_hierarchy { $current = $top; push(@saved, $rest); $sinfo{$rest} = $projinfo{$prj}; - } - elsif ($top ne $current) { + } elsif ($top ne $current) { if ($current ne '.') { ## Write out the hierachical workspace $self->cd($current); @@ -1272,8 +1303,7 @@ sub generate_hierarchy { @saved = ($rest); %sinfo = (); $sinfo{$rest} = $projinfo{$prj}; - } - else { + } else { push(@saved, $rest); $sinfo{$rest} = $projinfo{$prj}; } @@ -1293,7 +1323,6 @@ sub generate_hierarchy { return $status, $errorString; } - sub generate_project_files { my $self = shift; my $status = (scalar @{$self->{'project_files'}} == 0 ? 1 : 0); @@ -1304,13 +1333,15 @@ sub generate_project_files { my $cwd = $self->getcwd(); my $impl = $self->get_assignment('implicit'); my $postkey = $creator->get_dynamic() . - $creator->get_static() . "-$self"; + $creator->get_static() . "-$self"; my $previmpl = $impl; my $prevcache = $self->{'cacheok'}; my %gstate = $creator->save_state(); my $genimpdep = $self->generate_implicit_project_dependencies(); my $errorString; + $Data::Dumper::Indent = 0; + ## Save this project creator setting for later use in the ## number_target_deps() method. $self->{'dependency_is_filename'} = $creator->dependency_is_filename(); @@ -1369,7 +1400,7 @@ sub generate_project_files { ## Generate the key for this project file my $prkey = $self->getcwd() . '/' . - ($file eq '' ? $dir : $file) . "-$postkey"; + ($file eq '' ? $dir : $file) . "-$postkey"; ## We must change to the subdirectory for ## which this project file is intended @@ -1381,10 +1412,10 @@ sub generate_project_files { $files_written = $allprojects{$prkey}; $gen_proj_info = $allprinfo{$prkey}; $gen_lib_locs = $allliblocs{$prkey}; + $status = 1; - } - else { - $status = $creator->generate($self->mpc_basename($file)); + } else { + $status = $creator->generate($self->mpc_basename($file)); ## If any one project file fails, then stop ## processing altogether. @@ -1392,7 +1423,7 @@ sub generate_project_files { ## We don't restore the state before we leave, ## but that's ok since we will be exiting right now. return $status, $creator, - "Unable to process " . ($file eq '' ? " in $dir" : $file); + "Unable to process " . ($file eq '' ? " in $dir" : $file); } ## Get the individual project information and @@ -1413,8 +1444,7 @@ sub generate_project_files { $self->save_project_info($files_written, $gen_proj_info, $gen_lib_locs, $dir, \@projects, \%pi, \%liblocs); - } - else { + } else { ## Unable to change to the directory. ## We don't restore the state before we leave, ## but that's ok since we will be exiting soon. @@ -1427,11 +1457,11 @@ sub generate_project_files { $self->{'cacheok'} = $prevcache; $creator->restore_state(\%gstate); } - } - else { + } else { ## This one was excluded, so status is ok $status = 1; } + } ## Add implict project dependencies based on source files @@ -1440,6 +1470,7 @@ sub generate_project_files { ## in generate_hierarchy() for each workspace. $self->{'projects'} = \@projects; $self->{'project_info'} = \%pi; + if ($status && $genimpdep) { $self->add_implicit_project_dependencies($creator, $cwd); } @@ -1459,6 +1490,731 @@ sub generate_project_files { return $status, $creator, $errorString; } +sub generate_project_files_fork { + my $self = shift; + my $status = (scalar @{$self->{'project_files'}} == 0 ? 1 : 0); + + my @projects; + my %pi; + my %liblocs; + + my $creator = $self->project_creator('child'); + my $cwd = $self->getcwd(); + my $impl = $self->get_assignment('implicit'); + my $postkey = $creator->get_dynamic() . + $creator->get_static() . "-$self"; + my $previmpl = $impl; + my $prevcache = $self->{'cacheok'}; + my %gstate = $creator->save_state(); + my $genimpdep = $self->generate_implicit_project_dependencies(); + my $errorString; + + my @save; + my $VAR1; + $Data::Dumper::Indent = 0; + + ## Save this project creator setting for later use in the + ## number_target_deps() method. + $self->{'dependency_is_filename'} = $creator->dependency_is_filename(); + + ## Remove the address portion of the $self string + $postkey =~ s/=.*//; + + ## Set the source file callback on our project creator + $creator->set_source_listing_callback([\&source_listing_callback, $self]); + + my $pid; + my @pids; + my $tmp = 'mpctmp00000000'; + + ## remove old temp files + my @tmpfiles = glob "${wdir}/mpctmp*"; + for my $file (@tmpfiles) { + unlink $file || die "Error: Unable to delete tmp file $file in directory $wdir"; + } + + my $num_tmp_files = scalar (@tmpfiles); + + $self->diagnostic("Multiprocess MPC removed $num_tmp_files existing files like \"mpctmp\*\" in $wdir."); + + foreach my $ofile (@{$self->{'project_files'}}) { + if ($#pids + 1 >= $num_workers) { + waitpid(shift @pids, 0); + } + + ++$tmp; + + ## open the output file in parent so it can die if there's an error + open (FD, ">${wdir}/$tmp") || die "Can't open $tmp for write"; + + $pid = fork(); + if ($pid != 0) { + push @pids, $pid; + } else { + $self->{'pid'} = 'child'; + + if (!$self->excluded($ofile)) { + my $file = $ofile; + my $dir = $self->mpc_dirname($file); + my $restore = 0; + + if (defined $self->{'scoped_assign'}->{$ofile}) { + ## Handle the implicit assignment + my $oi = $self->{'scoped_assign'}->{$ofile}->{'implicit'}; + if (defined $oi) { + $previmpl = $impl; + $impl = $oi; + } + + ## Handle the cmdline assignment + my $cmdline = $self->{'scoped_assign'}->{$ofile}->{'cmdline'}; + if (defined $cmdline && $cmdline ne '') { + ## Save the cacheok value + $prevcache = $self->{'cacheok'}; + + ## Get the current parameters and process the command line + my %parameters = $self->current_parameters(); + $self->process_cmdline($cmdline, \%parameters); + + ## Set the parameters on the creator + $creator->restore_state(\%parameters); + $restore = 1; + } + } + + ## If we are generating implicit projects and the file is a + ## directory, then we set the dir to the file and empty the file + if ($impl && -d $file) { + $dir = $file; + $file = ''; + + ## If the implicit assignment value was not a number, then + ## we will add this value to our base projects. + if ($impl !~ /^\d+$/) { + my $bps = $creator->get_baseprojs(); + push(@$bps, split(/\s+/, $impl)); + $restore = 1; + $self->{'cacheok'} = 0; + } + } + + ## Generate the key for this project file + my $prkey = $self->getcwd() . '/' . + ($file eq '' ? $dir : $file) . "-$postkey"; + + ## We must change to the subdirectory for + ## which this project file is intended + + if ($self->cd($dir)) { + my $files_written = []; + my $gen_proj_info = []; + my $gen_lib_locs = {}; + + if ($self->{'cacheok'} && defined $allprojects{$prkey}) { + $files_written = $allprojects{$prkey}; + $gen_proj_info = $allprinfo{$prkey}; + $gen_lib_locs = $allliblocs{$prkey}; + + $status = 1; + } else { + $status = $creator->generate($self->mpc_basename($file)); + + ## If any one project file fails, then stop + ## processing altogether. + if (!$status) { + # save the status info and exit. the parent will + # see the error. + print FD "$status|Unable to process " . + ($file eq '' ? " in $dir" : $file) . "\n"; + + exit(1); # child error + } + + ## Get the individual project information and + ## generated file name(s) + $files_written = $creator->get_files_written(); + $gen_proj_info = $creator->get_project_info(); + $gen_lib_locs = $creator->get_lib_locations(); + + } + + + print FD "$status|''|$self->{'cacheok'}|$previmpl|$prevcache\n"; + print FD "$ofile|$prkey|$dir|$cwd|$restore\n"; + + print FD Dumper ($files_written), "\n"; + print FD Dumper ($gen_proj_info), "\n"; + print FD Dumper ($gen_lib_locs), "\n"; + + # there's a callback that sets the project file list + # since we can't callback between processes we store + # the list for later + print FD Dumper ($self->{'project_file_list'}), "\n"; + + } else { + ## Unable to change to the directory. + ## We don't restore the state before we leave, + ## but that's ok since we will be exiting soon. + print FD "$status|Unable to change directory to $dir\n"; + + exit (1); # child error + } + + } else { + ## This one was excluded, so status is ok + ## no need to set though since the child will exit. + #$status = 1; + } + + exit(0); # child is finished + } + } + + for $pid (@pids) { + # this will also reap any zombies + waitpid($pid, 0); + } + + my ($msg, $cacheok, $ofile, $prkey, $dir, $restore); + + # read the children's stored data + my @kid_data = glob "${wdir}/mpctmp*"; + + for my $kd (@kid_data) { + open (FD, "<$kd") || die "Can't open $kd for read"; + + ($status, $msg, $cacheok, $previmpl, $prevcache) = split /\|/, <FD>; + + if (!$status) { + return $status, $creator, $msg; + } + + ($ofile, $prkey, $dir, $cwd, $restore) = split /\|/, <FD>; + + eval (<FD>); + my $files_written = $VAR1; + + eval (<FD>); + my $gen_proj_info = $VAR1; + + # have to reconstitute gen_lib_locs in the same order it was + # created or else multi-process implicit dependency may differ from + # single process. + eval (<FD>); + my $gen_lib_locs; + for my $k (sort { substr($a, 0 , index ($a, '|')) <=> + substr ($b, 0, index ($b, '|')) } keys %$VAR1) { + + $gen_lib_locs->{substr ($k, index ($k, '|') + 1)} = + $VAR1->{$k}; + } + + # have to reconstitute project_file_list in the same order it was + # created or else multi-process implicit dependency may differ from + # single process. + eval (<FD>); + for my $k (sort { substr($a, 0 , index ($a, '|')) <=> + substr ($b, 0, index ($b, '|')) } keys %$VAR1) { + + $self->{'project_file_list'}->{substr ($k, index ($k, '|') + 1)} = + $VAR1->{$k}; + } + + $self->{'cacheok'} = $cacheok; + if ($self->cd($dir)) { + if ($self->{'cacheok'} && defined $allprojects{$prkey}) { + + $files_written = $allprojects{$prkey}; + $gen_proj_info = $allprinfo{$prkey}; + $gen_lib_locs = $allliblocs{$prkey}; + $status = 1; + } else { + # file is already generated. check status + if (!$status) { + + ## We don't restore the state before we leave, + ## but that's ok since we will be exiting right now. + return $status, $creator, $msg; + } + + ## Get the individual project information and + ## generated file name(s) + if ($self->{'cacheok'}) { + + $allprojects{$prkey} = $files_written; + $allprinfo{$prkey} = $gen_proj_info; + $allliblocs{$prkey} = $gen_lib_locs; + } + + push(@{$self->{'mpc_to_output'}->{$ofile}}, @$files_written); + } + + $self->cd($cwd); + $self->save_project_info($files_written, $gen_proj_info, + $gen_lib_locs, $dir, + \@projects, \%pi, \%liblocs); + } else { + + ## Unable to change to the directory. + ## We don't restore the state before we leave, + ## but that's ok since we will be exiting soon. + return 0, $creator, $msg; + + } + + ## Return things to the way they were + $impl = $previmpl if (defined $self->{'scoped_assign'}->{$ofile}); + if ($restore) { + $self->{'cacheok'} = $prevcache; + $creator->restore_state(\%gstate); + } + } + + ## Add implict project dependencies based on source files + ## that have been used by multiple projects. If we do it here + ## before we call generate_hierarchy(), we don't have to call it + ## in generate_hierarchy() for each workspace. + $self->{'projects'} = \@projects; + $self->{'project_info'} = \%pi; + + if ($status && $genimpdep) { + #print "aipd: $cwd\n", Dumper ($creator), "\n"; + $self->add_implicit_project_dependencies($creator, $cwd); + } + + ## If we are generating the hierarchical workspaces, then do so + $self->{'lib_locations'} = \%liblocs; + if ($self->get_hierarchy() || $self->workspace_per_project()) { + my $orig = $self->{'workspace_name'}; + ($status, $errorString) = $self->generate_hierarchy($creator, \@projects, \%pi); + $self->{'workspace_name'} = $orig; + } + + ## Reset the projects and project_info + $self->{'projects'} = \@projects; + $self->{'project_info'} = \%pi; + + return $status, $creator, $errorString; +} + +sub send_to_parent { + my $self = shift; + my $arr = shift; + + # send the data + my $sock = new IO::Socket::INET ( + PeerAddr => 'localhost', + PeerPort => $wport, + Proto => 'tcp', + ); + + if (!defined ($sock)) { + die "Child could not create socket"; + } + + map { print $sock "$_\n"; } @$arr; + $sock->close(); +} + +sub generate_project_files_fork_socket { + my $self = shift; + my $status = (scalar @{$self->{'project_files'}} == 0 ? 1 : 0); + + my @projects; + my %pi; + my %liblocs; + + my $creator = $self->project_creator('child'); + my $cwd = $self->getcwd(); + my $impl = $self->get_assignment('implicit'); + my $postkey = $creator->get_dynamic() . + $creator->get_static() . "-$self"; + my $previmpl = $impl; + my $prevcache = $self->{'cacheok'}; + my %gstate = $creator->save_state(); + my $genimpdep = $self->generate_implicit_project_dependencies(); + my $errorString; + + my @save; + my $VAR1; + $Data::Dumper::Indent = 0; + + ## Save this project creator setting for later use in the + ## number_target_deps() method. + $self->{'dependency_is_filename'} = $creator->dependency_is_filename(); + + ## Remove the address portion of the $self string + $postkey =~ s/=.*//; + + ## Set the source file callback on our project creator + $creator->set_source_listing_callback([\&source_listing_callback, $self]); + + my $pid; + my @pids; + my @pdata; # parents data sent from children. + + ## setup workers' data + my @wdata; + my $beg; + my $fin; + + my $num_prj_files = $#{$self->{'project_files'}} + 1; + + ## reduce the number of workers if necessary + ## what if $num_workers > SOMAXCONN?? (unlikely) + if ($num_workers > SOMAXCONN) { + $self->diagnostic("Multiprocess MPC reducing # workers from $num_workers to " . SOMAXCONN . ", the max # of queued connections"); + $num_workers = SOMAXCONN; + } + + if ($num_workers > $num_prj_files) { + # don't fork more workers than there are jobs + $self->diagnostic("Multiprocess MPC reducing # workers from $num_workers to $num_prj_files, the number of project files."); + $num_workers = $num_prj_files; + } + + my $num_per_worker = int ($num_prj_files / $num_workers); + my $num_lines_per_prj = 6; + + $self->diagnostic("Multiprocess MPC using $num_workers workers to process $num_prj_files project files."); + + for (my $wctr = 0; $wctr < $num_workers; ++$wctr) { + $beg = $wctr * $num_per_worker; + $fin = $beg + $num_per_worker - 1; + + @{$wdata[$wctr]} = @{$self->{'project_files'}}[$beg..$fin]; + } + + ## give any remaining data to last worker. + if ($num_prj_files > $num_per_worker * $num_workers) { + push @{$wdata[$num_workers - 1]} , + @{$self->{'project_files'}}[$num_per_worker + * $num_workers..$#{$self->{'project_files'}}]; + + } + + ## Setup listener. Do this before fork so that (in the rare case) + ## when child tries to send data before the accept(), the socket + ## is at least initialized. + my $sock = new IO::Socket::INET ( + LocalHost => 'localhost', + LocalPort => $wport, + Proto => 'tcp', + Listen => $num_workers, + Reuse => 1 + ); + if (!defined ($sock)) { + die "Error setting up parent listener"; + } + + ## spawn the workers. + my $id = 0; + while ($id < $num_workers) { + # use pipes as barrier + $pid = fork(); + if ($pid != 0) { + push @pids, $pid; + } else { + ## after fork, child knows its id and which data to use. + $self->{'pid'} = 'child'; + last; + } + ++$id; + } + + if ($self->{pid} eq 'parent') { + $self->diagnostic("Multiprocess MPC using port $wport."); + + # read the data from the kids + for (my $ctr = 0; $ctr < $num_workers; ++$ctr) { + my $handle = $sock->accept(); + die "Accept error" if !$handle; + my $id = <$handle>; + @{$pdata[$id]} = <$handle>; + + # each project as 6 records + if ((($#{$pdata[$id]} + 1) / $num_lines_per_prj) != $num_per_worker) { + if ($#{$pdata[$id]} != 0) { + # 0 indicates a failed status which will be delt with later + if (($id == $num_workers - 1) && ((($#{$pdata[$id]} + 1) / $num_lines_per_prj) != $num_per_worker + $#{$self->{'project_files'}} + 1 - ($num_workers * $num_per_worker))) { + # The last child may have more than num_per_worker records + my $rec = $#{$pdata[$id]} + 1; + my $exp = $num_per_worker * $num_lines_per_prj; + die "There is an error in the child data. Expected $exp. Received $rec"; + } + } + } + } + # all data has been read + $sock->close(); + + } else { + ## This is the code the workers run. + undef $sock; + ## generate projects + my @cdata = ($id); + foreach my $ofile (@{$wdata[$id]}) { + if (!$self->excluded($ofile)) { + my $file = $ofile; + my $dir = $self->mpc_dirname($file); + my $restore = 0; + + if (defined $self->{'scoped_assign'}->{$ofile}) { + ## Handle the implicit assignment + my $oi = $self->{'scoped_assign'}->{$ofile}->{'implicit'}; + if (defined $oi) { + $previmpl = $impl; + $impl = $oi; + } + + ## Handle the cmdline assignment + my $cmdline = $self->{'scoped_assign'}->{$ofile}->{'cmdline'}; + if (defined $cmdline && $cmdline ne '') { + ## Save the cacheok value + $prevcache = $self->{'cacheok'}; + + ## Get the current parameters and process the command line + my %parameters = $self->current_parameters(); + $self->process_cmdline($cmdline, \%parameters); + + ## Set the parameters on the creator + $creator->restore_state(\%parameters); + $restore = 1; + } + } + + ## If we are generating implicit projects and the file is a + ## directory, then we set the dir to the file and empty the file + if ($impl && -d $file) { + $dir = $file; + $file = ''; + + ## If the implicit assignment value was not a number, then + ## we will add this value to our base projects. + if ($impl !~ /^\d+$/) { + my $bps = $creator->get_baseprojs(); + push(@$bps, split(/\s+/, $impl)); + $restore = 1; + $self->{'cacheok'} = 0; + } + } + + ## Generate the key for this project file + my $prkey = $self->getcwd() . '/' . + ($file eq '' ? $dir : $file) . "-$postkey"; + + ## We must change to the subdirectory for + ## which this project file is intended + + if ($self->cd($dir)) { + my $files_written = []; + my $gen_proj_info = []; + my $gen_lib_locs = {}; + + if ($self->{'cacheok'} && defined $allprojects{$prkey}) { + $files_written = $allprojects{$prkey}; + $gen_proj_info = $allprinfo{$prkey}; + $gen_lib_locs = $allliblocs{$prkey}; + + $status = 1; + } else { + $status = $creator->generate($self->mpc_basename($file)); + + ## If any one project file fails, then stop + ## processing altogether. + if (!$status) { + # save the status info and exit. the parent will + # see the error. + @cdata = ($id); + push @cdata, "$status|Unable to process " . + ($file eq '' ? " in $dir" : $file) . "\n"; + + $self->send_to_parent(\@cdata); + exit(1); # child error + } + + ## Get the individual project information and + ## generated file name(s) + $files_written = $creator->get_files_written(); + $gen_proj_info = $creator->get_project_info(); + $gen_lib_locs = $creator->get_lib_locations(); + + } + + push @cdata, "$status|''|$self->{'cacheok'}|$previmpl|$prevcache"; + push @cdata, "$ofile|$prkey|$dir|$cwd|$restore"; + push @cdata, Dumper ($files_written); + push @cdata, Dumper ($gen_proj_info); + push @cdata, Dumper ($gen_lib_locs); + + # there's a callback that sets the project file list + # since we can't callback between processes we store + # the list for later + push @cdata, Dumper ($self->{'project_file_list'}); + + $self->cd($cwd); + + } else { + ## Unable to change to the directory. + ## We don't restore the state before we leave, + ## but that's ok since we will be exiting soon. + @cdata = ($id); + push @cdata, "$status|Unable to change directory to $dir\n"; + $self->send_to_parent(\@cdata); + + exit (1); # child error + } + ## Return things to the way they were + $impl = $previmpl if (defined $self->{'scoped_assign'}->{$ofile}); + if ($restore) { + $self->{'cacheok'} = $prevcache; + $creator->restore_state(\%gstate); + } + + } else { + ## This one was excluded, so status is ok + ## no need to set though since the child will exit. + #$status = 1; + } + + } + + # send all the data at once. + $self->send_to_parent(\@cdata); + + exit (0); + + # end of child + } + + # This is the parent again. + + for $pid (@pids) { + # this will reap any zombies + waitpid($pid, 0); + } + + my ($msg, $cacheok, $ofile, $prkey, $dir, $restore); + + # read the children's stored data + for (my $i = 0; $i < $num_workers; ++$i) { + for (my $j = 0; $j < $#{$pdata[$i]} + 1; ++$j) { + ($status, $msg, $cacheok, $previmpl, $prevcache) = split /\|/, ${$pdata[$i]}[$j++]; + + # check that the child was successful + if (!$status) { + return $status, $creator, $msg; + } + + ($ofile, $prkey, $dir, $cwd, $restore) = split /\|/, ${$pdata[$i]}[$j++]; + + eval (${$pdata[$i]}[$j++]); + my $files_written = $VAR1; + + eval (${$pdata[$i]}[$j++]); + my $gen_proj_info = $VAR1; + + # have to reconstitute gen_lib_locs in the same order it was + # created or else multi-process implicit dependency may differ from + # single process. + eval (${$pdata[$i]}[$j++]); + my $gen_lib_locs; + for my $k (sort { substr($a, 0 , index ($a, '|')) <=> + substr ($b, 0, index ($b, '|')) } keys %$VAR1) { + + $gen_lib_locs->{substr ($k, index ($k, '|') + 1)} = + $VAR1->{$k}; + } + + # have to reconstitute project_file_list in the same order it was + # created or else multi-process implicit dependency may differ from + # single process. + eval (${$pdata[$i]}[$j]); + for my $k (sort { substr($a, 0 , index ($a, '|')) <=> + substr ($b, 0, index ($b, '|')) } keys %$VAR1) { + + $self->{'project_file_list'}->{substr ($k, index ($k, '|') + 1)} = + $VAR1->{$k}; + } + + $self->{'cacheok'} = $cacheok; + if ($self->cd($dir)) { + if ($self->{'cacheok'} && defined $allprojects{$prkey}) { + + $files_written = $allprojects{$prkey}; + $gen_proj_info = $allprinfo{$prkey}; + $gen_lib_locs = $allliblocs{$prkey}; + $status = 1; + } else { + # file is already generated. check status + if (!$status) { + + ## We don't restore the state before we leave, + ## but that's ok since we will be exiting right now. + return $status, $creator, $msg; + } + + ## Get the individual project information and + ## generated file name(s) + if ($self->{'cacheok'}) { + + $allprojects{$prkey} = $files_written; + $allprinfo{$prkey} = $gen_proj_info; + $allliblocs{$prkey} = $gen_lib_locs; + } + + push(@{$self->{'mpc_to_output'}->{$ofile}}, @$files_written); + } + + $self->cd($cwd); + $self->save_project_info($files_written, $gen_proj_info, + $gen_lib_locs, $dir, + \@projects, \%pi, \%liblocs); + } else { + + ## Unable to change to the directory. + ## We don't restore the state before we leave, + ## but that's ok since we will be exiting soon. + return 0, $creator, $msg; + + } + + ## Return things to the way they were + $impl = $previmpl if (defined $self->{'scoped_assign'}->{$ofile}); + if ($restore) { + $self->{'cacheok'} = $prevcache; + $creator->restore_state(\%gstate); + } + } + } + + ## Add implict project dependencies based on source files + ## that have been used by multiple projects. If we do it here + ## before we call generate_hierarchy(), we don't have to call it + ## in generate_hierarchy() for each workspace. + $self->{'projects'} = \@projects; + $self->{'project_info'} = \%pi; + + if ($status && $genimpdep) { + #print "aipd: $cwd\n", Dumper ($creator), "\n"; + $self->add_implicit_project_dependencies($creator, $cwd); + } + + ## If we are generating the hierarchical workspaces, then do so + $self->{'lib_locations'} = \%liblocs; + if ($self->get_hierarchy() || $self->workspace_per_project()) { + my $orig = $self->{'workspace_name'}; + ($status, $errorString) = $self->generate_hierarchy($creator, \@projects, \%pi); + $self->{'workspace_name'} = $orig; + } + + ## Reset the projects and project_info + $self->{'projects'} = \@projects; + $self->{'project_info'} = \%pi; + + return $status, $creator, $errorString; +} + sub array_contains { my($self, $left, $right) = @_; @@ -1489,8 +2245,7 @@ sub non_intersection { foreach my $r (@$right) { if (exists $check{$r}) { $status = 1; - } - else { + } else { push(@$over, $r); } } @@ -1504,10 +2259,9 @@ sub indirect_dependency { $self->{'indirect_checked'}->{$ccheck} = 1; if (index($self->{'project_info'}->{$ccheck}->[ProjectCreator::DEPENDENCIES], $cfile) >= 0) { return 1; - } - else { + } else { my $deps = $self->create_array( - $self->{'project_info'}->{$ccheck}->[ProjectCreator::DEPENDENCIES]); + $self->{'project_info'}->{$ccheck}->[ProjectCreator::DEPENDENCIES]); foreach my $dep (@$deps) { if (defined $self->{'project_info'}->{"$dir$dep"} && !defined $self->{'indirect_checked'}->{"$dir$dep"} && @@ -1536,6 +2290,7 @@ sub add_implicit_project_dependencies { ## project so that the next time around the foreach, we don't find it ## as a dependent on the one that we just modified. my @pflkeys = keys %{$self->{'project_file_list'}}; + foreach my $key (@pflkeys) { foreach my $ikey (@pflkeys) { ## Not the same project and @@ -1548,17 +2303,16 @@ sub add_implicit_project_dependencies { !$self->array_contains($bidir{$ikey}, [$key]))) { my @over; if ($self->non_intersection( - $self->{'project_file_list'}->{$key}->[2], - $self->{'project_file_list'}->{$ikey}->[2], - \@over)) { + $self->{'project_file_list'}->{$key}->[2], + $self->{'project_file_list'}->{$ikey}->[2], + \@over)) { ## The project contains shared source files, so we need to ## look into adding an implicit inter-project dependency. $save{$ikey} = $self->{'project_file_list'}->{$ikey}->[2]; $self->{'project_file_list'}->{$ikey}->[2] = \@over; if (defined $bidir{$key}) { push(@{$bidir{$key}}, $ikey); - } - else { + } else { $bidir{$key} = [$ikey]; } my $append = $creator->translate_value('after', $key); @@ -1649,7 +2403,7 @@ sub sort_within_group { ## Put the projects in the order specified ## by the project dependencies. - for(my $i = $start; $i <= $end; ++$i) { + for (my $i = $start; $i <= $end; ++$i) { ## If our moved project equals our previously moved project then ## we count this as a possible circular dependency. my $key = "@$list"; @@ -1657,8 +2411,7 @@ sub sort_within_group { (defined $$movepjs[0] && defined $$prevpjs[0] && $$movepjs[0] == $$prevpjs[0] && $$movepjs[1] == $$prevpjs[1])) { ++$ccount; - } - else { + } else { $ccount = 0; } @@ -1674,7 +2427,7 @@ sub sort_within_group { } $self->warning('Circular dependency detected while processing the ' . ($self->{'current_input'} eq '' ? - 'default' : $self->{'current_input'}) . + 'default' : $self->{'current_input'}) . ' workspace. ' . 'The following projects are involved: ' . (defined $other ? "$$list[$other], " : '') . @@ -1691,23 +2444,23 @@ sub sort_within_group { $deps = $self->get_validated_ordering($$list[$i]); if (defined $$deps[0]) { my $baseproj = ($self->{'dependency_is_filename'} ? - $self->mpc_basename($$list[$i]) : - $self->{'project_info'}->{$$list[$i]}->[ProjectCreator::PROJECT_NAME]); + $self->mpc_basename($$list[$i]) : + $self->{'project_info'}->{$$list[$i]}->[ProjectCreator::PROJECT_NAME]); my $moved = 0; foreach my $dep (@$deps) { if ($baseproj ne $dep) { ## See if the dependency is listed after this project - for(my $j = $i + 1; $j <= $end; ++$j) { + for (my $j = $i + 1; $j <= $end; ++$j) { my $ldep = ($self->{'dependency_is_filename'} ? - $self->mpc_basename($$list[$j]) : - $self->{'project_info'}->{$$list[$j]}->[ProjectCreator::PROJECT_NAME]); + $self->mpc_basename($$list[$j]) : + $self->{'project_info'}->{$$list[$j]}->[ProjectCreator::PROJECT_NAME]); if ($ldep eq $dep) { $movepjs = [$i, $j]; ## If so, move it in front of the current project. ## The original code, which had splices, didn't always ## work correctly (especially on AIX for some reason). my $save = $$list[$j]; - for(my $k = $j; $k > $i; --$k) { + for (my $k = $j; $k > $i; --$k) { $$list[$k] = $$list[$k - 1]; } $$list[$i] = $save; @@ -1734,16 +2487,16 @@ sub build_dependency_chain { ## Find the item in the list that matches our current dependency my $mapped = $$map{$dep}; if (defined $mapped) { - for(my $i = 0; $i < $len; $i++) { + for (my $i = 0; $i < $len; $i++) { if ($$list[$i] eq $mapped) { ## Locate the group number to which the dependency belongs - for(my $j = 0; $j < $glen; $j++) { + for (my $j = 0; $j < $glen; $j++) { if ($i >= $$groups[$j]->[0] && $i <= $$groups[$j]->[1]) { if ($j != $ni) { ## Add every project in the group to the dependency chain - for(my $k = $$groups[$j]->[0]; $k <= $$groups[$j]->[1]; $k++) { + for (my $k = $$groups[$j]->[0]; $k <= $$groups[$j]->[1]; $k++) { my $ldep = $self->mpc_basename($$list[$k]); if (!exists $$gdeps{$ldep}) { $$gdeps{$ldep} = 1; @@ -1785,11 +2538,11 @@ sub sort_by_groups { } my %circular_checked; - for(my $gi = 0; $gi <= $#groups; ++$gi) { + for (my $gi = 0; $gi <= $#groups; ++$gi) { ## Detect circular dependencies if (!$circular_checked{$gi}) { $circular_checked{$gi} = 1; - for(my $i = $groups[$gi]->[0]; $i <= $groups[$gi]->[1]; ++$i) { + for (my $i = $groups[$gi]->[0]; $i <= $groups[$gi]->[1]; ++$i) { my %gdeps; $self->build_dependency_chain($$list[$i], $llen, $list, $gi, $#groups + 1, \@groups, @@ -1819,7 +2572,7 @@ sub sort_by_groups { my @keys = sort keys %dirs; $self->warning('Circular directory dependency detected in the ' . ($self->{'current_input'} eq '' ? - 'default' : $self->{'current_input'}) . + 'default' : $self->{'current_input'}) . ' workspace. ' . 'The following director' . ($#keys == 0 ? 'y is' : 'ies are') . @@ -1831,38 +2584,38 @@ sub sort_by_groups { ## Build up the group dependencies my %gdeps; - for(my $i = $groups[$gi]->[0]; $i <= $groups[$gi]->[1]; ++$i) { + for (my $i = $groups[$gi]->[0]; $i <= $groups[$gi]->[1]; ++$i) { my $deps = $self->get_validated_ordering($$list[$i]); @gdeps{@$deps} = () if (defined $$deps[0]); } ## Search the rest of the groups for any of the group dependencies - for(my $gj = $gi + 1; $gj <= $#groups; ++$gj) { - for(my $i = $groups[$gj]->[0]; $i <= $groups[$gj]->[1]; ++$i) { + for (my $gj = $gi + 1; $gj <= $#groups; ++$gj) { + for (my $i = $groups[$gj]->[0]; $i <= $groups[$gj]->[1]; ++$i) { if (exists $gdeps{$self->mpc_basename($$list[$i])}) { ## Move this group ($gj) in front of the current group ($gi) my @save; - for(my $j = $groups[$gi]->[1] + 1; $j <= $groups[$gj]->[1]; ++$j) { + for (my $j = $groups[$gi]->[1] + 1; $j <= $groups[$gj]->[1]; ++$j) { push(@save, $$list[$j]); } my $offset = $groups[$gj]->[1] - $groups[$gi]->[1]; - for(my $j = $groups[$gi]->[1]; $j >= $groups[$gi]->[0]; --$j) { + for (my $j = $groups[$gi]->[1]; $j >= $groups[$gi]->[0]; --$j) { $$list[$j + $offset] = $$list[$j]; } - for(my $j = 0; $j <= $#save; ++$j) { + for (my $j = 0; $j <= $#save; ++$j) { $$list[$groups[$gi]->[0] + $j] = $save[$j]; } ## Update the group indices my $shiftamt = ($groups[$gi]->[1] - $groups[$gi]->[0]) + 1; - for(my $j = $gi + 1; $j <= $gj; ++$j) { + for (my $j = $gi + 1; $j <= $gj; ++$j) { $groups[$j]->[0] -= $shiftamt; $groups[$j]->[1] -= $shiftamt; } my @grsave = @{$groups[$gi]}; $grsave[0] += $offset; $grsave[1] += $offset; - for(my $j = $gi; $j < $gj; ++$j) { + for (my $j = $gi; $j < $gj; ++$j) { $groups[$j] = $groups[$j + 1]; $circular_checked{$j} = $circular_checked{$j + 1}; } @@ -1900,12 +2653,11 @@ sub sort_dependencies { ## First determine the individual groups my @grindex; my $previous = [0, undef]; - for(my $li = 0; $li <= $#list; ++$li) { + for (my $li = 0; $li <= $#list; ++$li) { my $dir = $self->get_first_level_directory($list[$li]); if (!defined $previous->[1]) { $previous = [$li, $dir]; - } - elsif ($previous->[1] ne $dir) { + } elsif ($previous->[1] ne $dir) { push(@grindex, [$previous->[0], $li - 1]); $previous = [$li, $dir]; } @@ -1919,8 +2671,7 @@ sub sort_dependencies { ## Now sort the groups as single entities $self->sort_by_groups(\@list, \@grindex) if ($#grindex > 0); - } - else { + } else { $self->sort_within_group(\@list, 0, $#list); } } @@ -1935,7 +2686,7 @@ sub number_target_deps { ## This block of code must be done after the list of dependencies ## has been sorted in order to get the correct project numbers. - for(my $i = 0; $i <= $#list; ++$i) { + for (my $i = 0; $i <= $#list; ++$i) { my $project = $list[$i]; if (defined $$pjs{$project}) { my($name, $deps) = @{$$pjs{$project}}; @@ -1948,13 +2699,13 @@ sub number_target_deps { ## up to the point of this project for the projects ## that this one depends on. When the project is ## found, we put the target number in the numbers array. - for(my $j = 0; $j < $i; ++$j) { + for (my $j = 0; $j < $i; ++$j) { ## If the dependency is a filename, then take the basename of ## the project file. Otherwise, get the project name based on ## the project file from the "project_info". my $key = ($self->{'dependency_is_filename'} ? - $self->mpc_basename($list[$j]) : - $self->{'project_info'}->{$list[$j]}->[ProjectCreator::PROJECT_NAME]); + $self->mpc_basename($list[$j]) : + $self->{'project_info'}->{$list[$j]}->[ProjectCreator::PROJECT_NAME]); push(@numbers, $j) if (exists $dhash{$key}); } @@ -1983,8 +2734,7 @@ sub project_target_translation { $dir =~ s/[\/\\].*//; if (($case && $dir eq $name) || (!$case && lc($dir) eq lc($name))) { $map{$key} = "$name-target"; - } - else { + } else { $map{$key} = $name; } } @@ -2019,16 +2769,13 @@ sub process_cmdline { if (!defined $type) { ## This option was not used, so we ignore it - } - elsif ($type eq 'ARRAY') { + } elsif ($type eq 'ARRAY') { push(@{$parameters->{$key}}, @{$options->{$key}}); - } - elsif ($type eq 'HASH') { + } elsif ($type eq 'HASH') { foreach my $hk (keys %{$options->{$key}}) { $parameters->{$key}->{$hk} = $options->{$key}->{$hk}; } - } - elsif ($type eq 'SCALAR') { + } elsif ($type eq 'SCALAR') { $parameters->{$key} = $options->{$key}; } } @@ -2084,6 +2831,11 @@ sub current_parameters { sub project_creator { my $self = shift; + my $pid = shift; + if (not defined $pid) { + $pid = 'parent'; + } + my $str = "$self"; ## NOTE: If the subclassed WorkspaceCreator name prefix does not @@ -2130,7 +2882,8 @@ sub project_creator { $parameters{'expand_vars'}, $self->{'gendot'}, $parameters{'comments'}, - $self->{'for_eclipse'}); + $self->{'for_eclipse'}, + $pid); } @@ -2169,23 +2922,22 @@ sub get_modified_workspace_name { if (!defined $previous_workspace_name{$type}->{$pwd}) { $previous_workspace_name{$type}->{$pwd} = $wsname; $self->{'current_workspace_name'} = undef; - } - else { + } else { my $prefix = ($oname eq $wsname ? $name : "$name.$wsname"); $previous_workspace_name{$type}->{$pwd} = $wsname; - while($self->file_written("$prefix" . - ($self->{'modified_count'} > 0 ? - ".$self->{'modified_count'}" : '') . - "$ext")) { + while ($self->file_written("$prefix" . + ($self->{'modified_count'} > 0 ? + ".$self->{'modified_count'}" : '') . + "$ext")) { ++$self->{'modified_count'}; } $self->{'current_workspace_name'} = - "$prefix" . ($self->{'modified_count'} > 0 ? - ".$self->{'modified_count'}" : '') . "$ext"; + "$prefix" . ($self->{'modified_count'} > 0 ? + ".$self->{'modified_count'}" : '') . "$ext"; } return (defined $self->{'current_workspace_name'} ? - $self->{'current_workspace_name'} : "$name$ext"); + $self->{'current_workspace_name'} : "$name$ext"); } @@ -2209,15 +2961,14 @@ sub get_validated_ordering { if (defined $self->{'ordering_cache'}->{$project}) { $deps = $self->{'ordering_cache'}->{$project}; - } - else { + } else { $deps = []; if (defined $self->{'project_info'}->{$project}) { my($name, $dstr) = @{$self->{'project_info'}->{$project}}; if (defined $dstr && $dstr ne '') { $deps = $self->create_array($dstr); my $dlen = scalar(@$deps); - for(my $i = 0; $i < $dlen; $i++) { + for (my $i = 0; $i < $dlen; $i++) { my $dep = $$deps[$i]; my $found = 0; ## Avoid circular dependencies @@ -2238,8 +2989,7 @@ sub get_validated_ordering { --$dlen; --$i; } - } - else { + } else { ## If a project references itself, we must remove it ## from the list of dependencies. splice(@$deps, $i, 1); @@ -2259,6 +3009,14 @@ sub get_validated_ordering { sub source_listing_callback { my($self, $project_file, $project_name, $list) = @_; + + # have to keep projects in the the same order as if run in + # single process. otherwise implicit dependencies produces + # different output + if ($self->{'pid'} ne 'parent') { + $project_name = ++$self->{'imp_dep_ctr'} . '|' . $project_name; + } + $self->{'project_file_list'}->{$project_name} = [ $project_file, $self->getcwd(), $list ]; } @@ -2271,8 +3029,7 @@ sub sort_projects_by_directory { if ($sa >= 0 && $sb == -1) { return 1; - } - elsif ($sb >= 0 && $sa == -1) { + } elsif ($sb >= 0 && $sa == -1) { return -1; } return $left cmp $right; @@ -2298,12 +3055,11 @@ sub get_relative_dep_file { my @dirs = grep(!/^$/, split('/', $base)); my $last = -1; $project =~ s/^\///; - for(my $i = 0; $i <= $#dirs; $i++) { + for (my $i = 0; $i <= $#dirs; $i++) { my $dir = $dirs[$i]; if ($project =~ s/^$dir\///) { $last = $i; - } - else { + } else { last; } } @@ -2311,10 +3067,9 @@ sub get_relative_dep_file { my $dependee = $self->{'project_file_list'}->{$dep}->[0]; if ($last == -1) { return $base . '/' . $dependee; - } - else { + } else { my $built = ''; - for(my $i = $last + 1; $i <= $#dirs; $i++) { + for (my $i = $last + 1; $i <= $#dirs; $i++) { $built .= $dirs[$i] . '/'; } $built .= $dependee; @@ -2338,8 +3093,7 @@ sub create_command_line_string { ## contains a dollar sign, we need to wrap the argument in single ## quotes so that the UNIX shell does not interpret it. $arg = "'$arg'"; - } - else { + } else { ## Unfortunately, the Windows command line shell does not ## understand single quotes correctly. So, we have the distinction ## above and handle dollar signs here too. @@ -2347,8 +3101,7 @@ sub create_command_line_string { } if (defined $str) { $str .= " $arg"; - } - else { + } else { $str = $arg; } } @@ -2434,7 +3187,7 @@ sub workspace_per_project { sub default_verbose_ordering { - return 0; # Don't warning if there are missing dependencies. + return 0; # Don't warning if there are missing dependencies. } |