package WorkspaceCreator;

use strict;

use FileHandle;

use File::Path;

use Creator;

use Options;

use WorkspaceHelper;

use IO::Socket;

use Data::Dumper;

use vars qw(@ISA);

@ISA = qw(Creator Options);

our $num_workers = 0; # single-process

our $wdir; # tmp directory

our $wport;

my $wsext = 'mwc';

my $wsbase = 'mwb';

my %validNames = ('cmdline' => 1,

'implicit' => 1,

);

my %allprinfo;

my %allprojects;

my %allliblocs;

my %previous_workspace_name;

my $aggregated = 'aggregated_workspace';

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, $workers, $workers_dir,

$workers_port) = @_;

my $self = Creator::new($class, $global, $inc,

$template, $ti, $dynamic, $static,

$relative, $addtemp, $addproj,

$progress, $toplevel, $baseprojs,

$feature, $features,

$hierarchy, $nmod, $applypj,

$into, $language, $use_env, $expandvars,

'workspace');

$self->{'pid'} = 'parent';

# implicit dependency order counter. this is

# incremented in the children.

$self->{'imp_dep_ctr'} = 0;

## These need to be reset at the end of each

## workspace processed within a .mwc file

$self->{'workspace_name'} = undef;

$self->{'projects'} = [];

$self->{'project_info'} = {};

$self->{'project_files'} = [];

$self->{'modified_count'} = 0;

$self->{'exclude'} = {};

$self->{'associated'} = {};

$self->{'scoped_assign'} = {};

$self->{'aggregated_mpc'} = {};

$self->{'aggregated_assign'} = {};

$self->{'mpc_to_output'} = {};

## These are maintained/modified throughout processing

$self->{$self->{'type_check'}} = 0;

$self->{'cacheok'} = $self->default_cacheok();

$self->{'lib_locations'} = {};

$self->{'reading_parent'} = [];

$self->{'global_feature_file'} = $gfeature;

$self->{'relative_file'} = $relative_f;

$self->{'project_file_list'} = {};

$self->{'ordering_cache'} = {};

$self->{'handled_scopes'} = {};

$self->{'scoped_basedir'} = undef;

$self->{'current_aggregated'} = undef;

## 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();

$self->{'wctype'} = $self->extractType("$self");

$self->{'workspace_comments'} = $comments;

if (defined $$exclude[0]) {

my $type = $self->{'wctype'};

if (!defined $self->{'exclude'}->{$type}) {

$self->{'exclude'}->{$type} = [];

}

push(@{$self->{'exclude'}->{$type}}, @$exclude);

$self->{'orig_exclude'} = $self->{'exclude'};

}

else {

$self->{'orig_exclude'} = {};

}

## Add a hash reference for our workspace type

if (!defined $previous_workspace_name{$self->{'wctype'}}) {

$previous_workspace_name{$self->{'wctype'}} = {};

}

## Warn users about unnecessary options

if ($self->get_hierarchy() && $self->workspace_per_project()) {

$self->warning("The -hierarchy option is unnecessary " .

"for the " . $self->{'wctype'} . " type.");

}

if ($self->{'coexistence'} && !$self->supports_make_coexistence()) {

$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;

}

sub set_verbose_ordering {

my($self, $value) = @_;

$self->{'verbose_ordering'} = $value;

}

sub modify_assignment_value {

## Workspace assignments do not need modification.

return $_[2];

}

sub parse_line {

my($self, $ih, $line, $flags) = @_;

my($status, $error, @values) = $self->parse_known($line, $ih);

## Was the line recognized?

if ($status && defined $values[0]) {

if ($values[0] eq $self->{'grammar_type'}) {

my $name = $values[1];

if (defined $name && $name eq '}') {

if (!defined $self->{'reading_parent'}->[0]) {

## Fill in all the default values

$self->generate_defaults();

## End of workspace; Have subclass write out the file

## Generate the 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 {

$error = $err;

$status = 0;

}

$self->{'modified_count'} = 0;

$self->{'workspace_name'} = undef;

$self->{'projects'} = [];

$self->{'project_info'} = {};

$self->{'project_files'} = [];

$self->{'exclude'} = $self->{'orig_exclude'};

$self->{'associated'} = {};

$self->{'scoped_assign'} = {};

$self->{'aggregated_mpc'} = {};

$self->{'aggregated_assign'} = {};

$self->{'mpc_to_output'} = {};

}

$self->{$self->{'type_check'}} = 0;

}

else {

## Workspace Beginning

## Deal with the inheritance hierarchy first

if (defined $values[2]) {

foreach my $parent (@{$values[2]}) {

## Read in the parent onto ourself

my $file = $self->search_include_path("$parent.$wsbase");

if (!defined $file) {

$file = $self->search_include_path("$parent.$wsext");

}

if (defined $file) {

push(@{$self->{'reading_parent'}}, 1);

$status = $self->parse_file($file);

pop(@{$self->{'reading_parent'}});

$error = "Invalid parent: $parent" if (!$status);

}

else {

$status = 0;

$error = "Unable to locate parent: $parent";

}

}

}

## Set up some initial values

if (defined $name) {

if ($name =~ /[\/\\]/) {

$status = 0;

$error = 'Workspaces can not have a slash ' .

'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());

}

$self->{'workspace_name'} = $name;

}

}

$self->{$self->{'type_check'}} = 1;

}

}

