workspacecreator.pm

ACE源码

  my(%pi)        = ();
  my($creator)   = $self->project_creator();
  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();

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

  foreach my $ofile (@{$self->{'project_files'}}) {
    if (!$self->excluded($ofile)) {
      my($file)    = $ofile;
      my($dir)     = 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($gen) = [];
        my($gpi) = [];
        if ($self->{'cacheok'} && defined $allprojects{$prkey}) {
          $gen = $allprojects{$prkey};
          $gpi = $allprinfo{$prkey};
          $status = 1;
        }
        else {
          $status = $creator->generate(basename($file));

          ## If any one project file fails, then stop
          ## processing altogether.
          if (!$status) {
            ## We don't restore the state before we leave,
            ## but that's ok since we will be exiting soon.
            return $status, $creator;
          }

          ## Get the individual project information and
          ## generated file name(s)
          $gen = $creator->get_files_written();
          $gpi = $creator->get_project_info();

          if ($self->{'cacheok'}) {
            $allprojects{$prkey} = $gen;
            $allprinfo{$prkey}   = $gpi;
          }
        }
        $self->cd($cwd);
        $self->save_project_info($gen, $gpi, $dir, \@projects, \%pi);
      }
      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;
      }

      ## Return things to the way they were
      if (defined $self->{'scoped_assign'}->{$ofile}) {
        $impl = $previmpl;
      }
      if ($restore) {
        $self->{'cacheok'} = $prevcache;
        $creator->restore_state(\%gstate);
      }
    }
    else {
      ## This one was excluded, so status is ok
      $status = 1;
    }
  }

  ## 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) {
    $self->add_implicit_project_dependencies($creator, $cwd);
  }

  ## If we are generating the hierarchical workspaces, then do so
  if ($self->get_hierarchy() || $self->workspace_per_project()) {
    my($orig) = $self->{'workspace_name'};
    $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;
}


sub array_contains {
  my($self)   = shift;
  my($left)   = shift;
  my($right)  = shift;
  my(%check)  = ();

  ## Initialize the hash keys with the left side array
  @check{@$left} = ();

  ## Check each element on the right against the left.
  foreach my $r (@$right) {
    if (exists $check{$r}) {
      return 1;
    }
  }

  return 0;
}


sub non_intersection {
  my($self)   = shift;
  my($left)   = shift;
  my($right)  = shift;
  my($over)   = shift;
  my($status) = 0;
  my(%check)  = ();

  ## Initialize the hash keys with the left side array
  @check{@$left} = ();

  ## Check each element on the right against the left.
  ## Store anything that isn't in the left side in the over array.
  foreach my $r (@$right) {
    if (exists $check{$r}) {
      $status = 1;
    }
    else {
      push(@$over, $r);
    }
  }
  return $status;
}


sub indirect_depdency {
  my($self)   = shift;
  my($dir)    = shift;
  my($ccheck) = shift;
  my($cfile)  = shift;

  if ($self->{'project_info'}->{$ccheck}->[1] =~ /$cfile/) {
    return 1;
  }
  else {
    my($deps) = $self->create_array(
                         $self->{'project_info'}->{$ccheck}->[1]);
    foreach my $dep (@$deps) {
      if (defined $self->{'project_info'}->{"$dir$dep"} &&
          $self->indirect_depdency($dir, "$dir$dep", $cfile)) {
        return 1;
      }
    }
  }

  return 0;
}


sub add_implicit_project_dependencies {
  my($self)      = shift;
  my($creator)   = shift;
  my($cwd)       = shift;
  my(%bidir)     = ();
  my(%save)      = ();

  ## Take the current working directory and regular expression'ize it.
  $cwd = $self->escape_regex_special($cwd);

  ## Look at each projects file list and check it against all of the
  ## others.  If any of the other projects file lists contains anothers
  ## file, then they are dependent (due to build parallelism).  So, we
  ## append the dependency and remove the file in question from the
  ## 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
      ## The same directory and
      ## We've not already added a dependency to this project
      if ($key ne $ikey &&
          ($self->{'project_file_list'}->{$key}->[1] eq
           $self->{'project_file_list'}->{$ikey}->[1]) &&
          (!defined $bidir{$ikey} ||
           !$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)) {
          ## 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 {
            $bidir{$key} = [$ikey];
          }
          my($append) = $creator->translate_value('after', $key);
          my($file)   = $self->{'project_file_list'}->{$ikey}->[0];
          my($dir)    = $self->{'project_file_list'}->{$ikey}->[1];
          my($cfile)  = $self->escape_regex_special(
                              $creator->translate_value('after', $ikey));
          ## Remove our starting directory from the projects directory
          ## to get the right part of the directory to prepend.
          $dir =~ s/^$cwd[\/\\]*//;

          ## Turn the append value into a key for 'project_info' and
          ## prepend the directory to the file.
          my($ccheck) = $append;
          $ccheck =~ s/"//g;
          if ($dir ne '') {
            $dir .= '/';
            $ccheck = "$dir$ccheck";
            $file = "$dir$file";
          }

          ## If the append value key contains a reference to the project
          ## that we were going to append the dependency value, then
          ## ignore the generated dependency.  It is redundant and
          ## quite possibly wrong.
          if (!defined $self->{'project_info'}->{$ccheck} ||
              !$self->indirect_depdency($dir, $ccheck, $cfile)) {
            ## Append the dependency
            $self->{'project_info'}->{$file}->[1] .= " $append";
          }
        }
      }
    }
  }

  ## Restore the modified values in case this method is called again
  ## which is the case when using the -hierarchy option.
  foreach my $skey (keys %save) {
    $self->{'project_file_list'}->{$skey}->[2] = $save{$skey};
  }
}


