projectcreator.pm

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

      }

      my($vc) = $self->{'valid_components'};
      if (defined $$vc{$comp}) {
        if (!$self->parse_components($ih, $comp, $name)) {
          $errorString = "ERROR: Unable to process $comp";
          $status = 0;
        }
      }
      else {
        if ($comp eq 'verbatim') {
          my($type, $loc) = split(/\s*,\s*/, $name);
          if (!$self->parse_verbatim($ih, $comp, $type, $loc)) {
            $errorString = "ERROR: Unable to process $comp";
            $status = 0;
          }
        }
        elsif ($comp eq 'specific') {
          my(@types) = split(/\s*,\s*/, $name);
          ($status, $errorString) = $self->parse_scope(
                       $ih, $values[1], \@types, \%validNames);
        }
        elsif ($comp eq 'define_custom') {
          ($status, $errorString) = $self->parse_define_custom($ih, $name);
        }
        else {
          $errorString = "ERROR: Invalid component name: $comp";
          $status = 0;
        }
      }
    }
    elsif ($values[0] eq 'feature') {
      $self->{'feature_defined'} = 1;
      $self->process_feature($ih, $values[1]);
      if ($self->{'feature_defined'}) {
        $errorString = "ERROR: Did not find the end of the feature";
        $status = 0;
      }
    }
    else {
      $errorString = "ERROR: Unrecognized line: $line";
      $status = 0;
    }
  }
  elsif ($status == -1) {
    $status = 0;
  }

  return $status, $errorString;
}


sub parse_scoped_assignment {
  my($self)   = shift;
  my($tag)    = shift;
  my($type)   = shift;
  my($name)   = shift;
  my($value)  = shift;
  my($flags)  = shift;
  my($order)  = shift;
  my($over)   = {};
  my($status) = 0;

  if (defined $self->{'matching_assignments'}->{$tag}) {
    foreach my $possible (@{$self->{'matching_assignments'}->{$tag}}) {
      if ($possible eq $name) {
        $status = 1;
        last;
      }
    }
  }

  if ($status) {
    if (defined $self->{'flag_overrides'}->{$tag}) {
      $over = $self->{'flag_overrides'}->{$tag};
    }
    else {
      $self->{'flag_overrides'}->{$tag} = $over;
    }

    if ($type eq 'assignment') {
      $self->process_assignment($name, $value, $flags);
    }
    elsif ($type eq 'assign_add') {
      ## If there is no value in $$flags, then we need to get
      ## the outer scope value and put it in there.
      if (!defined $self->get_assignment($name, $flags)) {
        my($outer) = $self->get_assignment($name);
        $self->process_assignment($name, $outer, $flags);
      }
      $self->process_assignment_add($name, $value, $flags, $order);
    }
    elsif ($type eq 'assign_sub') {
      ## If there is no value in $$flags, then we need to get
      ## the outer scope value and put it in there.
      if (!defined $self->get_assignment($name, $flags)) {
        my($outer) = $self->get_assignment($name);
        $self->process_assignment($name, $outer, $flags);
      }
      $self->process_assignment_sub($name, $value, $flags);
    }
  }
  return $status;
}


