WebSVN – gelsvn – Diff – /trunk/MPC/modules/TemplateParser.pm


package TemplateParser;
 
# ************************************************************
# Description   : Parses the template and fills in missing values
# Author        : Chad Elliott
# Create Date   : 5/17/2002
# ************************************************************
 
# ************************************************************
# Pragmas
# ************************************************************
 
use strict;
 
use Parser;
use WinVersionTranslator;
 
use vars qw(@ISA);
@ISA = qw(Parser);
 
# ************************************************************
# Data Section
# ************************************************************
 
# Valid keywords for use in template files.  Each has a handle_
# method available, but some have other methods too.
# Bit  Meaning
# 0 means there is a get_ method available (used by if)
# 1 means there is a perform_ method available (used by foreach)
# 2 means there is a doif_ method available (used by if)
my(%keywords) = ('if'              => 0,
                 'else'            => 0,
                 'endif'           => 0,
                 'noextension'     => 2,
                 'dirname'         => 5,
                 'basename'        => 0,
                 'basenoextension' => 0,
                 'foreach'         => 0,
                 'forfirst'        => 0,
                 'fornotfirst'     => 0,
                 'fornotlast'      => 0,
                 'forlast'         => 0,
                 'endfor'          => 0,
                 'eval'            => 0,
                 'comment'         => 0,
                 'marker'          => 0,
                 'uc'              => 0,
                 'lc'              => 0,
                 'ucw'             => 0,
                 'normalize'       => 2,
                 'flag_overrides'  => 1,
                 'reverse'         => 2,
                 'sort'            => 2,
                 'uniq'            => 3,
                 'multiple'        => 5,
                 'starts_with'     => 5,
                 'ends_with'       => 5,
                 'contains'        => 5,
                 'compares'        => 5,
                 'duplicate_index' => 5,
                );
 
my(%target_type_vars) = ('type_is_static'   => 1,
                         'need_staticflags' => 1,
                         'type_is_dynamic'  => 1,
                         'type_is_binary'   => 1,
                        );
 
# ************************************************************
# Subroutine Section
# ************************************************************
 