sub get_projects {
  my($self) = shift;
  return $self->{'projects'};
}


sub get_project_info {
  my($self) = shift;
  return $self->{'project_info'};
}


sub get_first_level_directory {
  my($self) = shift;
  my($file) = shift;
  my($dir)  = undef;
  if (($file =~ tr/\///) > 0) {
    $dir = $file;
    $dir =~ s/^([^\/]+\/).*/$1/;
    $dir =~ s/\/+$//;
  }
  else {
    $dir = '.';
  }
  return $dir;
}


sub sort_within_group {
  my($self)    = shift;
  my($list)    = shift;
  my($pjs)     = shift;
  my($start)   = shift;
  my($end)     = shift;
  my($deps)    = undef;
  my($ccount)  = 0;
  my($cmax)    = ($end - $start) + 1;

  ## If we go more than twice the number of elements in this group
  ## factorial, then there is a circular dependency.
  my($f) = $cmax - 1;
  while($f > 1) {
    $cmax *= $f--;
  }
  $cmax = ($cmax * 2) + 1;

  ## Put the projects in the order specified
  ## by the project dpendencies.
  for(my $i = $start; $i <= $end; ++$i) {
    ## Detect circular dependencies
    if ($ccount > $cmax) {
      $self->warning('Circular dependency detected while processing the ' .
                     ($self->{'current_input'} eq '' ?
                       'default' : $self->{'current_input'}) . ' workspace');
      return;
    }

    $deps = $self->get_validated_ordering($$list[$i]);
    if ($deps ne '') {
      my($baseproj) = basename($$list[$i]);
      my($darr) = $self->create_array($deps);

      my($moved) = 0;
      foreach my $dep (@$darr) {
        if ($baseproj ne $dep) {
          ## See if the dependency is listed after this project
          for(my $j = $i + 1; $j <= $end; ++$j) {
            if (basename($$list[$j]) eq $dep) {
              ## 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) {
                $$list[$k] = $$list[$k - 1];
              }
              $$list[$i] = $save;

              ## Mark that an entry has been moved
              $moved = 1;
              $j--;
            }
          }
        }
      }
      if ($moved) {
        $i--;
      }
    }
    ++$ccount;
  }
}


sub sort_by_groups {
  my($self)    = shift;
  my($list)    = shift;
  my($grindex) = shift;
  my(@groups)  = @$grindex;
  my($ccount)  = 0;
  my($cmax)    = $#groups;

  ## If we go more than twice $#groups factorial, then there is
  ## a circular dependency.
  my($f) = $cmax - 1;
  while($f > 1) {
    $cmax *= $f--;
  }
  $cmax = ($cmax * 2) + 1;

  for(my $gi = 0; $gi <= $#groups; ++$gi) {
    ## Detect circular dependencies
    if ($ccount > $cmax) {
      $self->warning('Circular dependency detected while processing the ' .
                     ($self->{'current_input'} eq '' ?
                       'default' : $self->{'current_input'}) . ' workspace');
      return;
    }

    ## Build up the group dependencies
    my(%gdeps) = ();
    for(my $i = $groups[$gi]->[0]; $i <= $groups[$gi]->[1]; ++$i) {
      my($deps) = $self->get_validated_ordering($$list[$i]);
      if ($deps ne '') {
        my($darr) = $self->create_array($deps);
        foreach my $dep (@$darr) {
          $gdeps{$dep} = 1;
        }
      }
    }

    ## Search the rest of the groups for any of the group dependencies
    my($moved) = 0;
    for(my $gj = $gi + 1; $gj <= $#groups; ++$gj) {
      for(my $i = $groups[$gj]->[0]; $i <= $groups[$gj]->[1]; ++$i) {
        if (defined $gdeps{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) {
            push(@save, $$list[$j]);
          }