projectcreator.pm

ACE源码

            $self->{'verbatim'}             = {};
            $self->{'verbatim_accessed'}    = {$self->{'pctype'} => {}};
            $self->{'special_supplied'}     = {};
            $self->{'flag_overrides'}       = {};
            $self->{'parents_read'}         = {};
            $self->{'inheritance_tree'}     = {};
            $self->reset_generating_types();
          }
        }
        $self->{$typecheck} = 0;
      }
      else {
        ## Project Beginning
        ($status, $errorString) = $self->begin_project($values[2]);

        ## Set up the default project name
        if ($status) {
          if (defined $name) {
            if ($name =~ /[\/\\]/) {
              $status = 0;
              $errorString = 'Projects can not have a slash ' .
                             'or a back slash in the name';
            }
            else {
              $name =~ s/^\(\s*//;
              $name =~ s/\s*\)$//;
              $name = $self->transform_file_name($name);

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

              $self->set_project_name($name);
            }
          }
        }

        if ($status) {
          ## Signify that we have a valid project
          $self->{$typecheck} = 1;
        }
      }
    }
    elsif ($values[0] eq 'assignment') {
      my($name)  = $values[1];
      my($value) = $values[2];
      if (defined $self->{'valid_names'}->{$name}) {
        $self->process_assignment($name, $value);
      }
      else {
        $errorString = "Invalid assignment name: $name";
        $status = 0;
      }
    }
    elsif ($values[0] eq 'assign_add') {
      my($name)  = $values[1];
      my($value) = $values[2];
      if (defined $self->{'valid_names'}->{$name}) {
        $self->process_assignment_add($name, $value);
      }
      else {
        $errorString = "Invalid addition name: $name";
        $status = 0;
      }
    }
    elsif ($values[0] eq 'assign_sub') {
      my($name)  = $values[1];
      my($value) = $values[2];
      if (defined $self->{'valid_names'}->{$name}) {
        $self->process_assignment_sub($name, $value);
      }
      else {
        $errorString = "Invalid subtraction name: $name";
        $status = 0;
      }
    }
    elsif ($values[0] eq 'component') {
      my($comp) = $values[1];
      my($name) = $values[2];
      if (defined $name) {
        $name =~ s/^\(\s*//;
        $name =~ s/\s*\)$//;
      }
      else {
        $name = $self->get_default_component_name();
      }

      my($vc) = $self->{'valid_components'};
      if (defined $$vc{$comp}) {
        if (!$self->parse_components($ih, $comp, $name)) {
          $errorString = "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 = "Unable to process $comp";
            $status = 0;
          }
        }
        elsif ($comp eq 'specific') {
          my($scope_parsed) = 0;
          my($defcomp) = $self->get_default_component_name();
          foreach my $type (split(/\s*,\s*/, $name)) {
            if ($type eq $self->{'pctype'} || $type eq $defcomp) {
              ($status, $errorString) = $self->parse_scope(
                                          $ih, $values[1], $type,
                                          $self->{'valid_names'},
                                          $self->get_assignment_hash());
              $scope_parsed = 1;
              last;
            }
          }
          if (!$scope_parsed) {
            ## We still need to parse the scope, but we will be
            ## throwing away whatever is processed.  However, it
            ## could still be invalid code that will cause an error.
            ($status, $errorString) = $self->parse_scope(
                                        $ih, $values[1], undef,
                                        $self->{'valid_names'});
          }
        }
        elsif ($comp eq 'define_custom') {
          ($status, $errorString) = $self->parse_define_custom($ih, $name);
        }
        else {
          $errorString = "Invalid component name: $comp";
          $status = 0;
        }
      }
    }
    elsif ($values[0] eq 'feature') {
      $self->{'feature_defined'} = 1;
      $self->process_feature($ih, $values[1], $values[2]);
      if ($self->{'feature_defined'}) {
        $errorString = "Did not find the end of the feature";
        $status = 0;
      }
    }
    else {
      $errorString = "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($over)   = {};
  my($status) = 0;

  ## Map the assignment name on a scoped assignment
  my($mapped) = $self->{'valid_names'}->{$name};
  if (UNIVERSAL::isa($mapped, 'ARRAY')) {
    $name = $$mapped[1];
  }

  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);
    }
    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 handle_unknown_assignment {
  my($self)   = shift;
  my($type)   = shift;
  my(@values) = @_;

  ## Unknown assignments within a 'specific' section are handled as
  ## template value modifications.  These are handled exactly as the
  ## -value_template option in Options.pm.

  ## If $type is not defined, then we are skipping this section
  if (defined $type) {
    ## Save the addtemp state if we haven't done so before
    if (!defined $self->{'addtemp_state'}) {
      my(%state) = $self->save_state('addtemp');
      $self->{'addtemp_state'} = \%state;
    }

    ## Now modify the addtemp values
    $self->information("'$values[1]' was used as a template modifier.");
    if ($values[0] eq 'assign_add') {
      $values[0] = 1;
    }
    elsif ($values[0] eq 'assign_sub') {
      $values[0] = -1;
    }
    else {
      $values[0] = 0;
    }
    $self->get_addtemp()->{$values[1]} = [$values[0], $values[2]];
  }

  return 1, undef;
}


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} = [];
  }

  if (defined $specialComponents{$tag}) {
    $self->{'special_supplied'}->{$tag} = 1;
  }

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

    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);
        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->preprocess_line($fh, $_);

    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($parents) = shift;
  my($status)  = 1;
  my($error)   = undef;

  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.
    ($status, $error) = $self->begin_project($parents);
    if ($status) {
      $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->preprocess_line($fh, $_);

      ## 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;