workspacecreator.pm

ACE源码

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

      my(@acceptable) = ();
      foreach my $file (@files) {
        if (!defined $remove{$file}) {
          push(@acceptable, $file);
        }
      }
      @files = @acceptable;
    }

    if (defined $dupchk) {
      foreach my $file (@files) {
        if (exists $$dupchk{$file}) {
          $self->warning("Duplicate mpc file ($file) added by an " .
                         'aggregate workspace.  It will be ignored.');
        }
        else {
          $self->{'scoped_assign'}->{$file} = $flags;
          push(@{$self->{'project_files'}}, $file);
        }
      }
    }
    else {
      foreach my $file (@files) {
        $self->{'scoped_assign'}->{$file} = $flags;
        push(@{$self->{'project_files'}}, $file);
      }
    }
  }
  else {
    if ($line =~ /\.$wsext$/) {
      ## An aggregated workspace within an aggregated workspace.
      ($status, $error) = $self->aggregated_workspace($line);
    }
    else {
      if (defined $dupchk && exists $$dupchk{$line}) {
        $self->warning("Duplicate mpc file ($line) added by an " .
                       'aggregate workspace.  It will be ignored.');
      }
      else {
        $self->{'scoped_assign'}->{$line} = $flags;
        push(@{$self->{'project_files'}}, $line);
      }
    }
  }
  $self->{'handled_scopes'}->{$type} = 1;

  return $status, $error;
}


sub search_for_files {
  my($self)  = shift;
  my($files) = shift;
  my($array) = shift;
  my($impl)  = shift;

  foreach my $file (@$files) {
    if (-d $file) {
      my(@f) = $self->generate_default_file_list(
                         $file,
                         $self->{'exclude'}->{$self->{'wctype'}});
      $self->search_for_files(\@f, $array, $impl);
      if ($impl) {
        unshift(@$array, $file);
      }
    }
    else {
      if ($file =~ /\.mpc$/) {
        unshift(@$array, $file);
      }
    }
  }
}


sub remove_duplicate_projects {
  my($self)  = shift;
  my($list)  = shift;
  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 dirname($inner) && ! -d $inner) {
        splice(@$list, $i, 1);
        --$count;
        --$i;
        last;
      }
    }
  }
}


sub generate_default_components {
  my($self)  = shift;
  my($files) = shift;
  my($impl)  = shift;
  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);
        }
      }
    }

    ## If the workspace is set to implicit
    if ($impl) {
      ## Remove duplicates from this list
      $self->remove_duplicate_projects(\@built);
    }

    ## Set the project files
    $self->{'project_files'} = \@built;
  }
  else {
    ## Add all of the wanted files in this directory
    ## and in the subdirectories.
    $self->search_for_files($files, $pjf, $impl);

    ## If the workspace is set to implicit
    if ($impl) {
      ## Remove duplicates from this list
      $self->remove_duplicate_projects($pjf);
    }

    ## If no files were found, then we push the empty
    ## string, so the Project Creator will generate
    ## the default project file.
    if (!defined $$pjf[0]) {
      push(@$pjf, '');
    }
  }
}


sub get_default_workspace_name {
  my($self) = shift;
  my($name) = $self->{'current_input'};

  if ($name eq '') {
    $name = $self->base_directory();
  }
  else {
    ## Since files on UNIX can have back slashes, we transform them
    ## into underscores.
    $name =~ s/\\/_/g;

    ## Take off the extension
    $name =~ s/\.[^\.]+$//;
  }

  return $name;
}


sub generate_defaults {
  my($self) = shift;

  ## Generate default workspace name
  if (!defined $self->{'workspace_name'}) {
    $self->{'workspace_name'} = $self->get_default_workspace_name();
  }

  my(@files) = $self->generate_default_file_list(
                        '.',
                        $self->{'exclude'}->{$self->{'wctype'}});

  ## Generate default components
  $self->generate_default_components(\@files,
                                     $self->get_assignment('implicit'));
}


sub get_workspace_name {
  my($self) = shift;
  return $self->{'workspace_name'};
}


