workspacecreator.pm

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

package WorkspaceCreator;

# ************************************************************
# Description   : Base class for all workspace creators
# Author        : Chad Elliott
# Create Date   : 5/13/2002
# ************************************************************

# ************************************************************
# Pragmas
# ************************************************************

use strict;
use FileHandle;
use File::Path;
use File::Compare;
use File::Basename;

use Creator;
use Options;

use vars qw(@ISA);
@ISA = qw(Creator Options);

# ************************************************************
# Data Section
# ************************************************************

my($wsext)  = 'mwc';
my($wsbase) = 'mwb';

## Valid names for assignments within a workspace
my(%validNames) = ('cmdline'  => 1,
                   'implicit' => 1,
                  );

## Singleton hash maps of project information
my(%allprinfo)   = ();
my(%allprojects) = ();

## Global previous workspace names
my(%previous_workspace_name) = ();

# ************************************************************
# Subroutine Section
# ************************************************************

sub new {
  my($class)     = shift;
  my($global)    = shift;
  my($inc)       = shift;
  my($template)  = shift;
  my($ti)        = shift;
  my($dynamic)   = shift;
  my($static)    = shift;
  my($relative)  = shift;
  my($addtemp)   = shift;
  my($addproj)   = shift;
  my($progress)  = shift;
  my($toplevel)  = shift;
  my($baseprojs) = shift;
  my($gfeature)  = shift;
  my($feature)   = shift;
  my($hierarchy) = shift;
  my($exclude)   = shift;
  my($makeco)    = shift;
  my($nmod)      = shift;
  my($applypj)   = shift;
  my($self)      = Creator::new($class, $global, $inc,
                                $template, $ti, $dynamic, $static,
                                $relative, $addtemp, $addproj,
                                $progress, $toplevel, $baseprojs,
                                $feature, $hierarchy, $nmod, $applypj,
                                'workspace');
  my($typecheck) = $self->{'type_check'};

  $self->{'workspace_name'}      = undef;
  $self->{$typecheck}            = 0;
  $self->{'projects'}            = [];
  $self->{'project_info'}        = {};
  $self->{'reading_parent'}      = [];
  $self->{'project_files'}       = [];
  $self->{'scoped_assign'}       = {};
  $self->{'cacheok'}             = 1;
  $self->{'exclude'}             = {};
  $self->{'wctype'}              = $self->extractType("$self");
  $self->{'modified_count'}      = 0;
  $self->{'global_feature_file'} = $gfeature;
  $self->{'coexistence'}         = $makeco;
  $self->{'project_file_list'}   = {};

  if (defined $$exclude[0]) {
    my($type) = $self->{'wctype'};
    if (!defined $self->{'exclude'}->{$type}) {
      $self->{'exclude'}->{$type} = [];
    }
    push(@{$self->{'exclude'}->{$type}}, @$exclude);
  }

  ## Add a hash reference for our workspace type
  if (!defined $previous_workspace_name{$self->{'wctype'}}) {
    $previous_workspace_name{$self->{'wctype'}} = {};
  }

  return $self;
}


sub modify_assignment_value {
  my($self)  = shift;
  my($value) = shift;

  ## Workspace assignments do not need modification.
  return $value;
}


