workspacecreator.pm

ACE源码

          my($offset) = $groups[$gj]->[1] - $groups[$gi]->[1];
          for(my $j = $groups[$gi]->[1]; $j >= $groups[$gi]->[0]; --$j) {
            $$list[$j + $offset] = $$list[$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) {
            $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) {
            $groups[$j] = $groups[$j + 1];
          }
          $groups[$gj] = \@grsave;

          ## Signify that we have moved a group
          $moved = 1;
          last;
        }
      }
      if ($moved) {
        ## Start over from the first group
        $gi = -1;
        last;
      }
    }
    ++$ccount;
  }
}


sub sort_dependencies {
  my($self)     = shift;
  my($projects) = shift;
  my($pjs)      = shift;
  my(@list)     = sort @$projects;

  ## Put the projects in the order specified
  ## by the project dpendencies.  We only need to do
  ## this if there is more than one element in the array.
  if ($#list > 0) {
    ## First determine the individual groups
    my(@grindex)  = ();
    my($previous) = [0, undef];
    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) {
        push(@grindex, [$previous->[0], $li - 1]);
        $previous = [$li, $dir];
      }
    }
     push(@grindex, [$previous->[0], $#list]);

    ## Next, sort the individual groups
    foreach my $gr (@grindex) {
      if ($$gr[0] != $$gr[1]) {
        $self->sort_within_group(\@list, $pjs, @$gr);
      }
    }

    ## Now sort the groups as single entities
    if ($#grindex > 0) {
      $self->sort_by_groups(\@list, \@grindex);
    }
  }

  return @list;
}


sub number_target_deps {
  my($self)     = shift;
  my($projects) = shift;
  my($pjs)      = shift;
  my($targets)  = shift;
  my(@list)     = $self->sort_dependencies($projects, $pjs);

  ## 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) {
    my($project) = $list[$i];
    if (defined $$pjs{$project}) {
      my($name, $deps) = @{$$pjs{$project}};
      if (defined $deps && $deps ne '') {
        my(%targetnumbers) = ();
        my($darr) = $self->create_array($deps);

        ## For each dependency, search in the sorted list
        ## 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 a hash map (to avoid
        ## duplicates).
        foreach my $dep (@$darr) {
          for(my $j = 0; $j < $i; ++$j) {
            if (basename($list[$j]) eq $dep) {
              $targetnumbers{$j} = 1;
            }
          }
        }

        ## Get the keys of the hash map and store the
        ## array in the hash keyed on the project file.
        my(@numbers) = sort { $a <=> $b } keys %targetnumbers;
        if (defined $numbers[0]) {
          $$targets{$project} = \@numbers;
        }
      }
    }
  }

  return @list;
}


sub optionError {
  my($self) = shift;
  my($str)  = shift;
  $self->warning("$self->{'current_input'}: $str.");
}


sub process_cmdline {
  my($self)       = shift;
  my($cmdline)    = shift;
  my($parameters) = shift;

  ## It's ok to use the cache
  $self->{'cacheok'} = 1;

  if (defined $cmdline && $cmdline ne '') {
    my($args) = $self->create_array($cmdline);

    ## Look for environment variables
    foreach my $arg (@$args) {
      while($arg =~ /\$(\w+)/) {
        my($name) = $1;
        my($val)  = '';
        if ($name eq 'PWD') {
          $val = $self->getcwd();
        }
        elsif (defined $ENV{$name}) {
          $val = $ENV{$name};
        }
        $arg =~ s/\$\w+/$val/;
      }
    }

    my($options) = $self->options('MWC', {}, 0, @$args);
    if (defined $options) {
      foreach my $key (keys %$options) {
        my($type) = $self->is_set($key, $options);

        if (!defined $type) {
          ## This option was not used, so we ignore it
        }
        elsif ($type eq 'ARRAY') {
          push(@{$parameters->{$key}}, @{$options->{$key}});
        }
        elsif ($type eq 'HASH') {
          foreach my $hk (keys %{$options->{$key}}) {
            $parameters->{$key}->{$hk} = $options->{$key}->{$hk};
          }
        }
        elsif ($type eq 'SCALAR') {
          $parameters->{$key} = $options->{$key};
        }
      }

      ## Issue warnings for these options
      if (defined $options->{'recurse'}) {
        $self->optionError('-recurse is ignored');
      }
      if (defined $options->{'reldefs'}) {
        $self->optionError('-noreldefs is ignored');
      }
      if (defined $options->{'coexistence'}) {
        $self->optionError('-make_coexistence is ignored');
      }
      if (defined $options->{'genins'}) {
        $self->optionError('-genins is ignored');
      }
      if (defined $options->{'input'}->[0]) {
        $self->optionError('Command line files ' .
                           'specified in a workspace are ignored');
      }

      ## Determine if it's ok to use the cache
      my(@cacheInvalidating) = ('global', 'include', 'baseprojs',
                                'template', 'ti', 'relative',
                                'addtemp', 'addproj', 'feature_file');
      foreach my $key (@cacheInvalidating) {
        if ($self->is_set($key, $options)) {
          $self->{'cacheok'} = 0;
          last;
        }
      }
    }
  }
}


sub current_parameters {
  my($self) = shift;
  my(%parameters) = $self->save_state();

  ## We always want the project creator to generate a toplevel
  $parameters{'toplevel'} = 1;
  return %parameters;
}