elsif ($values[0] eq '0') {

if (defined $validNames{$values[1]}) {

$self->process_assignment($values[1], $values[2], $flags);

}

else {

$error = "Invalid assignment name: '$values[1]'";

$status = 0;

}

}

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

## that they are not incorrectly handled in aggregated

## workspaces.

$self->replace_env_vars(\$values[2]) if ($values[2] =~ /\$/);

$self->process_assignment_add($values[1], $values[2], $flags);

}

else {

$error = "Invalid addition name: $values[1]";

$status = 0;

}

}

elsif ($values[0] eq '-1') {

if (defined $validNames{$values[1]}) {

$self->process_assignment_sub($values[1], $values[2], $flags);

}

else {

$error = "Invalid subtraction name: $values[1]";

$status = 0;

}

}

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 {

$error = "Unrecognized line: $line";

$status = 0;

}

}

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) {

if ($expfile =~ /\.$wsext$/) {

my %copy = %{defined $flags ? $flags : $self->get_assignment_hash()};

($status, $error) = $self->aggregated_workspace($expfile, \%copy);

last if (!$status);

}

else {

push(@{$self->{'project_files'}}, $expfile);

$status = 1;

}

}

}

return $status, $error;

}

sub aggregated_workspace {

my($self, $file, $flags) = @_;

my $fh = new FileHandle();

if (open($fh, $file)) {

my $oline = $self->get_line_number();

my $tc = $self->{$self->{'type_check'}};

my $ag = $self->{'handled_scopes'}->{$aggregated};

my $pca = $self->{'current_aggregated'};

my $psbd = $self->{'scoped_basedir'};

my $prev_assign = $self->clone($self->get_assignment_hash());

my($status, $error, @values) = (0, 'No recognizable lines');

$self->{'handled_scopes'}->{$aggregated} = undef;

$self->set_line_number(0);

$self->{$self->{'type_check'}} = 0;

$self->{'current_aggregated'} = $file;

$self->{'scoped_basedir'} = $self->mpc_dirname($file);

## If the directory name for the file is the current directory, we

## need to empty it out. If we don't, it will cause the file name to

## not match up with itself later on where scoped_basedir is used.

$self->{'scoped_basedir'} = undef if ($self->{'scoped_basedir'} eq '.');

while (<$fh>) {

my $line = $self->preprocess_line($fh, $_);

($status, $error, @values) = $self->parse_known($line, $fh);

## Was the line recognized?

if ($status) {

if (defined $values[0]) {

if ($values[0] eq $self->{'grammar_type'}) {

if (defined $values[2]) {

my $name = $self->mpc_basename($file);

$name =~ s/\.[^\.]+$//;

$status = 0;

$error = 'Aggregated workspace (' . $name .

') can not inherit from another workspace';

}

else {

($status, $error) = $self->parse_scope($fh,

'',

$aggregated,

\%validNames,

$flags);

}

}

else {

$status = 0;

$error = 'Unable to aggregate ' . $file;

}

last;

}

}

else {

last;

}

}

close($fh);

if ($status) {

$self->{'aggregated_assign'}->{$file} =

$self->clone($self->get_assignment_hash());

$self->{'assign'} = $prev_assign;

}

$self->{'scoped_basedir'} = $psbd;

$self->{'current_aggregated'} = $pca;

$self->{'handled_scopes'}->{$aggregated} = $ag;

$self->{$self->{'type_check'}} = $tc;

$self->set_line_number($oline);

return $status, $error;

}

return 0, 'Unable to open ' . $file;

}