sub new {
  my($class) = shift;
  my($prjc)  = shift;
  my($self)  = $class->SUPER::new();
 
  $self->{'prjc'}                 = $prjc;
  $self->{'ti'}                   = $prjc->get_template_input();
  $self->{'cslashes'}             = $prjc->convert_slashes();
  $self->{'crlf'}                 = $prjc->crlf();
  $self->{'cmds'}                 = $prjc->get_command_subs();
  $self->{'vnames'}               = $prjc->get_valid_names();
  $self->{'values'}               = {};
  $self->{'defaults'}             = {};
  $self->{'lines'}                = [];
  $self->{'built'}                = '';
  $self->{'sstack'}               = [];
  $self->{'lstack'}               = [];
  $self->{'if_skip'}              = 0;
  $self->{'eval'}                 = 0;
  $self->{'eval_str'}             = '';
  $self->{'dupfiles'}             = {};
  $self->{'override_target_type'} = undef;
 
  $self->{'foreach'}  = {};
  $self->{'foreach'}->{'count'}      = -1;
  $self->{'foreach'}->{'nested'}     = 0;
  $self->{'foreach'}->{'name'}       = [];
  $self->{'foreach'}->{'vars'}       = [];
  $self->{'foreach'}->{'text'}       = [];
  $self->{'foreach'}->{'scope'}      = [];
  $self->{'foreach'}->{'scope_name'} = [];
  $self->{'foreach'}->{'temp_scope'} = [];
  $self->{'foreach'}->{'processing'} = 0;
 
  return $self;
}
 
 
sub basename {
  my($self) = shift;
  my($file) = shift;
 
  if ($self->{'cslashes'}) {
    $file =~ s/.*[\/\\]//;
  }
  else {
    $file =~ s/.*\///;
  }
  return $file;
}
 
 
sub tp_dirname {
  my($self)  = shift;
  my($file)  = shift;
  my($index) = rindex($file, ($self->{'cslashes'} ? '\\' : '/'));
 
  if ($index >= 0) {
    return $self->{'prjc'}->validated_directory(substr($file, 0, $index));
  }
  else {
    return '.';
  }
}
 
 
sub strip_line {
  #my($self) = shift;
  #my($line) = shift;
 
  ## Override strip_line() from Parser.
  ## We need to preserve leading space and
  ## there is no comment string in templates.
  ++$_[0]->{'line_number'};
  $_[1] =~ s/\s+$//;
 
  return $_[1];
}
 
 
## Append the current value to the line that is being
## built.  This line may be a foreach line or a general
## line without a foreach.
sub append_current {
#  my($self)  = shift;
#  my($value) = shift;
 
  if ($_[0]->{'foreach'}->{'count'} >= 0) {
    $_[0]->{'foreach'}->{'text'}->[$_[0]->{'foreach'}->{'count'}] .= $_[1];
  }
  elsif ($_[0]->{'eval'}) {
    $_[0]->{'eval_str'} .= $_[1];
  }
  else {
    $_[0]->{'built'} .= $_[1];
  }
}
 
 
sub split_parameters {
  my($self)   = shift;
  my($str)    = shift;
  my(@params) = ();
 
  while($str =~ /(\w+\([^\)]+\))\s*,\s*(.*)/) {
    push(@params, $1);
    $str = $2;
  }
  while($str =~ /([^,]+)\s*,\s*(.*)/) {
    push(@params, $1);
    $str = $2;
  }
 
  ## Return the parameters (which includes whatever is left in the
  ## string).  Just return it instead of pushing it onto @params.
  return @params, $str;
}
 
 
sub set_current_values {
  my($self) = shift;
  my($name) = shift;
  my($set)  = 0;
 
  ## If any value within a foreach matches the name
  ## of a hash table within the template input we will
  ## set the values of that hash table in the current scope
  if (defined $self->{'ti'}) {
    my($counter) = $self->{'foreach'}->{'count'};
    if ($counter >= 0) {
      ## Variable names are case-insensitive in MPC, however this can
      ## cause problems when dealing with template variable values that
      ## happen to match HASH names only by case-insensitivity.  So, we
      ## now make HASH names match with case-sensitivity.
      my($value) = $self->{'ti'}->get_value($name);
      if (defined $value && UNIVERSAL::isa($value, 'HASH') &&
          $self->{'ti'}->get_realname($name) eq $name) {
        $self->{'foreach'}->{'scope_name'}->[$counter] = $name;
        my(%copy) = ();
        foreach my $key (keys %$value) {
          $copy{$key} = $self->{'prjc'}->adjust_value(
                    [$name . '::' . $key, $name], $$value{$key});
        }
        $self->{'foreach'}->{'temp_scope'}->[$counter] = \%copy;
        $set = 1;
      }
    }
  }
  return $set;
}
 
 
sub get_value {
  my($self)    = shift;
  my($name)    = shift;
  my($value)   = undef;
  my($counter) = $self->{'foreach'}->{'count'};
  my($fromprj) = 0;
  my($scope)   = undef;
  my($sname)   = undef;
  my($adjust)  = 1;
 
  ## $name should always be all lower-case
  $name = lc($name);
 
  ## First, check the temporary scope (set inside a foreach)
  if ($counter >= 0) {
    ## Find the outer most scope for our variable name
    for(my $index = $counter; $index >= 0; --$index) {
      if (defined $self->{'foreach'}->{'scope_name'}->[$index]) {
        $scope = $self->{'foreach'}->{'scope_name'}->[$index];
        $sname = $scope . '::' . $name;
        last;
      }
    }
    while(!defined $value && $counter >= 0) {
      $value = $self->{'foreach'}->{'temp_scope'}->[$counter]->{$name};
      --$counter;
    }
    $counter = $self->{'foreach'}->{'count'};
 
    if ($self->{'override_target_type'} &&
        defined $value && defined $target_type_vars{$name}) {
      $value = $self->{'values'}->{$name};
    }
  }
 
  if (!defined $value) {
    if ($name =~ /^flag_overrides\((.*)\)$/) {
      $value = $self->get_flag_overrides($1);
    }
 
    if (!defined $value) {
      ## Next, check for a template value
      if (defined $self->{'ti'}) {
        $value = $self->{'ti'}->get_value($name);
      }
 
      if (!defined $value) {
        ## Calling adjust_value here allows us to pick up template
        ## overrides before getting values elsewhere.
        my($uvalue) = $self->{'prjc'}->adjust_value([$sname, $name], []);
        if (defined $$uvalue[0]) {
          $value = $uvalue;
          $adjust = 0;
        }
 
        if (!defined $value) {
          ## Next, check the inner to outer foreach
          ## scopes for overriding values
          while(!defined $value && $counter >= 0) {
            $value = $self->{'foreach'}->{'scope'}->[$counter]->{$name};
            --$counter;
          }
 
          ## Then get the value from the project creator
          if (!defined $value) {
            $fromprj = 1;
            $value = $self->{'prjc'}->get_assignment($name);
 
            ## Then get it from our known values
            if (!defined $value) {
              $value = $self->{'values'}->{$name};
              if (!defined $value) {
                ## Call back onto the project creator to allow
                ## it to fill in the value before defaulting to undef.
                $value = $self->{'prjc'}->fill_value($name);
                if (!defined $value && $name =~ /^(.*)\->(\w+)/) {
                  my($pre)  = $1;
                  my($post) = $2;
                  my($base) = $self->get_value($pre);
 
                  if (defined $base) {
                    $value = $self->{'prjc'}->get_special_value(
                               $pre, $post, $base,
                               ($self->{'prjc'}->requires_parameters($post) ?
                                   $self->prepare_parameters($pre) : undef));
                  }
                }
              }
            }
          }
        }
      }
    }
  }
 
  ## Adjust the value even if we haven't obtained one from an outside
  ## source.
  if ($adjust && defined $value) {
    $value = $self->{'prjc'}->adjust_value([$sname, $name], $value);
  }
 
  ## If the value did not come from the project creator, we
  ## check the variable name.  If it is a project keyword we then
  ## check to see if we need to add the project value to the template
  ## variable value.  If so, we make a copy of the value array and
  ## push the project value onto that (to avoid modifying the original).
  if (!$fromprj && defined $self->{'vnames'}->{$name} &&
      $self->{'prjc'}->add_to_template_input_value($name)) {
    my($pjval) = $self->{'prjc'}->get_assignment($name);
    if (defined $pjval) {
      my(@copy) = @$value;
      if (!UNIVERSAL::isa($pjval, 'ARRAY')) {
        $pjval = $self->create_array($pjval);
      }
      push(@copy, @$pjval);
      $value = \@copy;
    }
  }
 
  return $self->{'prjc'}->relative($value, undef, $scope);
}
 
 
sub get_value_with_default {
  my($self)  = shift;
  my($name)  = shift;
  my($value) = $self->get_value($name);
 
  if (!defined $value) {
    $value = $self->{'defaults'}->{$name};
    if (defined $value) {
      my($counter) = $self->{'foreach'}->{'count'};
      my($sname)   = undef;
 
      if ($counter >= 0) {
        ## Find the outer most scope for our variable name
        for(my $index = $counter; $index >= 0; --$index) {
          if (defined $self->{'foreach'}->{'scope_name'}->[$index]) {
            $sname = $self->{'foreach'}->{'scope_name'}->[$index] .
                     '::' . $name;
            last;
          }
        }
      }
      $value = $self->{'prjc'}->relative(
                    $self->{'prjc'}->adjust_value([$sname, $name], $value));
 
      ## If the user set the variable to empty, we will go ahead and use
      ## the default value (since we know we have one at this point).
      if (!defined $value) {
        $value = $self->{'defaults'}->{$name};
      }
    }
    else {
      #$self->warning("$name defaulting to empty string.");
      $value = '';
    }
  }
 
  if (UNIVERSAL::isa($value, 'ARRAY')) {
    $value = "@$value";
  }
 
  return $value;
}
 
 
sub process_foreach {
  my($self)   = shift;
  my($index)  = $self->{'foreach'}->{'count'};
  my($text)   = $self->{'foreach'}->{'text'}->[$index];
  my($status) = 1;
  my($error)  = undef;
  my(@values) = ();
  my($name)   = $self->{'foreach'}->{'name'}->[$index];
  my(@cmds)   = ();
  my($val)    = $self->{'foreach'}->{'vars'}->[$index];
 
  if ($val =~ /^((\w+),\s*)?flag_overrides\((.*)\)$/) {
    my($over) = $self->get_flag_overrides($3);
    $name = $2;
    if (defined $over) {
      $val = $self->create_array($over);
      @values = @$val;
    }
    if (!defined $name) {
      $name = '__unnamed__';
    }
  }
  else {
    ## Pull out modifying commands first
    while ($val =~ /(\w+)\((.+)\)/) {
      my($cmd) = $1;
      $val     = $2;
      if (($keywords{$cmd} & 0x02) != 0) {
        push(@cmds, 'perform_' . $cmd);
      }
      else {
        $self->warning("Unable to use $cmd in foreach (no perform_ method).");
      }
    }
 
    ## Get the values for all of the variable names
    ## contained within the foreach
    my($names) = $self->create_array($val);
    foreach my $n (@$names) {
      my($vals) = $self->get_value($n);
      if (defined $vals && $vals ne '') {
        if (!UNIVERSAL::isa($vals, 'ARRAY')) {
          $vals = $self->create_array($vals);
        }
        push(@values, @$vals);
      }
      if (!defined $name) {
        $name = $n;
        $name =~ s/s$//;
      }
    }
  }
 
  ## Perform the commands on the built up @values
  foreach my $cmd (reverse @cmds) {
    @values = $self->$cmd(\@values);
  }
 
  ## Reset the text (it will be regenerated by calling parse_line
  $self->{'foreach'}->{'text'}->[$index] = '';
 
  if (defined $values[0]) {
    my($scope) = $self->{'foreach'}->{'scope'}->[$index];
 
    $$scope{'forlast'}     = '';
    $$scope{'fornotlast'}  = 1;
    $$scope{'forfirst'}    = 1;
    $$scope{'fornotfirst'} = '';
 
    ## If the foreach values are mixed (HASH and SCALAR), then
    ## remove the SCALAR values.
    my(%mixed) = ();
    my($mixed) = 0;
    for(my $i = 0; $i <= $#values; ++$i) {
      $mixed{$values[$i]} = $self->set_current_values($values[$i]);
      $mixed |= $mixed{$values[$i]};
    }
    if ($mixed) {
      my(@nvalues) = ();
      foreach my $key (sort keys %mixed) {
        if ($mixed{$key}) {
          push(@nvalues, $key);
        }
      }
 
      ## Set the new values only if they are different
      ## from the original (except for order).
      my(@sorted) = sort(@values);
      if (@sorted != @nvalues) {
        @values = @nvalues;
      }
    }
 
    for(my $i = 0; $i <= $#values; ++$i) {
      my($value) = $values[$i];
 
      ## Set the corresponding values in the temporary scope
      $self->set_current_values($value);
 
      ## Set the special values that only exist
      ## within a foreach
      if ($i != 0) {
        $$scope{'forfirst'}    = '';
        $$scope{'fornotfirst'} = 1;
      }
      if ($i == $#values) {
        $$scope{'forlast'}    = 1;
        $$scope{'fornotlast'} = '';
      }
      $$scope{'forcount'} = $i + 1;
 
      ## We don't use adjust_value here because these names
      ## are generated from a foreach and should not be adjusted.
      $$scope{$name} = $value;
 
      ## A tiny hack for VC7
      if ($name eq 'configuration') {
        $self->{'prjc'}->update_project_info($self, 1,
                                             ['configuration', 'platform'],
                                             '|');
      }
 
      ## Now parse the line of text, each time
      ## with different values
      ++$self->{'foreach'}->{'processing'};
      ($status, $error) = $self->parse_line(undef, $text);
      --$self->{'foreach'}->{'processing'};
      if (!$status) {
        last;
      }
    }
  }
 
  return $status, $error;
}
 
 
sub handle_endif {
  my($self) = shift;
  my($name) = shift;
  my($end)  = pop(@{$self->{'sstack'}});
  pop(@{$self->{'lstack'}});
 
  if (!defined $end) {
    return 0, "Unmatched $name";
  }
  else {
    my($in) = index($end, $name);
    if ($in == 0) {
      $self->{'if_skip'} = 0;
    }
    elsif ($in == -1) {
      return 0, "Unmatched $name";
    }
  }
 
  return 1, undef;
}
 
 
sub handle_endfor {
  my($self) = shift;
  my($name) = shift;
  my($end)  = pop(@{$self->{'sstack'}});
  pop(@{$self->{'lstack'}});
 
  if (!defined $end) {
    return 0, "Unmatched $name";
  }
  else {
    my($in) = index($end, $name);
    if ($in == 0) {
      my($index) = $self->{'foreach'}->{'count'};
      my($status, $error) = $self->process_foreach();
      if ($status) {
        --$self->{'foreach'}->{'count'};
        $self->append_current($self->{'foreach'}->{'text'}->[$index]);
      }
      return $status, $error;
    }
    elsif ($in == -1) {
      return 0, "Unmatched $name";
    }
  }
 
  return 1, undef;
}
 
 
sub get_flag_overrides {
  my($self)  = shift;
  my($name)  = shift;
  my($type)  = '';
 
  ## Split the name and type parameters
  ($name, $type) = split(/,\s*/, $name);
 
  my($file) = $self->get_value($name);
  if (defined $file) {
    my($value) = undef;
    my($prjc)  = $self->{'prjc'};
    my($fo)    = $prjc->{'flag_overrides'};
 
    ## Save the name prefix (if there is one) for
    ## command parameter conversion at the end
    my($pre) = undef;
    if ($name =~ /(\w+)->/) {
      $pre = $1;
    }
 
    ## Replace the custom_type key with the actual custom type
    if ($name =~ /^custom_type\->/) {
      my($ct) = $self->get_value('custom_type');
      if (defined $ct) {
        $name = $ct;
      }
    }
 
    my($key) = (defined $$fo{$name} ? $name :
                   (defined $$fo{$name . 's'} ? $name . 's' : undef));
    if (defined $key) {
      if (defined $prjc->{'matching_assignments'}->{$key}) {
        ## Convert the file name into a unix style file name
        my($ustyle) = $file;
        $ustyle =~ s/\\/\//g;
 
        ## Save the directory portion for checking in the foreach
        my($dir) = $self->mpc_dirname($ustyle);
 
        my($of) = (defined $$fo{$key}->{$ustyle} ? $ustyle :
                      (defined $$fo{$key}->{$dir} ? $dir : undef));
        if (defined $of) {
          foreach my $aname (@{$prjc->{'matching_assignments'}->{$key}}) {
            if ($aname eq $type && defined $$fo{$key}->{$of}->{$aname}) {
              $value = $$fo{$key}->{$of}->{$aname};
              last;
            }
          }
        }
      }
    }
 
    ## If the name that we're overriding has a value and
    ## requires parameters, then we will convert all of the
    ## pseudo variables and provide parameters.
    if (defined $pre &&
        defined $value && $prjc->requires_parameters($type)) {
      $value = $prjc->convert_command_parameters(
                              $value,
                              $self->prepare_parameters($pre));
    }
 
    return $prjc->relative($value);
  }
 
  return undef;
}
 
 
sub get_multiple {
  my($self)  = shift;
  my($name)  = shift;
  my($value) = $self->get_value_with_default($name);
  return (defined $value ?
              $self->doif_multiple($self->create_array($value)) :
              undef);
}
 
 
sub doif_multiple {
  my($self)  = shift;
  my($value) = shift;
 
  if (defined $value) {
    return (scalar(@$value) > 1);
  }
  return undef;
}
 
 
sub handle_multiple {
  my($self) = shift;
  my($name) = shift;
  my($val)  = $self->get_value_with_default($name);
 
  if (defined $val) {
    my($array) = $self->create_array($val);
    $self->append_current(scalar(@$array));
  }
  else {
    $self->append_current(0);
  }
}
 
 
sub get_starts_with {
  my($self) = shift;
  my($str)  = shift;
  return $self->doif_starts_with([$str]);
}
 
 
sub doif_starts_with {
  my($self) = shift;
  my($val)  = shift;
 
  if (defined $val) {
    my($name, $pattern) = $self->split_parameters("@$val");
    if (defined $name && defined $pattern) {
      return ($self->get_value_with_default($name) =~ /^$pattern/);
    }
  }
  return undef;
}
 
 
sub handle_starts_with {
  my($self) = shift;
  my($str)  = shift;
 
  if (defined $str) {
    my($val) = $self->doif_starts_with([$str]);
 
    if (defined $val) {
      $self->append_current($val);
    }
    else {
      $self->append_current(0);
    }
  }
}
 
 
sub get_ends_with {
  my($self) = shift;
  my($str)  = shift;
  return $self->doif_ends_with([$str]);
}
 
 
sub doif_ends_with {
  my($self) = shift;
  my($val)  = shift;
 
  if (defined $val) {
    my($name, $pattern) = $self->split_parameters("@$val");
    if (defined $name && defined $pattern) {
      return ($self->get_value_with_default($name) =~ /$pattern$/);
    }
  }
  return undef;
}
 
 
sub handle_ends_with {
  my($self) = shift;
  my($str)  = shift;
 
  if (defined $str) {
    my($val) = $self->doif_ends_with([$str]);
 
    if (defined $val) {
      $self->append_current($val);
    }
    else {
      $self->append_current(0);
    }
  }
}
 
 
sub get_contains {
  my($self) = shift;
  my($str)  = shift;
  return $self->doif_contains([$str]);
}
 
 
sub doif_contains {
  my($self) = shift;
  my($val)  = shift;
 
  if (defined $val) {
    my($name, $pattern) = $self->split_parameters("@$val");
    if (defined $name && defined $pattern) {
      return ($self->get_value_with_default($name) =~ /$pattern/);
    }
  }
  return undef;
}
 
 
sub handle_contains {
  my($self) = shift;
  my($str)  = shift;
 
  if (defined $str) {
    my($val) = $self->doif_contains([$str]);
 
    if (defined $val) {
      $self->append_current($val);
    }
    else {
      $self->append_current(0);
    }
  }
}
 
 
sub get_compares {
  my($self) = shift;
  my($str)  = shift;
  return $self->doif_compares([$str]);
}
 
 
sub doif_compares {
  my($self) = shift;
  my($val)  = shift;
 
  if (defined $val) {
    my($name, $pattern) = $self->split_parameters("@$val");
    if (defined $name && defined $pattern) {
      return ($self->get_value_with_default($name) eq $pattern);
    }
  }
  return undef;
}
 
 
sub handle_compares {
  my($self) = shift;
  my($str)  = shift;
 
  if (defined $str) {
    my($val) = $self->doif_compares([$str]);
 
    if (defined $val) {
      $self->append_current($val);
    }
    else {
      $self->append_current(0);
    }
  }
}
 
 
sub perform_reverse {
  my($self)  = shift;
  my($value) = shift;
  return reverse(@$value);
}
 
 
sub handle_reverse {
  my($self) = shift;
  my($name) = shift;
  my($val)  = $self->get_value_with_default($name);
 
  if (defined $val) {
    my(@array) = $self->perform_reverse($self->create_array($val));
    $self->append_current("@array");
  }
}
 
 
sub perform_sort {
  my($self)  = shift;
  my($value) = shift;
  return sort(@$value);
}
 
 
sub handle_sort {
  my($self) = shift;
  my($name) = shift;
  my($val)  = $self->get_value_with_default($name);
 
  if (defined $val) {
    my(@array) = $self->perform_sort($self->create_array($val));
    $self->append_current("@array");
  }
}
 
 
sub get_uniq {
  my($self)  = shift;
  my($name)  = shift;
  my($value) = $self->get_value_with_default($name);
 
  if (defined $value) {
    my(@array) = $self->perform_uniq($self->create_array($value));
    return \@array;
  }
 
  return undef;
}
 
 
sub perform_uniq {
  my($self)  = shift;
  my($value) = shift;
  my(%value) = ();
  @value{@$value} = ();
  return sort(keys %value);
}
 
 
sub handle_uniq {
  my($self) = shift;
  my($name) = shift;
  my($val)  = $self->get_value_with_default($name);
 
  if (defined $val) {
    my(@array) = $self->perform_uniq($self->create_array($val));
    $self->append_current("@array");
  }
}
 
 
sub process_compound_if {
  my($self)   = shift;
  my($str)    = shift;
  my($status) = 0;
 
  if ($str =~ /\|\|/) {
    my($ret) = 0;
    foreach my $v (split(/\s*\|\|\s*/, $str)) {
      $ret |= $self->process_compound_if($v);
      if ($ret != 0) {
        return 1;
      }
    }
  }
  elsif ($str =~ /\&\&/) {
    my($ret) = 1;
    foreach my $v (split(/\s*\&\&\s*/, $str)) {
      $ret &&= $self->process_compound_if($v);
      if ($ret == 0) {
        return 0;
      }
    }
    $status = 1;
  }
  else {
    ## See if we need to reverse the return value
    my($not) = 0;
    if ($str =~ /^!(.*)/) {
      $not = 1;
      $str = $1;
    }
 
    ## Get the value based on the string
    my(@cmds) = ();
    my($val)  = undef;
    while ($str =~ /(\w+)\((.+)\)(.*)/) {
      if ($3 eq '') {
        push(@cmds, $1);
        $str = $2;
      }
      else {
        ## If there is something trailing the closing parenthesis then
        ## the whole thing is considered a parameter to the first
        ## function.
        last;
      }
    }
 
    if (defined $cmds[0]) {
      ## Start out calling get_xxx on the string
      my($type) = 0x01;
      my($prefix) = 'get_';
 
      $val = $str;
      foreach my $cmd (reverse @cmds) {
        if (defined $keywords{$cmd} && ($keywords{$cmd} & $type) != 0) {
          my($func) = "$prefix$cmd";
          $val = $self->$func($val);
 
          ## Now that we have a value, we need to switch over
          ## to calling doif_xxx
          $type = 0x04;
          $prefix = 'doif_';
        }
        else {
          $self->warning("Unable to use $cmd in if (no $prefix method).");
        }
      }
    }
    else {
      $val = $self->get_value($str);
    }
 
    ## See if any portion of the value is defined and not empty
    my($ret) = 0;
    if (defined $val) {
      if (UNIVERSAL::isa($val, 'ARRAY')) {
        foreach my $v (@$val) {
          if ($v ne '') {
            $ret = 1;
            last;
          }
        }
      }
      elsif ($val ne '') {
        $ret = 1;
      }
    }
    return ($not ? !$ret : $ret);
  }
 
  return $status;
}
 
 
sub handle_if {
  my($self)   = shift;
  my($val)    = shift;
  my($name)   = 'endif';
 
  push(@{$self->{'lstack'}}, $self->get_line_number() . " $val");
  if ($self->{'if_skip'}) {
    push(@{$self->{'sstack'}}, "*$name");
  }
  else {
    ## Determine if we are skipping the portion of this if statement
    ## $val will always be defined since we won't get into this method
    ## without properly parsing the if statement.
    $self->{'if_skip'} = !$self->process_compound_if($val);
    push(@{$self->{'sstack'}}, $name);
  }
}
 
 
sub handle_else {
  my($self)  = shift;
  my(@scopy) = @{$self->{'sstack'}};
 
  if (defined $scopy[$#scopy]) {
    my($index) = index($scopy[$#scopy], 'endif');
    if ($index >= 0) {
      if ($index == 0) {
        $self->{'if_skip'} ^= 1;
      }
      $self->{'sstack'}->[$#scopy] .= ':';
    }
 
    if (($self->{'sstack'}->[$#scopy] =~ tr/:/:/) > 1) {
      return 0, 'Unmatched else';
    }
  }
 
  return 1, undef;
}
 
 
sub handle_foreach {
  my($self)        = shift;
  my($val)         = shift;
  my($name)        = 'endfor';
  my($status)      = 1;
  my($errorString) = undef;
 
  push(@{$self->{'lstack'}}, $self->get_line_number());
  if (!$self->{'if_skip'}) {
    my($vname) = undef;
    if ($val =~ /flag_overrides\([^\)]+\)/) {
    }
    elsif ($val =~ /([^,]+),(.*)/) {
      $vname = $1;
      $val   = $2;
      $vname =~ s/^\s+//;
      $vname =~ s/\s+$//;
      $val   =~ s/^\s+//;
      $val   =~ s/\s+$//;
 
      ## Due to the way flag_overrides works, we can't allow
      ## the user to name the foreach variable when dealing
      ## with custom types.
      if ($val =~ /^custom_type\->/ || $val eq 'custom_types') {
        $status = 0;
        $errorString = 'The foreach variable can not be ' .
                       'named when dealing with custom types';
      }
      elsif ($val =~ /^grouped_.*_file\->/ || $val =~ /^grouped_.*files$/) {
        $status = 0;
        $errorString = 'The foreach variable can not be ' .
                       'named when dealing with grouped files';
      }
    }
 
    push(@{$self->{'sstack'}}, $name);
    my($index) = ++$self->{'foreach'}->{'count'};
 
    $self->{'foreach'}->{'name'}->[$index]  = $vname;
    $self->{'foreach'}->{'vars'}->[$index]  = $val;
    $self->{'foreach'}->{'text'}->[$index]  = '';
    $self->{'foreach'}->{'scope'}->[$index] = {};
    $self->{'foreach'}->{'scope_name'}->[$index] = undef;
  }
  else {
    push(@{$self->{'sstack'}}, "*$name");
  }
 
  return $status, $errorString;
}
 
 
sub handle_special {
  my($self) = shift;
  my($name) = shift;
  my($val)  = shift;
 
  ## If $name (fornotlast, forfirst, etc.) is set to 1
  ## Then we append the $val onto the current string that's
  ## being built.
  if ($self->get_value($name)) {
    $self->append_current($val);
  }
}
 
 
sub handle_uc {
  my($self) = shift;
  my($name) = shift;
 
  $self->append_current(uc($self->get_value_with_default($name)));
}
 
 
sub handle_lc {
  my($self) = shift;
  my($name) = shift;
 
  $self->append_current(lc($self->get_value_with_default($name)));
}
 
 
sub handle_ucw {
  my($self) = shift;
  my($name) = shift;
  my($val)  = $self->get_value_with_default($name);
 
  substr($val, 0, 1) = uc(substr($val, 0, 1));
  while($val =~ /[_\s]([a-z])/) {
    my($uc) = uc($1);
    $val =~ s/[_\s][a-z]/ $uc/;
  }
  $self->append_current($val);
}
 
 
sub perform_normalize {
  my($self)  = shift;
  my($value) = shift;
  $value =~ tr/\/\\\-$()./_/;
  return $value;
}
 
 
sub handle_normalize {
  my($self) = shift;
  my($name) = shift;
  my($val)  = $self->get_value_with_default($name);
 
  $self->append_current($self->perform_normalize($val));
}
 
 
sub perform_noextension {
  my($self)  = shift;
  my($value) = shift;
  $value =~ s/\.[^\.]+$//;
  return $value;
}
 
 
sub handle_noextension {
  my($self) = shift;
  my($name) = shift;
  my($val)  = $self->get_value_with_default($name);
 
  $self->append_current($self->perform_noextension($val));
}
 
 
sub get_dirname {
  my($self)  = shift;
  my($name)  = shift;
  my($value) = $self->get_value_with_default($name);
  return (defined $value ?
              $self->doif_dirname($value) : undef);
}
 
 
sub doif_dirname {
  my($self)  = shift;
  my($value) = shift;
 
  if (defined $value) {
    $value = $self->tp_dirname($value);
    return ($value ne '.');
  }
  return undef;
}
 
 
sub handle_dirname {
  my($self) = shift;
  my($name) = shift;
 
  if (!$self->{'if_skip'}) {
    $self->append_current(
              $self->tp_dirname($self->get_value_with_default($name)));
  }
}
 
 
sub handle_basename {
  my($self) = shift;
  my($name) = shift;
 
  if (!$self->{'if_skip'}) {
    $self->append_current(
              $self->basename($self->get_value_with_default($name)));
  }
}
 
 
sub handle_basenoextension {
  my($self) = shift;
  my($name) = shift;
  my($val)  = $self->basename($self->get_value_with_default($name));
 
  $val =~ s/\.[^\.]+$//;
  $self->append_current($val);
}
 
 
sub handle_flag_overrides {
  my($self)  = shift;
  my($name)  = shift;
  my($value) = $self->get_flag_overrides($name);
 
  if (defined $value) {
    $self->append_current($value);
  }
}
 
 
sub handle_marker {
  my($self) = shift;
  my($name) = shift;
  my($val)  = $self->{'prjc'}->get_verbatim($name);
 
  if (defined $val) {
    $self->append_current($val);
  }
}
 
 
sub handle_eval {
  my($self) = shift;
  my($name) = shift;
  my($val)  = $self->get_value_with_default($name);
 
  if (defined $val) {
    if ($val =~ /<%eval\($name\)%>/) {
      $self->warning("Infinite recursion detected in '$name'.");
    }
    else {
      ## Enter the eval state
      ++$self->{'eval'};
 
      ## Parse the eval line
      my($status, $error) = $self->parse_line(undef, $val);
      if ($status) {
        $self->{'built'} .= $self->{'eval_str'};
      }
      else {
        $self->warning($error);
      }
 
      ## Leave the eval state
      --$self->{'eval'};
      $self->{'eval_str'} = '';
    }
  }
}
 
 
sub handle_pseudo {
  my($self) = shift;
  my($name) = shift;
  $self->append_current($self->{'cmds'}->{$name});
}
 
 
sub get_duplicate_index {
  my($self) = shift;
  my($name) = shift;
  return $self->doif_duplicate_index($self->get_value_with_default($name));
}
 
 
sub doif_duplicate_index {
  my($self)  = shift;
  my($value) = shift;
 
  if (defined $value) {
    my($base) = lc($self->basename($value));
    my($path) = $self->tp_dirname($value);
 
    if (!defined $self->{'dupfiles'}->{$base}) {
      $self->{'dupfiles'}->{$base} = [$path];
    }
    else {
      my($index) = 1;
      foreach my $file (@{$self->{'dupfiles'}->{$base}}) {
        if ($file eq $path) {
          return $index;
        }
        ++$index;
      }
 
      push(@{$self->{'dupfiles'}->{$base}}, $path);
      return 1;
    }
  }
 
  return undef;
}
 
 
sub handle_duplicate_index {
  my($self) = shift;
  my($name) = shift;
 
  if (!$self->{'if_skip'}) {
    my($value) = $self->doif_duplicate_index(
                          $self->get_value_with_default($name));
    if (defined $value) {
      $self->append_current($value);
    }
  }
}
 
 
sub prepare_parameters {
  my($self)   = shift;
  my($prefix) = shift;
  my($input)  = $self->get_value($prefix . '->input_file');
  my($output) = undef;
 
  if (defined $input) {
    if ($self->{'cslashes'}) {
      $input = $self->{'prjc'}->slash_to_backslash($input);
    }
    $output = $self->get_value($prefix . '->input_file->output_files');
 
    if (defined $output) {
      my($size) = scalar(@$output);
      for(my $i = 0; $i < $size; ++$i) {
        my($fo) = $self->get_flag_overrides($prefix . '->input_file, gendir');
        if (defined $fo) {
          $$output[$i] = $fo . '/' . File::Basename::basename($$output[$i]);
        }
        if ($self->{'cslashes'}) {
          $$output[$i] = $self->{'prjc'}->slash_to_backslash($$output[$i]);
        }
      }
    }
  }
 
  ## Set the parameters array with the determined input and output files
  return $input, $output;
}
 
 
sub process_name {
  my($self)        = shift;
  my($line)        = shift;
  my($length)      = 0;
  my($status)      = 1;
  my($errorString) = undef;
 
  if ($line eq '') {
  }
  elsif ($line =~ /^\w+(\(([^\)]+|\".*\"|[!]?(\w+\s*,\s*)?\w+\(.+\))\)|\->\w+([\w\-\>]+)?)?%>/) {
    ## Split the line into a name and value
    my($name, $val) = ();
    if ($line =~ /([^%\(]+)(\(([^%]+)\))?%>/) {
      $name = lc($1);
      $val  = $3;
    }
 
    $length += length($name);
    if (defined $val) {
      ## Check for the parenthesis
      if (($val =~ tr/(//) != ($val =~ tr/)//)) {
        $status = 0;
        $errorString = 'Missing the closing parenthesis';
      }
 
      ## Add the length of the value plus 2 for the surrounding ()
      $length += length($val) + 2;
    }
 
    if ($status) {
      if (defined $keywords{$name}) {
        if ($name eq 'endif') {
          ($status, $errorString) = $self->handle_endif($name);
        }
        elsif ($name eq 'if') {
          $self->handle_if($val);
        }
        elsif ($name eq 'endfor') {
          ($status, $errorString) = $self->handle_endfor($name);
        }
        elsif ($name eq 'foreach') {
          ($status, $errorString) = $self->handle_foreach($val);
        }
        elsif ($name eq 'fornotlast'  || $name eq 'forlast' ||
               $name eq 'fornotfirst' || $name eq 'forfirst') {
          if (!$self->{'if_skip'}) {
            $self->handle_special($name, $self->process_special($val));
          }
        }
        elsif ($name eq 'else') {
          ($status, $errorString) = $self->handle_else();
        }
        elsif ($name eq 'comment') {
          ## Ignore the contents of the comment
        }
        else {
          if (!$self->{'if_skip'}) {
            my($func) = 'handle_' . $name;
            $self->$func($val);
          }
        }
      }
      elsif (defined $self->{'cmds'}->{$name}) {
        if (!$self->{'if_skip'}) {
          $self->handle_pseudo($name);
        }
      }
      else {
        if (!$self->{'if_skip'}) {
          if (defined $val && !defined $self->{'defaults'}->{$name}) {
            $self->{'defaults'}->{$name} = $self->process_special($val);
          }
          $self->append_current($self->get_value_with_default($name));
        }
      }
    }
  }
  else {
    my($error)  = $line;
    my($length) = length($line);
    for(my $i = 0; $i < $length; ++$i) {
      my($part) = substr($line, $i, 2);
      if ($part eq '%>') {
        $error = substr($line, 0, $i + 2);
        last;
      }
    }
    $status = 0;
    $errorString = "Unable to parse line starting at '$error'";
  }
 
  return $status, $errorString, $length;
}
 
 
sub collect_data {
  my($self)  = shift;
  my($prjc)  = $self->{'prjc'};
  my($cwd)   = $self->getcwd();
 
  ## Set the current working directory
  if ($self->{'cslashes'}) {
    $cwd = $prjc->slash_to_backslash($cwd);
  }
  $self->{'values'}->{'cwd'} = $cwd;
 
  ## Collect the components into {'values'} somehow
  foreach my $key (keys %{$prjc->{'valid_components'}}) {
    my(@list) = $prjc->get_component_list($key);
    if (defined $list[0]) {
      $self->{'values'}->{$key} = \@list;
    }
  }
 
  ## If there is a staticname and no sharedname then this project
  ## 'type_is_static'.  If we are generating static projects, let
  ## all of the templates know that we 'need_staticflags'.
  ## If there is a sharedname then this project 'type_is_dynamic'.
  my($sharedname) = $prjc->get_assignment('sharedname');
  my($staticname) = $prjc->get_assignment('staticname');
  if (!defined $sharedname && defined $staticname) {
    $self->{'override_target_type'} = 1;
    $self->{'values'}->{'type_is_static'}   = 1;
    $self->{'values'}->{'need_staticflags'} = 1;
  }
  elsif ($prjc->get_static() == 1) {
    $self->{'values'}->{'need_staticflags'} = 1;
  }
  elsif (defined $sharedname) {
    $self->{'values'}->{'type_is_dynamic'} = 1;
  }
 
  ## If there is a sharedname or exename then this project
  ## 'type_is_binary'.
  if (defined $sharedname ||
      defined $prjc->get_assignment('exename')) {
    $self->{'values'}->{'type_is_binary'} = 1;
  }
 
  ## A tiny hack (mainly for VC6 projects)
  ## for the workspace creator.  It needs to know the
  ## target names to match up with the project name.
  $prjc->update_project_info($self, 0, ['project_name']);
 
  ## This is for all projects
  $prjc->update_project_info($self, 1, ['after']);
 
  ## VC7 Projects need to know the GUID.
  ## We need to save this value in our known values
  ## since each guid generated will be different.  We need
  ## this to correspond to the same guid used in the workspace.
  my($guid) = $prjc->update_project_info($self, 1, ['guid']);
  $self->{'values'}->{'guid'} = $guid;
 
  ## Some Windows based projects can't deal with certain version
  ## values.  So, for those we provide a translated version.
  my($version) = $prjc->get_assignment('version');
  if (defined $version) {
    $self->{'values'}->{'win_version'} =
                        WinVersionTranslator::translate($version);
  }
}
 
 
sub parse_line {
  my($self)        = shift;
  my($ih)          = shift;
  my($line)        = shift;
  my($status)      = 1;
  my($errorString) = undef;
  my($startempty)  = (length($line) == 0 ? 1 : 0);
 
  ## If processing a foreach or the line only
  ## contains a keyword, then we do
  ## not need to add a newline to the end.
  if (!$self->{'eval'} && $self->{'foreach'}->{'processing'} == 0) {
    if ($line !~ /^[ ]*<%(\w+)(\(((\w+\s*,\s*)?\w+\(.+\)|[^\)]+)\))?%>$/ ||
        !defined $keywords{$1}) {
      $line .= $self->{'crlf'};
    }
  }
 
  if (!$self->{'eval'} && $self->{'foreach'}->{'count'} < 0) {
    $self->{'built'} = '';
  }
 
  my($start) = index($line, '<%');
  if ($start >= 0) {
    my($append_name) = 0;
    if ($start > 0) {
      if (!$self->{'if_skip'}) {
        $self->append_current(substr($line, 0, $start));
      }
      $line = substr($line, $start);
    }
    foreach my $item (split('<%', $line)) {
      my($name)   = 1;
      my($length) = length($item);
      for(my $i = 0; $i < $length; ++$i) {
        my($part) = substr($item, $i, 2);
        if ($part eq '%>') {
          ++$i;
          $name = 0;
          if ($append_name) {
            $append_name = 0;
            if (!$self->{'if_skip'}) {
              $self->append_current($part);
            }
          }
          if ($length != $i + 1) {
            if (!$self->{'if_skip'}) {
              $self->append_current(substr($item, $i + 1));
            }
            last;
          }
        }
        elsif ($name) {
          my($substr)  = substr($item, $i);
          my($efcheck) = ($substr =~ /^endfor\%\>/);
          my($focheck) = ($efcheck ? 0 : ($substr =~ /^foreach\(/));
 
          if ($focheck && $self->{'foreach'}->{'count'} >= 0) {
            ++$self->{'foreach'}->{'nested'};
          }
 
          if ($self->{'foreach'}->{'count'} < 0 ||
              $self->{'foreach'}->{'processing'} > $self->{'foreach'}->{'nested'} ||
              (($efcheck || $focheck) &&
               $self->{'foreach'}->{'nested'} == $self->{'foreach'}->{'processing'})) {
            my($nlen) = 0;
            ($status,
             $errorString,
             $nlen) = $self->process_name($substr);
 
            if ($status && $nlen == 0) {
              $errorString = "Could not parse this line at column $i";
              $status = 0;
            }
            if (!$status) {
              last;
            }
 
            $i += ($nlen - 1);
          }
          else  {
            $name = 0;
            if (!$self->{'if_skip'}) {
              $self->append_current('<%' . substr($item, $i, 1));
              $append_name = 1;
            }
          }
 
          if ($efcheck && $self->{'foreach'}->{'nested'} > 0) {
            --$self->{'foreach'}->{'nested'};
          }
        }
        else {
          if (!$self->{'if_skip'}) {
            $self->append_current(substr($item, $i, 1));
          }
        }
      }
    }
  }
  else {
    if (!$self->{'if_skip'}) {
      $self->append_current($line);
    }
  }
 
  if (!$self->{'eval'} && $self->{'foreach'}->{'count'} < 0) {
    ## If the line started out empty and we're not
    ## skipping from the start or the built up line is not empty
    if ($startempty ||
        ($self->{'built'} ne $self->{'crlf'} && $self->{'built'} ne '')) {
      push(@{$self->{'lines'}}, $self->{'built'});
    }
  }
 
  return $status, $errorString;
}
 
 
sub parse_file {
  my($self)  = shift;
  my($input) = shift;
 
  $self->collect_data();
  my($status, $errorString) = $self->cached_file_read($input);
 
  if ($status) {
    my($sstack) = $self->{'sstack'};
    if (defined $$sstack[0]) {
      my($lstack) = $self->{'lstack'};
      $status = 0;
      $errorString = "Missing an '$$sstack[0]' starting at $$lstack[0]";
    }
  }
 
  if (!$status) {
    my($linenumber) = $self->get_line_number();
    $errorString = "$input: line $linenumber:\n$errorString";
  }
 
  return $status, $errorString;
}
 
 
sub get_lines {
  my($self) = shift;
  return $self->{'lines'};
}
 
 
1;
 

Rev 107	Rev 198
1	`package TemplateParser;`	1	`package TemplateParser;`
2		2
3	`# ************************************************************`	3	`# ************************************************************`
4	`# Description : Parses the template and fills in missing values`	4	`# Description : Parses the template and fills in missing values`
5	`# Author : Chad Elliott`	5	`# Author : Chad Elliott`
6	`# Create Date : 5/17/2002`	6	`# Create Date : 5/17/2002`
7	`# ************************************************************`	7	`# ************************************************************`
8		8
9	`# ************************************************************`	9	`# ************************************************************`
10	`# Pragmas`	10	`# Pragmas`
11	`# ************************************************************`	11	`# ************************************************************`
12		12
13	`use strict;`	13	`use strict;`
14		14
15	`use Parser;`	15	`use Parser;`
16	`use WinVersionTranslator;`	16	`use WinVersionTranslator;`
17		17
18	`use vars qw(@ISA);`	18	`use vars qw(@ISA);`
19	`@ISA = qw(Parser);`	19	`@ISA = qw(Parser);`
20		20
21	`# ************************************************************`	21	`# ************************************************************`
22	`# Data Section`	22	`# Data Section`
23	`# ************************************************************`	23	`# ************************************************************`
24		24
25	`# Valid keywords for use in template files. Each has a handle_`	25	`# Valid keywords for use in template files. Each has a handle_`
26	`# method available, but some have other methods too.`	26	`# method available, but some have other methods too.`
27	`# Bit Meaning`	27	`# Bit Meaning`
28	`# 0 means there is a get_ method available (used by if)`	28	`# 0 means there is a get_ method available (used by if)`
29	`# 1 means there is a perform_ method available (used by foreach)`	29	`# 1 means there is a perform_ method available (used by foreach)`
30	`# 2 means there is a doif_ method available (used by if)`	30	`# 2 means there is a doif_ method available (used by if)`
31	`my(%keywords) = ('if' => 0,`	31	`my(%keywords) = ('if' => 0,`
32	`'else' => 0,`	32	`'else' => 0,`
33	`'endif' => 0,`	33	`'endif' => 0,`
34	`'noextension' => 2,`	34	`'noextension' => 2,`
35	`'dirname' => 5,`	35	`'dirname' => 5,`
36	`'basename' => 0,`	36	`'basename' => 0,`
37	`'basenoextension' => 0,`	37	`'basenoextension' => 0,`
38	`'foreach' => 0,`	38	`'foreach' => 0,`
39	`'forfirst' => 0,`	39	`'forfirst' => 0,`
40	`'fornotfirst' => 0,`	40	`'fornotfirst' => 0,`
41	`'fornotlast' => 0,`	41	`'fornotlast' => 0,`
42	`'forlast' => 0,`	42	`'forlast' => 0,`
43	`'endfor' => 0,`	43	`'endfor' => 0,`
44	`'eval' => 0,`	44	`'eval' => 0,`
45	`'comment' => 0,`	45	`'comment' => 0,`
46	`'marker' => 0,`	46	`'marker' => 0,`
47	`'uc' => 0,`	47	`'uc' => 0,`
48	`'lc' => 0,`	48	`'lc' => 0,`
49	`'ucw' => 0,`	49	`'ucw' => 0,`
50	`'normalize' => 2,`	50	`'normalize' => 2,`
51	`'flag_overrides' => 1,`	51	`'flag_overrides' => 1,`
52	`'reverse' => 2,`	52	`'reverse' => 2,`
53	`'sort' => 2,`	53	`'sort' => 2,`
54	`'uniq' => 3,`	54	`'uniq' => 3,`
55	`'multiple' => 5,`	55	`'multiple' => 5,`
56	`'starts_with' => 5,`	56	`'starts_with' => 5,`
57	`'ends_with' => 5,`	57	`'ends_with' => 5,`
58	`'contains' => 5,`	58	`'contains' => 5,`
59	`'compares' => 5,`	59	`'compares' => 5,`
60	`'duplicate_index' => 5,`	60	`'duplicate_index' => 5,`
61	`);`	61	`);`
62		62
63	`my(%target_type_vars) = ('type_is_static' => 1,`	63	`my(%target_type_vars) = ('type_is_static' => 1,`
64	`'need_staticflags' => 1,`	64	`'need_staticflags' => 1,`
65	`'type_is_dynamic' => 1,`	65	`'type_is_dynamic' => 1,`
66	`'type_is_binary' => 1,`	66	`'type_is_binary' => 1,`
67	`);`	67	`);`
68		68
69	`# ************************************************************`	69	`# ************************************************************`
70	`# Subroutine Section`	70	`# Subroutine Section`
71	`# ************************************************************`	71	`# ************************************************************`
72		72
73	`sub new {`	73	`sub new {`
74	`my($class) = shift;`	74	`my($class) = shift;`
75	`my($prjc) = shift;`	75	`my($prjc) = shift;`
76	`my($self) = $class->SUPER::new();`	76	`my($self) = $class->SUPER::new();`
77		77
78	`$self->{'prjc'} = $prjc;`	78	`$self->{'prjc'} = $prjc;`
79	`$self->{'ti'} = $prjc->get_template_input();`	79	`$self->{'ti'} = $prjc->get_template_input();`
80	`$self->{'cslashes'} = $prjc->convert_slashes();`	80	`$self->{'cslashes'} = $prjc->convert_slashes();`
81	`$self->{'crlf'} = $prjc->crlf();`	81	`$self->{'crlf'} = $prjc->crlf();`
82	`$self->{'cmds'} = $prjc->get_command_subs();`	82	`$self->{'cmds'} = $prjc->get_command_subs();`
83	`$self->{'vnames'} = $prjc->get_valid_names();`	83	`$self->{'vnames'} = $prjc->get_valid_names();`
84	`$self->{'values'} = {};`	84	`$self->{'values'} = {};`
85	`$self->{'defaults'} = {};`	85	`$self->{'defaults'} = {};`
86	`$self->{'lines'} = [];`	86	`$self->{'lines'} = [];`
87	`$self->{'built'} = '';`	87	`$self->{'built'} = '';`
88	`$self->{'sstack'} = [];`	88	`$self->{'sstack'} = [];`
89	`$self->{'lstack'} = [];`	89	`$self->{'lstack'} = [];`
90	`$self->{'if_skip'} = 0;`	90	`$self->{'if_skip'} = 0;`
91	`$self->{'eval'} = 0;`	91	`$self->{'eval'} = 0;`
92	`$self->{'eval_str'} = '';`	92	`$self->{'eval_str'} = '';`
93	`$self->{'dupfiles'} = {};`	93	`$self->{'dupfiles'} = {};`
94	`$self->{'override_target_type'} = undef;`	94	`$self->{'override_target_type'} = undef;`
95		95
96	`$self->{'foreach'} = {};`	96	`$self->{'foreach'} = {};`
97	`$self->{'foreach'}->{'count'} = -1;`	97	`$self->{'foreach'}->{'count'} = -1;`
98	`$self->{'foreach'}->{'nested'} = 0;`	98	`$self->{'foreach'}->{'nested'} = 0;`
99	`$self->{'foreach'}->{'name'} = [];`	99	`$self->{'foreach'}->{'name'} = [];`
100	`$self->{'foreach'}->{'vars'} = [];`	100	`$self->{'foreach'}->{'vars'} = [];`
101	`$self->{'foreach'}->{'text'} = [];`	101	`$self->{'foreach'}->{'text'} = [];`
102	`$self->{'foreach'}->{'scope'} = [];`	102	`$self->{'foreach'}->{'scope'} = [];`
103	`$self->{'foreach'}->{'scope_name'} = [];`	103	`$self->{'foreach'}->{'scope_name'} = [];`
104	`$self->{'foreach'}->{'temp_scope'} = [];`	104	`$self->{'foreach'}->{'temp_scope'} = [];`
105	`$self->{'foreach'}->{'processing'} = 0;`	105	`$self->{'foreach'}->{'processing'} = 0;`
106		106
107	`return $self;`	107	`return $self;`
108	`}`	108	`}`
109		109
110		110
111	`sub basename {`	111	`sub basename {`
112	`my($self) = shift;`	112	`my($self) = shift;`
113	`my($file) = shift;`	113	`my($file) = shift;`
114		114
115	`if ($self->{'cslashes'}) {`	115	`if ($self->{'cslashes'}) {`
116	`$file =~ s/.*[\/\\]//;`	116	`$file =~ s/.*[\/\\]//;`
117	`}`	117	`}`
118	`else {`	118	`else {`
119	`$file =~ s/.*\///;`	119	`$file =~ s/.*\///;`
120	`}`	120	`}`
121	`return $file;`	121	`return $file;`
122	`}`	122	`}`
123		123
124		124
125	`sub tp_dirname {`	125	`sub tp_dirname {`
126	`my($self) = shift;`	126	`my($self) = shift;`
127	`my($file) = shift;`	127	`my($file) = shift;`
128	`my($index) = rindex($file, ($self->{'cslashes'} ? '\\' : '/'));`	128	`my($index) = rindex($file, ($self->{'cslashes'} ? '\\' : '/'));`
129		129
130	`if ($index >= 0) {`	130	`if ($index >= 0) {`
131	`return $self->{'prjc'}->validated_directory(substr($file, 0, $index));`	131	`return $self->{'prjc'}->validated_directory(substr($file, 0, $index));`
132	`}`	132	`}`
133	`else {`	133	`else {`
134	`return '.';`	134	`return '.';`
135	`}`	135	`}`
136	`}`	136	`}`
137		137
138		138
139	`sub strip_line {`	139	`sub strip_line {`
140	`#my($self) = shift;`	140	`#my($self) = shift;`
141	`#my($line) = shift;`	141	`#my($line) = shift;`
142		142
143	`## Override strip_line() from Parser.`	143	`## Override strip_line() from Parser.`
144	`## We need to preserve leading space and`	144	`## We need to preserve leading space and`
145	`## there is no comment string in templates.`	145	`## there is no comment string in templates.`
146	`++$_[0]->{'line_number'};`	146	`++$_[0]->{'line_number'};`
147	`$_[1] =~ s/\s+$//;`	147	`$_[1] =~ s/\s+$//;`
148		148
149	`return $_[1];`	149	`return $_[1];`
150	`}`	150	`}`
151		151
152		152
153	`## Append the current value to the line that is being`	153	`## Append the current value to the line that is being`
154	`## built. This line may be a foreach line or a general`	154	`## built. This line may be a foreach line or a general`
155	`## line without a foreach.`	155	`## line without a foreach.`
156	`sub append_current {`	156	`sub append_current {`
157	`# my($self) = shift;`	157	`# my($self) = shift;`
158	`# my($value) = shift;`	158	`# my($value) = shift;`
159		159
160	`if ($_[0]->{'foreach'}->{'count'} >= 0) {`	160	`if ($_[0]->{'foreach'}->{'count'} >= 0) {`
161	`$_[0]->{'foreach'}->{'text'}->[$_[0]->{'foreach'}->{'count'}] .= $_[1];`	161	`$_[0]->{'foreach'}->{'text'}->[$_[0]->{'foreach'}->{'count'}] .= $_[1];`
162	`}`	162	`}`
163	`elsif ($_[0]->{'eval'}) {`	163	`elsif ($_[0]->{'eval'}) {`
164	`$_[0]->{'eval_str'} .= $_[1];`	164	`$_[0]->{'eval_str'} .= $_[1];`
165	`}`	165	`}`
166	`else {`	166	`else {`
167	`$_[0]->{'built'} .= $_[1];`	167	`$_[0]->{'built'} .= $_[1];`
168	`}`	168	`}`
169	`}`	169	`}`
170		170
171		171
172	`sub split_parameters {`	172	`sub split_parameters {`
173	`my($self) = shift;`	173	`my($self) = shift;`
174	`my($str) = shift;`	174	`my($str) = shift;`
175	`my(@params) = ();`	175	`my(@params) = ();`
176		176
177	`while($str =~ /(\w+\([^\)]+\))\s,\s(.*)/) {`	177	`while($str =~ /(\w+\([^\)]+\))\s,\s(.*)/) {`
178	`push(@params, $1);`	178	`push(@params, $1);`
179	`$str = $2;`	179	`$str = $2;`
180	`}`	180	`}`
181	`while($str =~ /([^,]+)\s,\s(.*)/) {`	181	`while($str =~ /([^,]+)\s,\s(.*)/) {`
182	`push(@params, $1);`	182	`push(@params, $1);`
183	`$str = $2;`	183	`$str = $2;`
184	`}`	184	`}`
185		185
186	`## Return the parameters (which includes whatever is left in the`	186	`## Return the parameters (which includes whatever is left in the`
187	`## string). Just return it instead of pushing it onto @params.`	187	`## string). Just return it instead of pushing it onto @params.`
188	`return @params, $str;`	188	`return @params, $str;`
189	`}`	189	`}`
190		190
191		191
192	`sub set_current_values {`	192	`sub set_current_values {`
193	`my($self) = shift;`	193	`my($self) = shift;`
194	`my($name) = shift;`	194	`my($name) = shift;`
195	`my($set) = 0;`	195	`my($set) = 0;`
196		196
197	`## If any value within a foreach matches the name`	197	`## If any value within a foreach matches the name`
198	`## of a hash table within the template input we will`	198	`## of a hash table within the template input we will`
199	`## set the values of that hash table in the current scope`	199	`## set the values of that hash table in the current scope`
200	`if (defined $self->{'ti'}) {`	200	`if (defined $self->{'ti'}) {`
201	`my($counter) = $self->{'foreach'}->{'count'};`	201	`my($counter) = $self->{'foreach'}->{'count'};`
202	`if ($counter >= 0) {`	202	`if ($counter >= 0) {`
203	`## Variable names are case-insensitive in MPC, however this can`	203	`## Variable names are case-insensitive in MPC, however this can`
204	`## cause problems when dealing with template variable values that`	204	`## cause problems when dealing with template variable values that`
205	`## happen to match HASH names only by case-insensitivity. So, we`	205	`## happen to match HASH names only by case-insensitivity. So, we`
206	`## now make HASH names match with case-sensitivity.`	206	`## now make HASH names match with case-sensitivity.`
207	`my($value) = $self->{'ti'}->get_value($name);`	207	`my($value) = $self->{'ti'}->get_value($name);`
208	`if (defined $value && UNIVERSAL::isa($value, 'HASH') &&`	208	`if (defined $value && UNIVERSAL::isa($value, 'HASH') &&`
209	`$self->{'ti'}->get_realname($name) eq $name) {`	209	`$self->{'ti'}->get_realname($name) eq $name) {`
210	`$self->{'foreach'}->{'scope_name'}->[$counter] = $name;`	210	`$self->{'foreach'}->{'scope_name'}->[$counter] = $name;`
211	`my(%copy) = ();`	211	`my(%copy) = ();`
212	`foreach my $key (keys %$value) {`	212	`foreach my $key (keys %$value) {`
213	`$copy{$key} = $self->{'prjc'}->adjust_value(`	213	`$copy{$key} = $self->{'prjc'}->adjust_value(`
214	`[$name . '::' . $key, $name], $$value{$key});`	214	`[$name . '::' . $key, $name], $$value{$key});`
215	`}`	215	`}`
216	`$self->{'foreach'}->{'temp_scope'}->[$counter] = \%copy;`	216	`$self->{'foreach'}->{'temp_scope'}->[$counter] = \%copy;`
217	`$set = 1;`	217	`$set = 1;`
218	`}`	218	`}`
219	`}`	219	`}`
220	`}`	220	`}`
221	`return $set;`	221	`return $set;`
222	`}`	222	`}`
223		223
224		224
225	`sub get_value {`	225	`sub get_value {`
226	`my($self) = shift;`	226	`my($self) = shift;`
227	`my($name) = shift;`	227	`my($name) = shift;`
228	`my($value) = undef;`	228	`my($value) = undef;`
229	`my($counter) = $self->{'foreach'}->{'count'};`	229	`my($counter) = $self->{'foreach'}->{'count'};`
230	`my($fromprj) = 0;`	230	`my($fromprj) = 0;`
231	`my($scope) = undef;`	231	`my($scope) = undef;`
232	`my($sname) = undef;`	232	`my($sname) = undef;`
233	`my($adjust) = 1;`	233	`my($adjust) = 1;`
234		234
-		235	`## $name should always be all lower-case`
-		236	`$name = lc($name);`
-		237
235	`## First, check the temporary scope (set inside a foreach)`	238	`## First, check the temporary scope (set inside a foreach)`
236	`if ($counter >= 0) {`	239	`if ($counter >= 0) {`
237	`## Find the outer most scope for our variable name`	240	`## Find the outer most scope for our variable name`
238	`for(my $index = $counter; $index >= 0; --$index) {`	241	`for(my $index = $counter; $index >= 0; --$index) {`
239	`if (defined $self->{'foreach'}->{'scope_name'}->[$index]) {`	242	`if (defined $self->{'foreach'}->{'scope_name'}->[$index]) {`
240	`$scope = $self->{'foreach'}->{'scope_name'}->[$index];`	243	`$scope = $self->{'foreach'}->{'scope_name'}->[$index];`
241	`$sname = $scope . '::' . $name;`	244	`$sname = $scope . '::' . $name;`
242	`last;`	245	`last;`
243	`}`	246	`}`
244	`}`	247	`}`
245	`while(!defined $value && $counter >= 0) {`	248	`while(!defined $value && $counter >= 0) {`
246	`$value = $self->{'foreach'}->{'temp_scope'}->[$counter]->{$name};`	249	`$value = $self->{'foreach'}->{'temp_scope'}->[$counter]->{$name};`
247	`--$counter;`	250	`--$counter;`
248	`}`	251	`}`
249	`$counter = $self->{'foreach'}->{'count'};`	252	`$counter = $self->{'foreach'}->{'count'};`
250		253
251	`if ($self->{'override_target_type'} &&`	254	`if ($self->{'override_target_type'} &&`
252	`defined $value && defined $target_type_vars{$name}) {`	255	`defined $value && defined $target_type_vars{$name}) {`
253	`$value = $self->{'values'}->{$name};`	256	`$value = $self->{'values'}->{$name};`
254	`}`	257	`}`
255	`}`	258	`}`
256		259
257	`if (!defined $value) {`	260	`if (!defined $value) {`
258	`if ($name =~ /^flag_overrides\((.*)\)$/) {`	261	`if ($name =~ /^flag_overrides\((.*)\)$/) {`
259	`$value = $self->get_flag_overrides($1);`	262	`$value = $self->get_flag_overrides($1);`
260	`}`	263	`}`
261		264
262	`if (!defined $value) {`	265	`if (!defined $value) {`
263	`## Next, check for a template value`	266	`## Next, check for a template value`
264	`if (defined $self->{'ti'}) {`	267	`if (defined $self->{'ti'}) {`
265	`$value = $self->{'ti'}->get_value($name);`	268	`$value = $self->{'ti'}->get_value($name);`
266	`}`	269	`}`
267		270
268	`if (!defined $value) {`	271	`if (!defined $value) {`
269	`## Calling adjust_value here allows us to pick up template`	272	`## Calling adjust_value here allows us to pick up template`
270	`## overrides before getting values elsewhere.`	273	`## overrides before getting values elsewhere.`
271	`my($uvalue) = $self->{'prjc'}->adjust_value([$sname, $name], []);`	274	`my($uvalue) = $self->{'prjc'}->adjust_value([$sname, $name], []);`
272	`if (defined $$uvalue[0]) {`	275	`if (defined $$uvalue[0]) {`
273	`$value = $uvalue;`	276	`$value = $uvalue;`
274	`$adjust = 0;`	277	`$adjust = 0;`
275	`}`	278	`}`
276		279
277	`if (!defined $value) {`	280	`if (!defined $value) {`
278	`## Next, check the inner to outer foreach`	281	`## Next, check the inner to outer foreach`
279	`## scopes for overriding values`	282	`## scopes for overriding values`
280	`while(!defined $value && $counter >= 0) {`	283	`while(!defined $value && $counter >= 0) {`
281	`$value = $self->{'foreach'}->{'scope'}->[$counter]->{$name};`	284	`$value = $self->{'foreach'}->{'scope'}->[$counter]->{$name};`
282	`--$counter;`	285	`--$counter;`
283	`}`	286	`}`
284		287
285	`## Then get the value from the project creator`	288	`## Then get the value from the project creator`
286	`if (!defined $value) {`	289	`if (!defined $value) {`
287	`$fromprj = 1;`	290	`$fromprj = 1;`
288	`$value = $self->{'prjc'}->get_assignment($name);`	291	`$value = $self->{'prjc'}->get_assignment($name);`
289		292
290	`## Then get it from our known values`	293	`## Then get it from our known values`
291	`if (!defined $value) {`	294	`if (!defined $value) {`
292	`$value = $self->{'values'}->{$name};`	295	`$value = $self->{'values'}->{$name};`
293	`if (!defined $value) {`	296	`if (!defined $value) {`
294	`## Call back onto the project creator to allow`	297	`## Call back onto the project creator to allow`
295	`## it to fill in the value before defaulting to undef.`	298	`## it to fill in the value before defaulting to undef.`
296	`$value = $self->{'prjc'}->fill_value($name);`	299	`$value = $self->{'prjc'}->fill_value($name);`
297	`if (!defined $value && $name =~ /^(.*)\->(\w+)/) {`	300	`if (!defined $value && $name =~ /^(.*)\->(\w+)/) {`
298	`my($pre) = $1;`	301	`my($pre) = $1;`
299	`my($post) = $2;`	302	`my($post) = $2;`
300	`my($base) = $self->get_value($pre);`	303	`my($base) = $self->get_value($pre);`
301		304
302	`if (defined $base) {`	305	`if (defined $base) {`
303	`$value = $self->{'prjc'}->get_special_value(`	306	`$value = $self->{'prjc'}->get_special_value(`
304	`$pre, $post, $base,`	307	`$pre, $post, $base,`
305	`($self->{'prjc'}->requires_parameters($post) ?`	308	`($self->{'prjc'}->requires_parameters($post) ?`
306	`$self->prepare_parameters($pre) : undef));`	309	`$self->prepare_parameters($pre) : undef));`
307	`}`	310	`}`
308	`}`	311	`}`
309	`}`	312	`}`
310	`}`	313	`}`
311	`}`	314	`}`
312	`}`	315	`}`
313	`}`	316	`}`
314	`}`	317	`}`
315	`}`	318	`}`
316		319
317	`## Adjust the value even if we haven't obtained one from an outside`	320	`## Adjust the value even if we haven't obtained one from an outside`
318	`## source.`	321	`## source.`
319	`if ($adjust && defined $value) {`	322	`if ($adjust && defined $value) {`
320	`$value = $self->{'prjc'}->adjust_value([$sname, $name], $value);`	323	`$value = $self->{'prjc'}->adjust_value([$sname, $name], $value);`
321	`}`	324	`}`
322		325
323	`## If the value did not come from the project creator, we`	326	`## If the value did not come from the project creator, we`
324	`## check the variable name. If it is a project keyword we then`	327	`## check the variable name. If it is a project keyword we then`
325	`## check to see if we need to add the project value to the template`	328	`## check to see if we need to add the project value to the template`
326	`## variable value. If so, we make a copy of the value array and`	329	`## variable value. If so, we make a copy of the value array and`
327	`## push the project value onto that (to avoid modifying the original).`	330	`## push the project value onto that (to avoid modifying the original).`
328	`if (!$fromprj && defined $self->{'vnames'}->{$name} &&`	331	`if (!$fromprj && defined $self->{'vnames'}->{$name} &&`
329	`$self->{'prjc'}->add_to_template_input_value($name)) {`	332	`$self->{'prjc'}->add_to_template_input_value($name)) {`
330	`my($pjval) = $self->{'prjc'}->get_assignment($name);`	333	`my($pjval) = $self->{'prjc'}->get_assignment($name);`
331	`if (defined $pjval) {`	334	`if (defined $pjval) {`
332	`my(@copy) = @$value;`	335	`my(@copy) = @$value;`
333	`if (!UNIVERSAL::isa($pjval, 'ARRAY')) {`	336	`if (!UNIVERSAL::isa($pjval, 'ARRAY')) {`
334	`$pjval = $self->create_array($pjval);`	337	`$pjval = $self->create_array($pjval);`
335	`}`	338	`}`
336	`push(@copy, @$pjval);`	339	`push(@copy, @$pjval);`
337	`$value = \@copy;`	340	`$value = \@copy;`
338	`}`	341	`}`
339	`}`	342	`}`
340		343
341	`return $self->{'prjc'}->relative($value, undef, $scope);`	344	`return $self->{'prjc'}->relative($value, undef, $scope);`
342	`}`	345	`}`
343		346
344		347
345	`sub get_value_with_default {`	348	`sub get_value_with_default {`
346	`my($self) = shift;`	349	`my($self) = shift;`
347	`my($name) = shift;`	350	`my($name) = shift;`
348	`my($value) = $self->get_value($name);`	351	`my($value) = $self->get_value($name);`
349		352
350	`if (!defined $value) {`	353	`if (!defined $value) {`
351	`$value = $self->{'defaults'}->{$name};`	354	`$value = $self->{'defaults'}->{$name};`
352	`if (defined $value) {`	355	`if (defined $value) {`
353	`my($counter) = $self->{'foreach'}->{'count'};`	356	`my($counter) = $self->{'foreach'}->{'count'};`
354	`my($sname) = undef;`	357	`my($sname) = undef;`
355		358
356	`if ($counter >= 0) {`	359	`if ($counter >= 0) {`
357	`## Find the outer most scope for our variable name`	360	`## Find the outer most scope for our variable name`
358	`for(my $index = $counter; $index >= 0; --$index) {`	361	`for(my $index = $counter; $index >= 0; --$index) {`
359	`if (defined $self->{'foreach'}->{'scope_name'}->[$index]) {`	362	`if (defined $self->{'foreach'}->{'scope_name'}->[$index]) {`
360	`$sname = $self->{'foreach'}->{'scope_name'}->[$index] .`	363	`$sname = $self->{'foreach'}->{'scope_name'}->[$index] .`
361	`'::' . $name;`	364	`'::' . $name;`
362	`last;`	365	`last;`
363	`}`	366	`}`
364	`}`	367	`}`
365	`}`	368	`}`
366	`$value = $self->{'prjc'}->relative(`	369	`$value = $self->{'prjc'}->relative(`
367	`$self->{'prjc'}->adjust_value([$sname, $name], $value));`	370	`$self->{'prjc'}->adjust_value([$sname, $name], $value));`
368		371
369	`## If the user set the variable to empty, we will go ahead and use`	372	`## If the user set the variable to empty, we will go ahead and use`
370	`## the default value (since we know we have one at this point).`	373	`## the default value (since we know we have one at this point).`
371	`if (!defined $value) {`	374	`if (!defined $value) {`
372	`$value = $self->{'defaults'}->{$name};`	375	`$value = $self->{'defaults'}->{$name};`
373	`}`	376	`}`
374	`}`	377	`}`
375	`else {`	378	`else {`
376	`#$self->warning("$name defaulting to empty string.");`	379	`#$self->warning("$name defaulting to empty string.");`
377	`$value = '';`	380	`$value = '';`
378	`}`	381	`}`
379	`}`	382	`}`
380		383
381	`if (UNIVERSAL::isa($value, 'ARRAY')) {`	384	`if (UNIVERSAL::isa($value, 'ARRAY')) {`
382	`$value = "@$value";`	385	`$value = "@$value";`
383	`}`	386	`}`
384		387
385	`return $value;`	388	`return $value;`
386	`}`	389	`}`
387		390
388		391
389	`sub process_foreach {`	392	`sub process_foreach {`
390	`my($self) = shift;`	393	`my($self) = shift;`
391	`my($index) = $self->{'foreach'}->{'count'};`	394	`my($index) = $self->{'foreach'}->{'count'};`
392	`my($text) = $self->{'foreach'}->{'text'}->[$index];`	395	`my($text) = $self->{'foreach'}->{'text'}->[$index];`
393	`my($status) = 1;`	396	`my($status) = 1;`
394	`my($error) = undef;`	397	`my($error) = undef;`
395	`my(@values) = ();`	398	`my(@values) = ();`
396	`my($name) = $self->{'foreach'}->{'name'}->[$index];`	399	`my($name) = $self->{'foreach'}->{'name'}->[$index];`
397	`my(@cmds) = ();`	400	`my(@cmds) = ();`
398	`my($val) = $self->{'foreach'}->{'vars'}->[$index];`	401	`my($val) = $self->{'foreach'}->{'vars'}->[$index];`
399		402
400	`if ($val =~ /^((\w+),\s)?flag_overrides\((.)\)$/) {`	403	`if ($val =~ /^((\w+),\s)?flag_overrides\((.)\)$/) {`
401	`my($over) = $self->get_flag_overrides($3);`	404	`my($over) = $self->get_flag_overrides($3);`
402	`$name = $2;`	405	`$name = $2;`
403	`if (defined $over) {`	406	`if (defined $over) {`
404	`$val = $self->create_array($over);`	407	`$val = $self->create_array($over);`
405	`@values = @$val;`	408	`@values = @$val;`
406	`}`	409	`}`
407	`if (!defined $name) {`	410	`if (!defined $name) {`
408	`$name = '__unnamed__';`	411	`$name = '__unnamed__';`
409	`}`	412	`}`
410	`}`	413	`}`
411	`else {`	414	`else {`
412	`## Pull out modifying commands first`	415	`## Pull out modifying commands first`
413	`while ($val =~ /(\w+)\((.+)\)/) {`	416	`while ($val =~ /(\w+)\((.+)\)/) {`
414	`my($cmd) = $1;`	417	`my($cmd) = $1;`
415	`$val = $2;`	418	`$val = $2;`
416	`if (($keywords{$cmd} & 0x02) != 0) {`	419	`if (($keywords{$cmd} & 0x02) != 0) {`
417	`push(@cmds, 'perform_' . $cmd);`	420	`push(@cmds, 'perform_' . $cmd);`
418	`}`	421	`}`
419	`else {`	422	`else {`
420	`$self->warning("Unable to use $cmd in foreach (no perform_ method).");`	423	`$self->warning("Unable to use $cmd in foreach (no perform_ method).");`
421	`}`	424	`}`
422	`}`	425	`}`
423		426
424	`## Get the values for all of the variable names`	427	`## Get the values for all of the variable names`
425	`## contained within the foreach`	428	`## contained within the foreach`
426	`my($names) = $self->create_array($val);`	429	`my($names) = $self->create_array($val);`
427	`foreach my $n (@$names) {`	430	`foreach my $n (@$names) {`
428	`my($vals) = $self->get_value($n);`	431	`my($vals) = $self->get_value($n);`
429	`if (defined $vals && $vals ne '') {`	432	`if (defined $vals && $vals ne '') {`
430	`if (!UNIVERSAL::isa($vals, 'ARRAY')) {`	433	`if (!UNIVERSAL::isa($vals, 'ARRAY')) {`
431	`$vals = $self->create_array($vals);`	434	`$vals = $self->create_array($vals);`
432	`}`	435	`}`
433	`push(@values, @$vals);`	436	`push(@values, @$vals);`
434	`}`	437	`}`
435	`if (!defined $name) {`	438	`if (!defined $name) {`
436	`$name = $n;`	439	`$name = $n;`
437	`$name =~ s/s$//;`	440	`$name =~ s/s$//;`
438	`}`	441	`}`
439	`}`	442	`}`
440	`}`	443	`}`
441		444
442	`## Perform the commands on the built up @values`	445	`## Perform the commands on the built up @values`
443	`foreach my $cmd (reverse @cmds) {`	446	`foreach my $cmd (reverse @cmds) {`
444	`@values = $self->$cmd(\@values);`	447	`@values = $self->$cmd(\@values);`
445	`}`	448	`}`
446		449
447	`## Reset the text (it will be regenerated by calling parse_line`	450	`## Reset the text (it will be regenerated by calling parse_line`
448	`$self->{'foreach'}->{'text'}->[$index] = '';`	451	`$self->{'foreach'}->{'text'}->[$index] = '';`
449		452
450	`if (defined $values[0]) {`	453	`if (defined $values[0]) {`
451	`my($scope) = $self->{'foreach'}->{'scope'}->[$index];`	454	`my($scope) = $self->{'foreach'}->{'scope'}->[$index];`
452		455
453	`$$scope{'forlast'} = '';`	456	`$$scope{'forlast'} = '';`
454	`$$scope{'fornotlast'} = 1;`	457	`$$scope{'fornotlast'} = 1;`
455	`$$scope{'forfirst'} = 1;`	458	`$$scope{'forfirst'} = 1;`
456	`$$scope{'fornotfirst'} = '';`	459	`$$scope{'fornotfirst'} = '';`
457		460
458	`## If the foreach values are mixed (HASH and SCALAR), then`	461	`## If the foreach values are mixed (HASH and SCALAR), then`
459	`## remove the SCALAR values.`	462	`## remove the SCALAR values.`
460	`my(%mixed) = ();`	463	`my(%mixed) = ();`
461	`my($mixed) = 0;`	464	`my($mixed) = 0;`
462	`for(my $i = 0; $i <= $#values; ++$i) {`	465	`for(my $i = 0; $i <= $#values; ++$i) {`
463	`$mixed{$values[$i]} = $self->set_current_values($values[$i]);`	466	`$mixed{$values[$i]} = $self->set_current_values($values[$i]);`
464	`$mixed \|= $mixed{$values[$i]};`	467	`$mixed \|= $mixed{$values[$i]};`
465	`}`	468	`}`
466	`if ($mixed) {`	469	`if ($mixed) {`
467	`my(@nvalues) = ();`	470	`my(@nvalues) = ();`
468	`foreach my $key (sort keys %mixed) {`	471	`foreach my $key (sort keys %mixed) {`
469	`if ($mixed{$key}) {`	472	`if ($mixed{$key}) {`
470	`push(@nvalues, $key);`	473	`push(@nvalues, $key);`
471	`}`	474	`}`
472	`}`	475	`}`
473		476
474	`## Set the new values only if they are different`	477	`## Set the new values only if they are different`
475	`## from the original (except for order).`	478	`## from the original (except for order).`
476	`my(@sorted) = sort(@values);`	479	`my(@sorted) = sort(@values);`
477	`if (@sorted != @nvalues) {`	480	`if (@sorted != @nvalues) {`
478	`@values = @nvalues;`	481	`@values = @nvalues;`
479	`}`	482	`}`
480	`}`	483	`}`
481		484
482	`for(my $i = 0; $i <= $#values; ++$i) {`	485	`for(my $i = 0; $i <= $#values; ++$i) {`
483	`my($value) = $values[$i];`	486	`my($value) = $values[$i];`
484		487
485	`## Set the corresponding values in the temporary scope`	488	`## Set the corresponding values in the temporary scope`
486	`$self->set_current_values($value);`	489	`$self->set_current_values($value);`
487		490
488	`## Set the special values that only exist`	491	`## Set the special values that only exist`
489	`## within a foreach`	492	`## within a foreach`
490	`if ($i != 0) {`	493	`if ($i != 0) {`
491	`$$scope{'forfirst'} = '';`	494	`$$scope{'forfirst'} = '';`
492	`$$scope{'fornotfirst'} = 1;`	495	`$$scope{'fornotfirst'} = 1;`
493	`}`	496	`}`
494	`if ($i == $#values) {`	497	`if ($i == $#values) {`
495	`$$scope{'forlast'} = 1;`	498	`$$scope{'forlast'} = 1;`
496	`$$scope{'fornotlast'} = '';`	499	`$$scope{'fornotlast'} = '';`
497	`}`	500	`}`

Subversion Repositories gelsvn

(root)/trunk/MPC/modules/TemplateParser.pm @ 201 – Rev 107 → 198