workspacecreator.pm

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

            $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 generate_circular_tree {
  my($self)     = shift;
  my($circular) = shift;
  my($prepend)  = shift;
  my($into)     = shift;
  my($current)  = shift;
  my($aref)     = $self->{'project_info'}->{$current};

  if (defined $aref) {
    my($name, $deps) = @$aref;

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

      if (!defined $$circular{$into}) {
        $$circular{$into} = {};
      }

      foreach my $dep (@$darr) {
        my($base) = basename($dep);
        my($full) = (defined $$prepend{$base} ?
                       "$$prepend{$base}/" : '') . $base;
        if (!defined $$circular{$into}->{$full}) {
          $$circular{$into}->{$full} = 1;
          $self->generate_circular_tree($circular, $prepend, $into, $full);
        }
      }
    }
  }
}


sub sort_dependencies {
  my($self)     = shift;
  my($projects) = shift;
  my($pjs)      = shift;
  my($prepref)  = shift;
  my(@list)     = @$projects;
  my(%prepend)  = ();

  foreach my $project (@list) {
    my($dname) = dirname($project);
    if ($dname ne '.') {
      $prepend{basename($project)} = $dname;
    }
  }

  if (defined $prepref) {
    %$prepref = %prepend;
  }

  ## This will help us catch circular dependencies
  my(%circular) = ();

  ## Put the projects in the order specified
  ## by the project dpendencies.
  for(my $i = 0; $i <= $#list; ++$i) {
    my($project) = $list[$i];
    my($name) = $$pjs{$project}->[0];
    my($deps) = $self->get_validated_ordering($project);

    if ($deps ne '') {
      my($darr) = $self->create_array($deps);

      ## Set up the circular entry
      $self->generate_circular_tree(\%circular, \%prepend, $project, $project);

      my($moved) = 0;
      foreach my $dep (@$darr) {
        my($base) = basename($dep);
        my($full) = (defined $prepend{$base} ?
                       "$prepend{$base}/" : '') . $base;
        if ($project ne $full) {
          ## See if the dependency is listed after this project
          for(my $j = $i + 1; $j <= $#list; ++$j) {
            if ($list[$j] eq $full) {
              if (defined $circular{$full} &&
                  defined $circular{$full}->{$list[$j]}) {
                ## Don't warn about circular dependencies if we are
                ## generating implicit project dependencies.  The
                ## dependencies in question may have been generated and
                ## that's not the users fault.
                if (!$self->generate_implicit_project_dependencies() ||
                    defined $ENV{MPC_VERBOSE_CIRCULAR}) {
                  print 'WARNING: Circular dependency between ' .
                        "$list[$j] and $project\n";
                }
              }
              else {
                ## 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).
                for(my $k = $j; $k > $i; --$k) {
                  $list[$k] = $list[$k - 1];
                }
                $list[$i] = $full;

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


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

  ## 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) {
          my($base) = basename($dep);
          my($full) = (defined $prepend{$base} ?
                         "$prepend{$base}/" : '') . $base;
          for(my $j = 0; $j < $i; ++$j) {
            if ($list[$j] eq $full) {
              $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;
  print 'WARNING: ' . $self->get_current_input() . ": $str\n";
}


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->{'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'});
}


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, 1);
  }
}


sub get_validated_ordering {
  my($self)     = shift;
  my($project)  = shift;
  my($warn)     = shift;
  my($pjs)      = $self->{'project_info'};
  my($name)     = undef;
  my($deps)     = '';

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

    $deps =~ s/^\s+//;
    $deps =~ s/\s+$//;
  }

  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;