sub parse_scope {

my($self, $fh, $name, $type, $validNames, $flags, $elseflags) = @_;

if ($type eq $self->get_default_component_name()) {

$type = $self->{'wctype'};

}

if ($name eq 'exclude') {

return $self->parse_exclude($fh, $type, $flags);

}

elsif ($name eq 'associate') {

return $self->parse_associate($fh, $type);

}

elsif ($name eq 'specific') {

return $self->parse_specific($fh, $type, $validNames, $flags, $elseflags);

}

else {

return $self->SUPER::parse_scope($fh, $name, $type,

$validNames, $flags, $elseflags);

}

}

sub process_types {

my($self, $typestr) = @_;

my $wcprops = $self->get_properties();

my %types;

my %props;

@types{split(/\s*,\s*/, $typestr)} = ();

## If there is a property in the typestr, i.e., prop:, then

## we need to extract it into its own collection while removing

## it from the types collection.

if (index($typestr, 'prop:') >= 0) {

foreach my $key (keys %types) {

if ($key =~ /^prop:\s*(\w+)/) {

## Add the property to the prop hash.

$props{$1} = 1;

## Remove the original property from the types.

delete $types{$key};

}

elsif ($key =~ /^!prop:\s*(\w+)/) {

## Negate the property.

$props{$1} = 0;

## Remove the original property from the types.

delete $types{$key};

}

}

}

## Now, process the properties and determine if this project

## type should be excluded. This will be the case if the property

## is valid and there exists a match between the listed properties

## and the workspace properties.

while (my ($key, $val) = each %props) {

if (exists $$wcprops{$key}) {

if ($$wcprops{$key} == 1 and $$wcprops{$key} == $val) {

$types{$self->{wctype}} = 1;

}

else {

delete $types{$self->{wctype}};

}

}

elsif ($val == 0) {

$types{$self->{wctype}} = 1;

}

}

## Remove all negated types from the collection.

foreach my $key (keys %types) {

if ($key =~ /^!\s*(\w+)/) {

if ($1 eq $self->{wctype}) {

## Remove the negated key

delete $types{$key};

## Then delete the key that was negated in the exclusion

delete $types{$1};

}

}

}

return \%types;

}

sub parse_exclude {

my($self, $fh, $typestr, $flags) = @_;

my $status = 0;

my $errorString = 'Unable to process exclude';

my $negated = (index($typestr, '!') >= 0);

my $types = $self->process_types($typestr);

my $count = 1;

my @exclude;

if (exists $$types{$self->{wctype}}) {

while (<$fh>) {

my $line = $self->preprocess_line($fh, $_);

if ($line eq '') {

}

elsif ($line =~ /^}(.*)$/) {

--$count;

if (defined $1 && $1 ne '') {

$status = 0;

$errorString = "Trailing characters found: '$1'";

}

else {

$status = 1;

$errorString = undef;

}

last if ($count == 0);

}

else {

if ($line =~ /^(\w+)\s*(\([^\)]+\))?\s*{$/) {

++$count;

}

elsif ($self->parse_assignment($line, [], $fh)) {

## Ignore all assignments

}

else {

if ($line =~ /^"([^"]+)"$/) {

$line = $1;

}

## If the line contains a variable, try to replace it with an

## actual value.

$line = $self->relative($line) if (index($line, '$') >= 0);

if (defined $self->{'scoped_basedir'} &&

$self->path_is_relative($line)) {

$line = $self->{'scoped_basedir'} . '/' . $line;

}

if ($line =~ /[\?\*\[\]]/) {

push(@exclude, $self->mpc_glob($line));

}

else {

push(@exclude, $line);

}

}

}

}

foreach my $type (keys %$types) {

if (!defined $self->{'exclude'}->{$type}) {

$self->{'exclude'}->{$type} = [];

}

push(@{$self->{'exclude'}->{$type}}, @exclude);

}

}

else {

if ($negated) {

($status, $errorString) = $self->SUPER::parse_scope($fh,

'exclude',

$typestr,

\%validNames,

$flags);

}

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>) {

my $line = $self->preprocess_line($fh, $_);

if ($line =~ /^(\w+)\s*(\([^\)]+\))?\s*{$/) {

++$count;

}

elsif ($line =~ /^}(.*)$/) {

--$count;

if (defined $1 && $1 ne '') {

$status = 0;

$errorString = "Trailing characters found: '$1'";

}

else {

$status = 1;

$errorString = undef;

}

last if ($count == 0);

}

}

}

}

return $status, $errorString;

}