sub parse_components {
  my($self)    = shift;
  my($fh)      = shift;
  my($tag)     = shift;
  my($name)    = shift;
  my($current) = $self->get_default_element_name();
  my($status)  = 1;
  my($names)   = {};
  my($comps)   = {};
  my($set)     = 0;
  my(%flags)   = ();
  my($custom)  = defined $self->{'generated_exts'}->{$tag};
  my($grtag)   = $grouped_key . $tag;

  if ($custom) {
    ## For the custom scoped assignments, we want to put a copy of
    ## the original custom defined values in our flags associative array.
    foreach my $key (keys %custom) {
      if (defined $self->{'generated_exts'}->{$tag}->{$key}) {
        $flags{$key} = $self->{'generated_exts'}->{$tag}->{$key};
      }
    }
  }

  if (defined $self->{$tag}) {
    $names = $self->{$tag};
  }
  else {
    $self->{$tag} = $names;
  }
  if (defined $$names{$name}) {
    $comps = $$names{$name};
  }
  else {
    $$names{$name} = $comps;
  }
  if (!defined $$comps{$current}) {
    $$comps{$current} = [];
  }

  foreach my $special (@specialComponents) {
    if ($special eq $tag) {
      $self->{'special_supplied'}->{$tag} = 1;
      last;
    }
  }

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

    if ($line eq '') {
    }
    elsif ($line =~ /^(\w+)\s*{$/) {
      if (!defined $current || !$set) {
        if (defined $current && !defined $$comps{$current}->[0]) {
          ## The default components name was never used
          ## so we remove it from the components
          delete $$comps{$current};
        }
        $current = $1;
        $set = 1;
        if (!defined $$comps{$current}) {
          $$comps{$current} = [];
          $self->process_assignment_add($grtag, $current);
        }
      }
      else {
        $status = 0;
        last;
      }
    }
    elsif ($line =~ /^}/) {
      if (defined $current && $set) {
        $current = undef;
      }
      else {
        ## This is not an error,
        ## this is the end of the components
        last;
      }
    }
    elsif (defined $current) {
      my(@values) = ();
      ## If this returns true, then we've found an assignment
      if ($self->parse_assignment($line, \@values)) {
        $status = $self->parse_scoped_assignment($tag, @values,
                                                 \%flags, $custom);
        if (!$status) {
          last;
        }
      }
      else {
        my($over) = $self->{'flag_overrides'}->{$tag};
        if (defined $over) {
          $$over{$line} = \%flags;
        }
        push(@{$$comps{$current}}, $line);
      }
    }
    else {
      $status = 0;
      last;
    }
  }

  return $status;
}


sub parse_verbatim {
  my($self)    = shift;
  my($fh)      = shift;
  my($tag)     = shift;
  my($type)    = shift;
  my($loc)     = shift;

  ## All types are lowercase
  $type = lc($type);

  if (!defined $self->{'verbatim'}->{$type}) {
    $self->{'verbatim'}->{$type} = {};
  }
  $self->{'verbatim'}->{$type}->{$loc} = [];
  my($array) = $self->{'verbatim'}->{$type}->{$loc};

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

    if ($line =~ /^}/) {
      ## This is not an error,
      ## this is the end of the verbatim
      last;
    }
    else {
      push(@$array, $line);
    }
  }

  return 1;
}


sub process_feature {
  my($self)   = shift;
  my($fh)     = shift;
  my($names)  = shift;
  my($status) = 1;
  my($error)  = '';

  my($requires) = '';
  my($avoids)   = '';
  foreach my $name (@$names) {
    if ($name =~ /^!\s*(.*)$/) {
      if ($avoids ne '') {
        $avoids .= ' ';
      }
      $avoids .= $1;
    }
    else {
      if ($requires ne '') {
        $requires .= ' ';
      }
      $requires .= $name;
    }
  }

  if ($self->check_features($requires, $avoids)) {
    ## The required features are enabled, so we say that
    ## a project has been defined and we allow the parser to
    ## find the data held within the feature.
    $self->{'feature_defined'} = 0;
    $self->{$self->{'type_check'}} = 1;
  }
  else {
    ## Otherwise, we read in all the lines until we find the
    ## closing brace for the feature and it appears to the parser
    ## that nothing was defined.
    my($curly) = 1;
    while(<$fh>) {
      my($line) = $self->strip_line($_);

      ## This is a very simplistic way of finding the end of
      ## the feature definition.  It will work as long as no spurious
      ## open curly braces are counted.
      if ($line =~ /{$/) {
        ++$curly;
      }
      elsif ($line =~ /^}$/) {
        --$curly;
      }
      if ($curly == 0) {
        $self->{'feature_defined'} = 0;
        last;
      }
    }
  }

  return $status, $error;
}


sub process_type_specific_assignments {
  my($self) = shift;
  my($tsa)  = $self->{'type_specific_assign'}->{$self->{'pctype'}};

  if (defined $tsa) {
    foreach my $key (keys %$tsa) {
      $self->process_assignment_add($key, $$tsa{$key});
    }
  }
}