sub write_workspace {
  my($self)      = shift;
  my($creator)   = shift;
  my($addfile)   = shift;
  my($status)    = 1;
  my($error)     = undef;
  my($duplicates) = 0;

  if ($self->get_toplevel()) {
    my($progress) = $self->get_progress_callback();

    if (defined $progress) {
      &$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
      my(%names) = ();
      foreach my $project (@{$self->{'projects'}}) {
        my($name) = lc($self->{'project_info'}->{$project}->[0]);
        if (defined $names{$name}) {
          ++$duplicates;
          $self->error("Duplicate case-insensitive project '$name'.");
        }
        else {
          $names{$name} = 1;
        }
      }
    }
    else {
      $self->{'per_project_workspace_name'} = 1;
    }

    my($name) = $self->transform_file_name($self->workspace_file_name());

    my($abort_creation) = 0;
    if ($duplicates > 0) {
      $abort_creation = 1;
      $error = "Duplicate case-insensitive project names are " .
               "not allowed within a workspace.";
      $status = 0;
    }
    else {
      if (!defined $self->{'projects'}->[0]) {
        $self->information('No projects were created.');
        $abort_creation = 1;
      }
    }

    if (!$abort_creation) {
      my($fh)  = new FileHandle();
      my($dir) = dirname($name);

      ## Verify and possibly modify the dependencies
      if ($addfile) {
        $self->verify_build_ordering();
      }

      if ($dir ne '.') {
        mkpath($dir, 0, 0777);
      }

      if ($self->compare_output()) {
        ## First write the output to a temporary file
        my($tmp) = "MWC$>.$$";
        my($different) = 1;
        if (open($fh, ">$tmp")) {
          $self->pre_workspace($fh);
          $self->write_comps($fh, $creator);
          $self->post_workspace($fh);
          close($fh);

          if (-r $name &&
              -s $tmp == -s $name && compare($tmp, $name) == 0) {
            $different = 0;
          }
        }
        else {
          $error = "Unable to open $tmp for output.";
          $status = 0;
        }

        if ($status) {
          if ($different) {
            unlink($name);
            if (rename($tmp, $name)) {
              if ($addfile) {
                $self->add_file_written($name);
              }
            }
            else {
              $error = 'Unable to open ' . $self->getcwd() .
                       "/$name for output";
              $status = 0;
            }
          }
          else {
            ## We will pretend that we wrote the file
            unlink($tmp);
            if ($addfile) {
              $self->add_file_written($name);
            }
          }
        }
      }
      else {
        if (open($fh, ">$name")) {
          $self->pre_workspace($fh);
          $self->write_comps($fh, $creator);
          $self->post_workspace($fh);
          close($fh);

          if ($addfile) {
            $self->add_file_written($name);
          }
        }
        else {
          $error = "Unable to open $name for output.";
          $status = 0;
        }
      }
    }

    if (!$addfile) {
      $self->{'per_project_workspace_name'} = undef;
    }
  }

  return $status, $error;
}


sub save_project_info {
  my($self)     = shift;
  my($gen)      = shift;
  my($gpi)      = shift;
  my($dir)      = shift;
  my($projects) = shift;
  my($pi)       = shift;
  my($c)        = 0;

  ## For each file written
  foreach my $pj (@$gen) {
    ## Save the full path to the project file in the array
    my($full) = ($dir ne '.' ? "$dir/" : '') . $pj;
    push(@$projects, $full);

    ## Get the corresponding generated project info and save it
    ## in the hash map keyed on the full project file name
    $$pi{$full} = $$gpi[$c];
    $c++;
  }
}


sub topname {
  my($self) = shift;
  my($file) = shift;
  my($dir)  = '.';
  my($rest) = $file;
  if ($file =~ /^([^\/\\]+)[\/\\](.*)/) {
    $dir  = $1;
    $rest = $2;
  }
  return $dir, $rest;
}


sub generate_hierarchy {
  my($self)      = shift;
  my($creator)   = shift;
  my($origproj)  = shift;
  my($originfo)  = shift;
  my($current)   = undef;
  my(@saved)     = ();
  my(%sinfo)     = ();
  my($cwd)       = $self->getcwd();

  ## Make a copy of these.  We will be modifying them.
  ## It is necessary to sort the project to get the correct ordering.
  my(@projects)  = sort @{$origproj};
  my(%projinfo)  = %{$originfo};

  foreach my $prj (@projects) {
    my($top, $rest) = $self->topname($prj);

    if (!defined $current) {
      $current = $top;
      push(@saved, $rest);
      $sinfo{$rest} = $projinfo{$prj};
    }
    elsif ($top ne $current) {
      ## Write out the hierachical workspace
      $self->cd($current);
      $self->generate_hierarchy($creator, \@saved, \%sinfo);

      $self->{'projects'}       = \@saved;
      $self->{'project_info'}   = \%sinfo;
      $self->{'workspace_name'} = $self->base_directory();

      my($status, $error) = $self->write_workspace($creator);
      if (!$status) {
        $self->error($error);
      }
      $self->cd($cwd);

      ## Start the next one
      $current = $top;
      @saved = ($rest);
      %sinfo = ();
      $sinfo{$rest} = $projinfo{$prj};
    }
    else {
      push(@saved, $rest);
      $sinfo{$rest} = $projinfo{$prj};
    }
  }
  if (defined $current && $current ne '.') {
    $self->cd($current);
    $self->generate_hierarchy($creator, \@saved, \%sinfo);

    $self->{'projects'}       = \@saved;
    $self->{'project_info'}   = \%sinfo;
    $self->{'workspace_name'} = $self->base_directory();

    my($status, $error) = $self->write_workspace($creator);
    if (!$status) {
      $self->error($error);
    }
    $self->cd($cwd);
  }
}


sub generate_project_files {
  my($self)      = shift;
  my($status)    = (scalar @{$self->{'project_files'}} == 0 ? 1 : 0);
  my(@projects)  = ();