sub parse_associate {

my($self, $fh, $assoc_key) = @_;

my $status = 0;

my $errorString = 'Unable to process associate';

my $count = 1;

my @projects;

if (!defined $self->{'associated'}->{$assoc_key}) {

$self->{'associated'}->{$assoc_key} = {};

}

while (<$fh>) {

my $line = $self->preprocess_line($fh, $_);

if ($line eq '') {

}

elsif ($line =~ /^}(.*)$/) {

--$count;

if (defined $1 && $1 ne '') {

$errorString = "Trailing characters found: '$1'";

last;

}

else {

$status = 1;

$errorString = undef;

}

last if ($count == 0);

}

else {

if ($line =~ /^(\w+)\s*(\([^\)]+\))?\s*{$/) {

++$count;

}

elsif ($self->parse_assignment($line, [], $fh)) {

$errorString = 'Assignments are not ' .

'allowed within an associate scope';

last;

}

else {

if ($line =~ /^"([^"]+)"$/) {

$line = $1;

}

## If the line contains a variable, try to replace it with an

## actual value.

$line = $self->relative($line) if (index($line, '$') >= 0);

if (defined $self->{'scoped_basedir'} &&

$self->path_is_relative($line)) {

$line = $self->{'scoped_basedir'} . '/' . $line;

}

if ($line =~ /[\?\*\[\]]/) {

foreach my $file ($self->mpc_glob($line)) {

$self->{'associated'}->{$assoc_key}->{$file} = 1;

}

}

else {

$self->{'associated'}->{$assoc_key}->{$line} = 1;

}

}

}

}

return $status, $errorString;

}

sub parse_specific {

my($self, $fh, $typestr, $validNames, $flags, $elseflags) = @_;

my $types = $self->process_types($typestr);

my $wctype = $self->{'wctype'};

my $matches = exists $types->{$wctype};

# $elseflags needs to be defined for Creator::parse_scope to allow "} else {"

$elseflags = {} unless defined $elseflags;

# Assignments within 'specific' always go to the workspace-level assignment

# hash table instead of the $flags bound to the scope.

my $assign = $self->get_assignment_hash();

return $self->SUPER::parse_scope($fh, 'specific', $matches ? $wctype : undef,

$validNames, $matches ? ($assign, $elseflags)

: (undef, $assign));

}

sub handle_unknown_assignment {

my $self = shift;

my $type = shift;

my @values = @_;

if (defined $type) {

$self->process_any_assignment(undef, @values);

}

return 1, undef;

}

sub excluded {

my($self, $file) = @_;

foreach my $excluded (@{$self->{'exclude'}->{$self->{'wctype'}}}) {

return 1 if ($excluded eq $file || index($file, "$excluded/") == 0);

}

return 0;

}

sub handle_scoped_end {

my($self, $type, $flags) = @_;

my $status = 1;

my $error;

## Replace instances of $PWD with the current directory plus the

## scoped_basedir. We have to do it now otherwise, $PWD will be the

## wrong directory if it's done later.

if (defined $$flags{'cmdline'} && defined $self->{'scoped_basedir'} &&

index($$flags{'cmdline'}, '$PWD') >= 0) {

my $dir = $self->getcwd() . '/' . $self->{'scoped_basedir'};

$$flags{'cmdline'} =~ s/\$PWD(\W)/$dir$1/g;

$$flags{'cmdline'} =~ s/\$PWD$/$dir/;

}

if ($type eq $aggregated && !defined $self->{'handled_scopes'}->{$type}) {

## Go back to the previous directory and add the directory contents

($status, $error) = $self->handle_scoped_unknown(undef, $type, $flags, '.');

}

$self->{'handled_scopes'}->{$type} = undef;

return $status, $error;

}

