workspacecreator.pm

这是广泛使用的通信开源项目,对于大容量,高并发的通讯要求完全能够胜任,他广泛可用于网络游戏医学图像网关的高qos要求.更详细的内容可阅读相应的材料

      ## 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;
          print "WARNING: Duplicate case-insensitive project '$name'.\n";
        }
        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) {
      print "ERROR: Duplicate project names are " .
            "not allowed within a workspace.\n";
      $abort_creation = 1;
    }
    else {
      if (!defined $self->{'projects'}->[0]) {
        print "WARNING: No projects were created.\n";
        $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 = "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 = '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 = "ERROR: Unable to open $name for output.";
          $status = 0;
        }
      }
    }
    else {
      print "         Workspace $name has not been created.\n";
    }
    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.
  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();

      ## Add implict project dependencies based on source files
      ## that have been used by multiple projects
      if ($self->generate_implicit_project_dependencies()) {
        $self->add_implicit_project_dependencies($creator, $self->getcwd());
      }

      my($status, $error) = $self->write_workspace($creator);
      if (!$status) {
        print STDERR "$error\n";
      }
      $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();

    ## Add implict project dependencies based on source files
    ## that have been used by multiple projects
    if ($self->generate_implicit_project_dependencies()) {
      $self->add_implicit_project_dependencies($creator, $self->getcwd());
    }

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


sub generate_project_files {
  my($self)      = shift;
  my($status)    = (scalar @{$self->{'project_files'}} == 0 ? 1 : 0);
  my(@projects)  = ();
  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 we need to generate a workspace file per project
          ## then we generate a temporary project info and projects
          ## array and call write_project().
          if ($dir ne '.' && defined $$gen[0] &&
              $self->workspace_per_project() && !$self->get_hierarchy()) {
            my(%perpi)       = ();
            my(@perprojects) = ();
            $self->save_project_info($gen, $gpi, '.', \@perprojects, \%perpi);

            ## Set our per project information
            $self->{'projects'}     = \@perprojects;
            $self->{'project_info'} = \%perpi;

            ## Add implict project dependencies based on source files
            ## that have been used by multiple projects
            if ($genimpdep) {
              $self->add_implicit_project_dependencies($creator,
                                                       $self->getcwd());
            }

            ## Write our per project workspace
            my($error) = '';
            ($status, $error) = $self->write_workspace($creator);
            if (!$status) {
              print STDERR "$error\n";
            }

            ## Reset our project information to empty
            $self->{'projects'}     = [];
            $self->{'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;
    }
  }

  if ($self->get_hierarchy()) {
    my($orig) = $self->{'workspace_name'};
    $self->generate_hierarchy($creator, \@projects, \%pi);
    $self->{'workspace_name'} = $orig;
  }

  $self->{'projects'}     = \@projects;
  $self->{'project_info'} = \%pi;

  ## Add implict project dependencies based on source files
  ## that have been used by multiple projects
  if ($status && $genimpdep) {
    $self->add_implicit_project_dependencies($creator, $cwd);
  }

  return $status, $creator;
}


sub array_contains {
  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;
    }
    elsif (defined $over) {
      push(@$over, $r);
    }
  }
  return $status;
}


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) {
      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->array_contains(
                      $self->{'project_file_list'}->{$key}->[2],
                      $self->{'project_file_list'}->{$ikey}->[2],
                      \@over)) {
          $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[\/\\]*//;
          if ($dir ne '') {
            $file = "$dir/$file";
          }

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

          ## 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->{'project_info'}->{$ccheck}->[1] !~ /$cfile/) {
            ## Append the dependency