projectcreator.pm

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

    }
  }

  if ($self->{'convert_slashes'}) {
    for(my $i = 0; $i <= $#list; $i++) {
      $list[$i] = $self->slash_to_backslash($list[$i]);
    }
  }

  if ($self->{'sort_files'}) {
    @list = sort { $self->file_sorter($a, $b) } @list;
  }

  return @list;
}


sub check_custom_output {
  my($self)    = shift;
  my($based)   = shift;
  my($pf)      = shift;
  my($cinput)  = shift;
  my($type)    = shift;
  my($comps)   = shift;
  my(@outputs) = ();
  my($gen)     = $self->{'generated_exts'}->{$based};

  if (defined $gen->{$type}) {
    foreach my $pe (@{$gen->{'pre_extension'}}) {
      foreach my $ext (@{$gen->{$type}}) {
        my($ge) = "$pe$ext";
        $ge =~ s/\\//g;
        my($built) = "$pf$cinput$ge";
        if (@$comps == 0) {
          push(@outputs, $built);
          last;
        }
        else {
          my($base) = $built;
          if ($self->{'convert_slashes'}) {
            $base =~ s/\\/\//g;
          }
          my($re) = $self->escape_regex_special(basename($base));
          foreach my $c (@$comps) {
            ## We only match if the built file name matches from
            ## beginning to end or from a slash to the end.
            if ($c =~ /^$re$/ || $c =~ /[\/\\]$re$/) {
              push(@outputs, $built);
              last;
            }
          }
        }
      }
    }
  }

  return @outputs;
}


sub get_special_value {
  my($self)  = shift;
  my($type)  = shift;
  my($cmd)   = shift;
  my($based) = shift;

  if ($type =~ /^custom_type/) {
    return $self->get_custom_value($cmd, $based);
  }
  elsif ($type =~ /^grouped_/) {
    return $self->get_grouped_value($type, $cmd, $based);
  }

  return undef;
}


sub get_grouped_value {
  my($self)  = shift;
  my($type)  = shift;
  my($cmd)   = shift;
  my($based) = shift;
  my($value) = undef;

  ## Make it all lowercase
  $type = lc($type);

  ## Remove the grouped_ part
  $type =~ s/^$grouped_key//;

  ## Add the s if it isn't there
  if ($type !~ /s$/) {
    $type .= 's';
  }

  my($names) = $self->{$type};
  if ($cmd eq 'files') {
    foreach my $name (keys %$names) {
      my($comps) = $$names{$name};
      foreach my $comp (keys %$comps) {
        if ($comp eq $based) {
          $value = $$comps{$comp};
          last;
        }
      }
    }
  }
  elsif ($cmd eq 'component_name') {
    ## If there is more than one name, then we will need
    ## to deal with that at a later time.
    foreach my $name (keys %$names) {
      $value = $name;
    }
  }

  return $value;
}


sub get_custom_value {
  my($self)  = shift;
  my($cmd)   = shift;
  my($based) = shift;
  my($value) = undef;

  if ($cmd eq 'input_files') {
    my($generic) = 'generic_files';  ## Matches with generic_outputext
    my(@array) = $self->get_component_list($based);
    $value = \@array;

    $self->{'custom_output_files'} = {};
    my(%vcomps) = ();
    foreach my $vc (keys %{$self->{'valid_components'}}, $generic) {
      my(@comps) = $self->get_component_list($vc);
      $vcomps{$vc} = \@comps;
    }
    foreach my $input (@array) {
      my(@outputs) = ();
      my($cinput)  = $input;
      $cinput =~ s/\.[^\.]+$//;
      foreach my $pf (@{$self->{'generated_exts'}->{$based}->{'pre_filename'}}) {
        foreach my $vc (keys %{$self->{'valid_components'}}, $generic) {
          push(@outputs,
               $self->check_custom_output($based, $pf,
                                          $cinput, $vc, $vcomps{$vc}));
        }
      }
      $self->{'custom_output_files'}->{$input} = \@outputs;
    }
  }
  elsif ($cmd eq 'output_files') {
    # Generate output files based on $based
    if (defined $self->{'custom_output_files'}) {
      $value = $self->{'custom_output_files'}->{$based};
    }
  }
  elsif ($cmd eq 'inputexts') {
    my(@array) = @{$self->{'valid_components'}->{$based}};
    foreach my $val (@array) {
      $val =~ s/\\\.//g;
    }
    $value = \@array;
  }
  elsif (defined $custom{$cmd} ||
         (defined $customDefined{$cmd} && $customDefined{$cmd} == 1)) {
    $value = $self->get_assignment($cmd,
                                   $self->{'generated_exts'}->{$based});
  }

  return $value;
}


sub check_features {
  my($self)     = shift;
  my($requires) = shift;
  my($avoids)   = shift;
  my($info)     = shift;
  my($status)   = 1;
  my($why)      = undef;

  if (defined $requires) {
    foreach my $require (split(/\s+/, $requires)) {
      my($fval) = $self->{'feature_parser'}->get_value($require);

      ## By default, if the feature is not listed, then it is enabled.
      if (defined $fval && !$fval) {
        $why = "requires $require";
        $status = 0;
        last;
      }
    }
  }

  ## If it passes the requires, then check the avoids
  if ($status) {
    if (defined $avoids) {
      foreach my $avoid (split(/\s+/, $avoids)) {
        my($fval) = $self->{'feature_parser'}->get_value($avoid);

        ## By default, if the feature is not listed, then it is enabled.
        if (!defined $fval || $fval) {
          $why = "avoids $avoid";
          $status = 0;
          last;
        }
      }
    }
  }

  if ($info && !$status) {
    print "Skipping " . $self->get_assignment('project_name') .
          " (" . $self->get_current_input() . "), it $why.\n";
  }

  return $status;
}