sub handle_scoped_unknown {

my($self, $fh, $type, $flags, $line) = @_;

my $status = 1;

my $error;

my $dupchk;

## If $type is undef, we are in a skipped part of a specific block

return 1 unless defined $type;

if ($line =~ /^\w+.*{/) {

if (defined $fh) {

my @values;

my $tc = $self->{$self->{'type_check'}};

$self->{$self->{'type_check'}} = 1;

($status, $error, @values) = $self->parse_line($fh, $line, $flags);

$self->{$self->{'type_check'}} = $tc;

}

else {

$status = 0;

$error = 'Unhandled line: ' . $line;

}

return $status, $error;

}

## If the line contains a variable, try to replace it with an actual

## value.

if (index($line, '$') >= 0) {

$line = $self->relative($line);

}

elsif (defined $self->{'scoped_basedir'}) {

if ($self->path_is_relative($line)) {

if ($line eq '.') {

$line = $self->{'scoped_basedir'};

}

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

## the current working directory from the front. This will get

## it down to a path that's relative to the current directory and

## likely to match up with the addition of this file or directory

## from an upper workspace.

my $cwd = $self->getcwd();

$line = $self->abs_path($self->{'scoped_basedir'} . "/$line");

if (index($line, $cwd) == 0) {

$line = substr($line, length($cwd) + 1);

}

}

}

}

## We must build up the list of project files and use them as the

## keys in the duplicate hash check. We need to call

## search_for_files() because the user may have just listed

## directories in the workspace and we need to deal with mpc files.

my @files;

$self->search_for_files($self->{'project_files'}, \@files);

my %dup;

@dup{@files} = ();

$dupchk = \%dup;

## If the aggregated workspace contains a scope (other than exclude)

## it will be processed in the block above and we will eventually get

## here, but by that time $type will no longer be $aggregated. So,

## we just need to set it here to ensure that we don't add everything

## in the scoped_basedir directory in handle_scoped_end()

$self->{'handled_scopes'}->{$aggregated} = 1;

if (-d $line) {

my @files;

$self->search_for_files([ $line ], \@files, $$flags{'implicit'});

## If we are generating implicit projects within a scope, then

## we need to remove directories and the parent directories for which

## there is an mpc file. Otherwise, the projects will be added

## twice.

if ($$flags{'implicit'}) {

my %remove;

foreach my $file (@files) {

if ($file =~ /\.mpc$/) {

my $exc = $file;

do {

$exc = $self->mpc_dirname($exc);

$remove{$exc} = 1;

} while ($exc ne '.' && $exc !~ /[a-z]:[\/\\]/i);

}

}

my @acceptable;

foreach my $file (@files) {

push(@acceptable, $file) if (!defined $remove{$file});

}

@files = @acceptable;

}

foreach my $file (@files) {

$self->add_aggregated_mpc($file, $dupchk, $flags);

}

}

else {

foreach my $expfile ($line =~ /[\?\*\[\]]/ ? $self->mpc_glob($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 {

$self->add_aggregated_mpc($expfile, $dupchk, $flags);

}

}

}

$self->{'handled_scopes'}->{$type} = 1;

return $status, $error;

}

sub add_aggregated_mpc {

my($self, $file, $dupchk, $flags) = @_;

if (!$self->excluded($file)) {

if (defined $dupchk && exists $$dupchk{$file}) {

$self->information("Duplicate mpc file ($file) added by an " .

'aggregate workspace. It will be ignored.');

}

else {

$self->{'scoped_assign'}->{$file} = $flags;

push(@{$self->{'project_files'}}, $file);

push(@{$self->{'aggregated_mpc'}->{$self->{'current_aggregated'}}},

$file) if defined $self->{'current_aggregated'};

}

}

}

sub search_for_files {

my($self, $files, $array, $impl) = @_;

my $excluded = 0;

foreach my $file (@$files) {

if (-d $file) {

my @f = $self->generate_default_file_list(

$file,

$self->{'exclude'}->{$self->{'wctype'}},

\$excluded);

$self->search_for_files(\@f, $array, $impl);

if ($impl) {

$file =~ s/^\.\///;

# Strip out ^ symbols

$file =~ s/\^//g if ($onVMS);

unshift(@$array, $file);

}

}

elsif ($file =~ /\.mpc$/) {

$file =~ s/^\.\///;

# Strip out ^ symbols

$file =~ s/\^//g if ($onVMS);

unshift(@$array, $file);

}

}

return $excluded;

}

sub remove_duplicate_projects {

my($self, $list) = @_;

my $count = scalar(@$list);

for (my $i = 0; $i < $count; ++$i) {

my $file = $$list[$i];

foreach my $inner (@$list) {

if ($file ne $inner &&

$file eq $self->mpc_dirname($inner) && ! -d $inner) {

splice(@$list, $i, 1);

--$count;

--$i;

last;

}

}

}

}

sub generate_default_components {

my($self, $files, $impl, $excluded) = @_;

my $pjf = $self->{'project_files'};

if (defined $$pjf[0]) {

## If we have files, then process directories

my @built;

foreach my $file (@$pjf) {

if (!$self->excluded($file)) {

if (-d $file) {

my @found;

my @gen = $self->generate_default_file_list(

$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 {

push(@built, $file);

}