sub process_array_assignment {
  my($self)  = shift;
  my($aref)  = shift;
  my($type)  = shift;
  my($array) = shift;

  if (!defined $$aref || $type eq 'assignment') {
    if ($type ne 'assign_sub') {
      $$aref = $array;
    }
  }
  else {
    if ($type eq 'assign_add') {
      push(@{$$aref}, @$array);
    }
    elsif ($type eq 'assign_sub') {
      my($count) = scalar(@{$$aref});
      for(my $i = 0; $i < $count; ++$i) {
        foreach my $val (@$array) {
          if ($$aref->[$i] eq $val) {
            splice(@{$$aref}, $i, 1);
            --$i;
            --$count;
            last;
          }
        }
      }
    }
  }
}


sub parse_define_custom {
  my($self)        = shift;
  my($fh)          = shift;
  my($tag)         = shift;
  my($status)      = 0;
  my($errorString) = "ERROR: Unable to process $tag";
  my(%flags)       = ();

  ## Make the tag something _files
  $tag = lc($tag) . '_files';

  if (defined $self->{'valid_components'}->{$tag}) {
    $errorString = "ERROR: $tag has already been defined";
  }
  else {
    ## Update the custom_types assignment
    $self->process_assignment_add('custom_types', $tag);

    if (!defined $self->{'matching_assignments'}->{$tag}) {
      my(@keys) = keys %custom;
      $self->{'matching_assignments'}->{$tag} = \@keys;
    }

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

      if ($line eq '') {
      }
      elsif ($line =~ /^}/) {
        $status = 1;
        $errorString = '';
        if (!defined $self->{'generated_exts'}->{$tag}->{'pre_filename'}) {
          $self->{'generated_exts'}->{$tag}->{'pre_filename'} = [ '' ];
        }
        if (!defined $self->{'generated_exts'}->{$tag}->{'pre_extension'}) {
          $self->{'generated_exts'}->{$tag}->{'pre_extension'} = [ '' ];
        }
        if (!defined $self->{'generated_exts'}->{$tag}->{'automatic'}) {
          $self->{'generated_exts'}->{$tag}->{'automatic'} = 1;
        }
        last;
      }
      else {
        my(@values) = ();
        ## If this returns true, then we've found an assignment
        if ($self->parse_assignment($line, \@values)) {
          my($type)  = $values[0];
          my($name)  = $values[1];
          my($value) = $values[2];
          if (defined $customDefined{$name}) {
            if ($customDefined{$name} == -1) {
              $value = $self->escape_regex_special($value);
              my(@array) = split(/\s*,\s*/, $value);
              $self->process_array_assignment(
                        \$self->{'valid_components'}->{$tag}, $type, \@array);
            }
            else {
              if (!defined $self->{'generated_exts'}->{$tag}) {
                $self->{'generated_exts'}->{$tag} = {};
              }
              ## First try to convert the value into a relative path
              $value = $self->relative($value);

              ## If that didn't work, try to convert it to the
              ## right environment variable form.
              if ($value =~ /\$\(.*\)/) {
                my($envstart, $envend) = $self->get_env_accessor();
                if (defined $envstart) {
                  if (!defined $envend) {
                    $envend = '';
                  }
                  $value =~ s/\$\(([^\)]+)\)/$envstart$1$envend/g;
                }
              }
              if ($customDefined{$name} == 1) {
                if ($type eq 'assignment') {
                  $self->process_assignment(
                                     $name, $value,
                                     $self->{'generated_exts'}->{$tag});
                }
                elsif ($type eq 'assign_add') {
                  $self->process_assignment_add(
                                     $name, $value,
                                     $self->{'generated_exts'}->{$tag});
                }
                elsif ($type eq 'assign_sub') {
                  $self->process_assignment_sub(
                                     $name, $value,
                                     $self->{'generated_exts'}->{$tag});
                }
              }
              else {
                ## Transform the name from something outputext to
                ## something files.  We expect this to match the
                ## names of valid_assignments.
                $name =~ s/outputext/files/g;

                ## Get it ready for regular expressions