sub parse_line {
  my($self)   = shift;
  my($ih)     = shift;
  my($line)   = shift;
  my($status,
     $errorString,
     @values) = $self->parse_known($line);

  ## Was the line recognized?
  if ($status && defined $values[0]) {
    if ($values[0] eq $self->{'grammar_type'}) {
      my($name)      = $values[1];
      my($typecheck) = $self->{'type_check'};
      if (defined $name && $name eq '}') {
        my($rp) = $self->{'reading_parent'};
        if (!defined $$rp[0]) {
          ## Fill in all the default values
          $self->generate_defaults();

          ## End of workspace; Have subclass write out the file
          ## Generate the project files
          my($gstat, $creator) = $self->generate_project_files();
          if ($gstat) {
            ($status, $errorString) = $self->write_workspace($creator, 1);
            $self->{'assign'} = {};
          }
          else {
            $errorString = 'ERROR: Unable to ' .
                           'generate all of the project files';
            $status = 0;
          }

          $self->{'modified_count'} = 0;
          $self->{'workspace_name'} = undef;
          $self->{'projects'}       = [];
          $self->{'project_info'}   = {};
          $self->{'project_files'}  = [];
        }
        $self->{$typecheck} = 0;
      }
      else {
        ## Project Beginning
        ## Deal with the inheritance hiearchy first
        my($parents) = $values[2];
        if (defined $parents) {
          foreach my $parent (@$parents) {
            ## Read in the parent onto ourself
            my($file) = $self->search_include_path("$parent.$wsbase");
            if (!defined $file) {
              $file = $self->search_include_path("$parent.$wsext");
            }

            if (defined $file) {
              my($rp) = $self->{'reading_parent'};
              push(@$rp, 1);
              $status = $self->parse_file($file);
              pop(@$rp);

              if (!$status) {
                $errorString = "ERROR: Invalid parent: $parent";
              }
            }
            else {
              $status = 0;
              $errorString = "ERROR: Unable to locate parent: $parent";
            }
          }
        }

        ## Set up some initial values
        if (defined $name) {
          if ($name =~ /[\/\\]/) {
            $status = 0;
            $errorString = 'ERROR: Workspaces can not have a slash ' .
                           'or a back slash in the name';
          }
          else {
            $name =~ s/^\(\s*//;
            $name =~ s/\s*\)$//;

            ## Replace any *'s with the default name
            my($def) = $self->get_default_workspace_name();
            $name = $self->fill_type_name($name, $def);

            $self->{'workspace_name'} = $name;
          }
        }
        $self->{$typecheck} = 1;
      }
    }
    elsif ($values[0] eq 'assignment') {
      if (defined $validNames{$values[1]}) {
        $self->process_assignment($values[1], $values[2]);
      }
      else {
        $errorString = "ERROR: Invalid assignment name: $values[1]";
        $status = 0;
      }
    }
    elsif ($values[0] eq 'assign_add') {
      if (defined $validNames{$values[1]}) {
        $self->process_assignment_add($values[1], $values[2]);
      }
      else {
        $errorString = "ERROR: Invalid addition name: $values[1]";
        $status = 0;
      }
    }
    elsif ($values[0] eq 'assign_sub') {
      if (defined $validNames{$values[1]}) {
        $self->process_assignment_sub($values[1], $values[2]);
      }
      else {
        $errorString = "ERROR: Invalid subtraction name: $values[1]";
        $status = 0;
      }
    }
    elsif ($values[0] eq 'component') {
      if ($values[1] eq 'exclude') {
        ($status, $errorString) = $self->parse_exclude($ih,
                                                       $values[2]);
      }
      else {
        ($status, $errorString) = $self->parse_scope($ih,
                                                     $values[1],
                                                     $values[2],
                                                     \%validNames);
      }
    }
    else {
      $errorString = "ERROR: Unrecognized line: $line";
      $status = 0;
    }
  }
  elsif ($status == -1) {
    push(@{$self->{'project_files'}}, $line);
    $status = 1;
  }

  return $status, $errorString;
}


sub parse_exclude {
  my($self)        = shift;
  my($fh)          = shift;
  my($typestr)     = shift;
  my($status)      = 0;
  my($errorString) = 'ERROR: Unable to process exclude';

  if ($typestr eq $self->get_default_component_name()) {
    $typestr = $self->{'wctype'};
  }

  my(@types)   = split(/\s*,\s*/, $typestr);
  my(@exclude) = ();

  while(<$fh>) {
    my($line) = $self->strip_line($_);

    if ($line eq '') {
    }
    elsif ($line =~ /^}/) {
      $status = 1;
      $errorString = '';
      last;
    }
    else {
      push(@exclude, $line);
    }
  }

  foreach my $type (@types) {
    if (!defined $self->{'exclude'}->{$type}) {
      $self->{'exclude'}->{$type} = [];
    }
    push(@{$self->{'exclude'}->{$type}}, @exclude);
  }

  return $status, $errorString;
}


sub excluded {
  my($self) = shift;
  my($file) = shift;

  foreach my $excluded (@{$self->{'exclude'}->{$self->{'wctype'}}}) {
    if ($excluded eq $file || $file =~ /$excluded\//) {
      return 1;
    }
  }

  return 0;
}


sub handle_scoped_unknown {
  my($self)  = shift;
  my($fh)    = shift;
  my($type)  = shift;
  my($flags) = shift;
  my($line)  = shift;

  if (-d $line) {
    my(@files) = ();
    $self->search_for_files([ $line ], \@files, $$flags{'implicit'});
    foreach my $file (@files) {
      $self->{'scoped_assign'}->{$file} = $flags;
      push(@{$self->{'project_files'}}, $file);
    }
  }
  else {
    $self->{'scoped_assign'}->{$line} = $flags;
    push(@{$self->{'project_files'}}, $line);
  }

  return 1, '';
}


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->get_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)     = '';
  my($duplicates) = 0;

  if ($self->get_toplevel()) {
    if ($addfile) {
      ## To be consistent across multiple project types, we disallow
      ## duplicate project names for all types, not just VC6.