sub need_to_write_project {
  my($self) = shift;

  foreach my $key ('source_files', keys %{$self->{'generated_exts'}}) {
    my($names) = $self->{$key};
    foreach my $name (keys %$names) {
      foreach my $key (keys %{$names->{$name}}) {
        if (defined $names->{$name}->{$key}->[0]) {
          return 1;
        }
      }
    }
  }

  return 0;
}


sub write_output_file {
  my($self)     = shift;
  my($name)     = shift;
  my($status)   = 0;
  my($error)    = '';
  my($tover)    = $self->get_template_override();
  my($template) = (defined $tover ? $tover : $self->get_template()) .
                  ".$TemplateExtension";
  my($tfile)    = $self->search_include_path($template);

  if (defined $tfile) {
    ## Read in the template values for the
    ## specific target and project type
    ($status, $error) = $self->read_template_input();

    if ($status) {
      my($tp) = new TemplateParser($self);

      ## Set the project_file assignment for the template parser
      $self->process_assignment('project_file', $name);

      ($status, $error) = $tp->parse_file($tfile);

      if ($status) {
        if (defined $self->{'source_callback'}) {
          my($cb)     = $self->{'source_callback'};
          my($pjname) = $self->get_assignment('project_name');
          my(@list)   = $self->get_component_list('source_files');
          if (UNIVERSAL::isa($cb, 'ARRAY')) {
            my(@copy) = @$cb;
            my($s) = shift(@copy);
            &$s(@copy, $name, $pjname, @list);
          }
          elsif (UNIVERSAL::isa($cb, 'CODE')) {
            &$cb($name, $pjname, @list);
          }
          else {
            print "WARNING: Ignoring callback: $cb\n";
          }
        }

        if ($self->get_toplevel()) {
          my($fh)  = new FileHandle();
          my($dir) = dirname($name);

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

          if ($self->compare_output()) {
            ## First write the output to a temporary file
            my($tmp) = "MPC$>.$$";
            my($different) = 1;
            if (open($fh, ">$tmp")) {
              my($lines) = $tp->get_lines();
              foreach my $line (@$lines) {
                print $fh $line;
              }
              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 they are different, then rename the temporary file
              if ($different) {
                unlink($name);
                if (rename($tmp, $name)) {
                  $self->add_file_written($name);
                }
                else {
                  $error = "ERROR: Unable to open $name for output.";
                  $status = 0;
                }
              }
              else {
                ## We will pretend that we wrote the file
                unlink($tmp);
                $self->add_file_written($name);
              }
            }
          }
          else {
            if (open($fh, ">$name")) {
              my($lines) = $tp->get_lines();
              foreach my $line (@$lines) {
                print $fh $line;
              }
              close($fh);
              $self->add_file_written($name);
            }
            else {
              $error = "ERROR: Unable to open $name for output.";
              $status = 0;
            }
          }
        }
      }
    }
  }
  else {
    $error = "ERROR: Unable to locate the template file: $template.";
    $status = 0;
  }

  return $status, $error;
}


sub write_project {
  my($self)      = shift;
  my($status)    = 1;
  my($error)     = '';
  my($file_name) = $self->transform_file_name($self->project_file_name());
  my($progress)  = $self->get_progress_callback();

  if (defined $progress) {
    &$progress();
  }

  if ($self->check_features($self->get_assignment('requires'),
                            $self->get_assignment('avoids'),
                            1)) {
    if ($self->need_to_write_project()) {
      ($status, $error) = $self->write_output_file($file_name);
    }
  }
  else {
    if (defined $ENV{MPC_VERBOSE_FEATURES}) {
      print "WARNING: Skipping the " . $self->get_assignment('project_name') .
            " project due to the current features\n";
    }
  }

  return $status, $error;
}


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


sub set_component_extensions {
  my($self) = shift;
  my($vc)   = $self->{'valid_components'};
  my($ec)   = $self->{'exclude_components'};

  foreach my $key (keys %$vc) {
    my($ov) = $self->override_valid_component_extensions($key);
    if (defined $ov) {
      $$vc{$key} = $ov;
    }
  }

  foreach my $key (keys %$ec) {
    my($ov) = $self->override_exclude_component_extensions($key);
    if (defined $ov) {
      $$ec{$key} = $ov;
    }
  }
}


sub set_source_listing_callback {
  my($self) = shift;
  my($cb)   = shift;
  $self->{'source_callback'} = $cb;
}


sub reset_values {
  my($self) = shift;
  $self->{'project_info'} = [];
}


sub reset_generating_types {
  my($self)  = shift;
  my(%reset) = ('matching_assignments' => \%ma,
                'valid_components'     => \%vc,
                'generated_exts'       => \%genext,
                'exclude_components'   => \%ec,
               );

  foreach my $r (keys %reset) {
    $self->{$r} = {};
    foreach my $key (keys %{$reset{$r}}) {
      $self->{$r}->{$key} = $reset{$r}->{$key};
    }
  }

  $self->{'custom_types'} = {};

  ## Allow subclasses to override the default extensions
  $self->set_component_extensions();
}


sub get_template_input {
  my($self) = shift;

  ## This follow