sub project_creator {
  my($self) = shift;
  my($str)  = "$self";

  ## NOTE: If the subclassed WorkspaceCreator name prefix does not
  ##       match the name prefix of the ProjectCreator, this code
  ##       will not work and the subclassed WorkspaceCreator will
  ##       need to override this method.

  $str =~ s/Workspace/Project/;
  $str =~ s/=HASH.*//;

  ## Set up values for each project creator
  ## If we have command line arguments in the workspace, then
  ## we process them before creating the project creator
  my($cmdline)    = $self->get_assignment('cmdline');
  my(%parameters) = $self->current_parameters();
  $self->process_cmdline($cmdline, \%parameters);

  ## Create the new project creator with the updated parameters
  return $str->new($parameters{'global'},
                   $parameters{'include'},
                   $parameters{'template'},
                   $parameters{'ti'},
                   $parameters{'dynamic'},
                   $parameters{'static'},
                   $parameters{'relative'},
                   $parameters{'addtemp'},
                   $parameters{'addproj'},
                   $parameters{'progress'},
                   $parameters{'toplevel'},
                   $parameters{'baseprojs'},
                   $self->{'global_feature_file'},
                   $parameters{'feature_file'},
                   $parameters{'hierarchy'},
                   $self->{'exclude'}->{$self->{'wctype'}},
                   $self->make_coexistence(),
                   $parameters{'name_modifier'},
                   $parameters{'apply_project'},
                   $self->{'generate_ins'});
}


sub sort_files {
  #my($self) = shift;
  return 0;
}


sub make_coexistence {
  my($self) = shift;
  return $self->{'coexistence'};
}


sub get_modified_workspace_name {
  my($self)   = shift;
  my($name)   = shift;
  my($ext)    = shift;
  my($nmod)   = $self->get_name_modifier();

  if (defined $nmod) {
    $nmod =~ s/\*/$name/g;
    $name = $nmod;
  }

  ## If this is a per project workspace, then we should not
  ## modify the workspace name.  It may overwrite another workspace
  ## but that's ok, it will also be a per project workspace.
  if ($self->{'per_project_workspace_name'}) {
    return "$name$ext";
  }

  my($pwd)    = $self->getcwd();
  my($type)   = $self->{'wctype'};
  my($wsname) = $self->get_workspace_name();

  if (!defined $previous_workspace_name{$type}->{$pwd}) {
    $previous_workspace_name{$type}->{$pwd} = $wsname;
    $self->{'current_workspace_name'} = undef;
  }
  else {
    my($prefix) = ($name eq $wsname ? $name : "$name.$wsname");
    $previous_workspace_name{$type}->{$pwd} = $wsname;
    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";
  }

  return (defined $self->{'current_workspace_name'} ?
                  $self->{'current_workspace_name'} : "$name$ext");
}


sub generate_recursive_input_list {
  my($self)    = shift;
  my($dir)     = shift;
  my($exclude) = shift;
  return $self->extension_recursive_input_list($dir, $exclude, $wsext);
}


sub verify_build_ordering {
  my($self) = shift;
  foreach my $project (@{$self->{'projects'}}) {
    $self->get_validated_ordering($project);
  }
}


sub get_validated_ordering {
  my($self)    = shift;
  my($project) = shift;
  my($deps)    = undef;

  if (defined $self->{'ordering_cache'}->{$project}) {
    $deps = $self->{'ordering_cache'}->{$project};
  }
  else {
    $deps = '';
    if (defined $self->{'project_info'}->{$project}) {
      my($name) = undef;
      ($name, $deps) = @{$self->{'project_info'}->{$project}};
      if (defined $deps && $deps ne '') {
        my($darr) = $self->create_array($deps);
        foreach my $dep (@$darr) {
          my($found) = 0;
          ## Avoid circular dependencies
          if ($dep ne $name && $dep ne basename($project)) {
            foreach my $p (@{$self->{'projects'}}) {
              if ($dep eq $self->{'project_info'}->{$p}->[0] ||
                  $dep eq basename($p)) {
                $found = 1;
                last;
              }
            }
            if (!$found) {
              if (defined $ENV{MPC_VERBOSE_ORDERING}) {
                $self->warning("'$name' references '$dep' which has " .
                               "not been processed.");
              }
              my($reg) = $self->escape_regex_special($dep);
              $deps =~ s/\s*"$reg"\s*/ /g;
            }
          }
        }
      }

      $deps =~ s/^\s+//;
      $deps =~ s/\s+$//;
      $self->{'ordering_cache'}->{$project} = $deps;
    }
  }

  return $deps;
}


sub source_listing_callback {
  my($self)         = shift;
  my($project_file) = shift;
  my($project_name) = shift;
  my(@files)        = @_;
  my($cwd)          = $self->getcwd();
  $self->{'project_file_list'}->{$project_name} = [ $project_file,
                                                    $cwd, \@files ];
}

# ************************************************************
# Virtual Methods To Be Overridden
# ************************************************************

sub generate_implicit_project_dependencies {
  #my($self) = shift;
  return 0;
}


sub workspace_file_name {
  #my($self) = shift;
  return '';
}


sub workspace_per_project {
  #my($self) = shift;
  return 0;
}


sub pre_workspace {
  #my($self) = shift;
  #my($fh)   = shift;
}


sub write_comps {
  #my($self) = shift;
  #my($fh)   = shift;
  #my($gens) = shift;
}


sub post_workspace {
  #my($self) = shift;
  #my($fh)   = shift;
}


1;