package TemplateParser;

# ************************************************************
# Description   : Parses the template and fills in missing values
# Author        : Chad Elliott
# Create Date   : 5/17/2002
# ************************************************************

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

use strict;
use File::Path;

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 and nested functions)
# 1 means there is a perform_ method available (used by foreach and nested)
# 2 means there is a doif_ method available (used by if)
# 3 means that parameters to perform_ should not be evaluated
# 4 means there is a post_ method available (called after the results of
#   calling perform_ for a nested function are written to the output)
# 5 means that the get_ method performs the get_ and doif_ functionality
#
# Perl Function		Parameter Type		Return Type
# get_			string			string or array
# perform_		array reference		array
# doif_			array reference		boolean
#
my $get_type             = 1 << 0;
my $perform_type         = 1 << 1;
my $doif_type            = 1 << 2;
my $perform_no_eval_type = 1 << 3;
my $post_type            = 1 << 4;
my $get_combined_type    = 1 << 5;
my %keywords = ('if'              => 0,
                'else'            => 0,
                'endif'           => 0,
                'noextension'     => $get_type|$perform_type,
                'dirname'         => $get_type|$perform_type|$doif_type,
                'basename'        => $get_type|$perform_type|$doif_type,
                'basenoextension' => 0,
                'foreach'         => 0,
                'forfirst'        => 0,
                'fornotfirst'     => 0,
                'fornotlast'      => 0,
                'forlast'         => 0,
                'endfor'          => 0,
                'eval'            => 0,
                'comment'         => 0,
                'marker'          => 0,
                'uc'              => $get_type|$perform_type,
                'lc'              => $get_type|$perform_type,
                'ucw'             => 0,
                'normalize'       => $get_type|$perform_type,
                'flag_overrides'  => $get_type,
                'reverse'         => $get_type|$perform_type,
                'sort'            => $get_type|$perform_type,
                'uniq'            => $get_type|$perform_type,
                'multiple'        => $get_type|$doif_type|$get_combined_type,
                'starts_with'     => $get_type|$doif_type|$get_combined_type,
                'ends_with'       => $get_type|$doif_type|$get_combined_type,
                'contains'        => $get_type|$doif_type|$get_combined_type,
                'remove_from'     => $get_type|$perform_type|$doif_type|$perform_no_eval_type|$get_combined_type,
                'compares'        => $get_type|$doif_type|$get_combined_type,
                'vars_equal'      => $get_type|$perform_type,
                'duplicate_index' => $get_type|$doif_type|$get_combined_type,
                'transdir'        => $get_type|$doif_type,
                'has_extension'   => $get_type|$doif_type|$get_combined_type,
                'keyname_used'    => 0,
                'scope'           => 0,
                'full_path'       => $get_type|$perform_type,
                'extensions'      => $perform_type|$perform_no_eval_type,
                'create_aux_file' => $perform_type|$post_type,
                'end_aux_file'    => 0,
                'translate_vars'  => $get_type|$perform_type,
                'convert_slashes' => $perform_type,
                'new_guid'        => 0,
                'deref'           => 0,
                'set'             => 0,
               );

my %target_type_vars = ('type_is_static'   => 1,
                        'need_staticflags' => 1,
                        'type_is_dynamic'  => 1,
                        'type_is_binary'   => 1,
                       );

my %arrow_op_ref = ('custom_type'     => 'custom types',
                    'grouped_.*_file' => 'grouped files',
                    'feature'         => 'features',
                   );

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

sub new {
  my($class, $prjc) = @_;
  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->{'keyname_used'}         = {};
  $self->{'scopes'}               = {};
  $self->{'aux_file'}             = 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 tp_basename {
  my($self, $file) = @_;

  if ($self->{'cslashes'}) {
    $file =~ s/.*[\/\\]//;
  }
  else {
    $file =~ s/.*\///;
  }
  return $file;
}


sub validated_dirname {
  my($self, $file) = @_;
  my $index = rindex($file, ($self->{'cslashes'} ? '\\' : '/'));

  if ($index >= 0) {
    return $self->{'prjc'}->validated_directory(substr($file, 0, $index));
  }
  else {
    return '.';
  }
}


sub tp_dirname {
  my($self, $file) = @_;
  my $index = rindex($file, ($self->{'cslashes'} ? '\\' : '/'));

  if ($index >= 0) {
    return 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 $value = $_[1];
  my $scope = $_[0]->{'scopes'};
  while(defined $$scope{'scope'}) {
    $scope = $$scope{'scope'};
    if (defined $$scope{'escape'}) {
      if ($$scope{'escape'}->[1] < 0 && $_[0]->{'foreach'}->{'count'} >= 0) {
        ## This scope was created outside of a foreach.  If we are
        ## processing a foreach, we need to skip this at this point as it
        ## will be handled once the foreach has been completed and is
        ## appended to the main project body.
        last;
      }
      else {
        my $key = $$scope{'escape'}->[0];
        if ($key eq '\\') {
          $value =~ s/\\/\\\\/g;
        }
        else {
          $value =~ s/($key)/\\$1/g;
        }
      }
    }
    else {
      foreach my $key (keys %$scope) {
        $_[0]->warning("Unrecognized scope function: $key.");
      }
    }
  }

  my $foreach_count = $_[0]->{'foreach'}->{'count'};
  if ($_[0]->{'aux_file'}
      && $foreach_count == $_[0]->{'aux_file'}->{'foreach_baseline'}) {
    $_[0]->{'aux_file'}->{'text'} .= $value;
  }
  elsif ($foreach_count >= 0) {
    $_[0]->{'foreach'}->{'text'}->[$foreach_count] .= $value;
  }
  elsif ($_[0]->{'eval'}) {
    $_[0]->{'eval_str'} .= $value;
  }
  else {
    $_[0]->{'built'} .= $value;
  }
}


sub split_parameters {
  my($self, $str) = @_;
  my @params;

  while($str =~ /^(\w+\([^\)]+\))(.*)/ || $str =~ /^([^,]+)(.*)/) {
    push(@params, $1);
    $str = $2;
    $str =~ s/^\s*,\s*//;
  }

  ## Return the parameters (which includes whatever is left in the
  ## string).  Just return it instead of pushing it onto @params.
  return $str eq '' ? @params : (@params, $str);
}


sub set_current_values {
  my($self, $name) = @_;
  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);
        }
        $self->{'foreach'}->{'temp_scope'}->[$counter] = \%copy;
        $set = 1;
      }
      else {
        ## Since we're not creating a temporary scope for this level, we
        ## need to empty out the scope that may have been held here from
        ## a previous foreach.
        $self->{'foreach'}->{'temp_scope'}->[$counter] = {};
      }
    }
  }
  return $set;
}


sub get_value {
  my($self, $name) = @_;
  my $value;
  my $counter = $self->{'foreach'}->{'count'};
  my $fromprj;
  my $scope;
  my $sname;
  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],
                                                   [], $self);
        if (defined $$uvalue[0]) {
          $value = $uvalue;
          $adjust = 0;
          $fromprj = 1;
        }

        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, $self);
  }

  ## 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 = lc(shift);
  my $value = $self->get_value($name);

  if (!defined $value) {
    $value = $self->{'defaults'}->{$name};
    if (defined $value) {
      my $counter = $self->{'foreach'}->{'count'};
      my $sname;

      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, $self));

      ## 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).
      $value = $self->{'defaults'}->{$name} if (!defined $value);
    }
    else {
      #$self->warning("$name defaulting to empty string.");
      $value = '';
    }
  }

  return (UNIVERSAL::isa($value, 'ARRAY') ? "@$value" : $value);
}


sub process_foreach {
  my $self   = shift;
  my $index = $self->{'foreach'}->{'count'};
  my $text = $self->{'foreach'}->{'text'}->[$index];
  my @values;
  my $name = $self->{'foreach'}->{'name'}->[$index];
  my @cmds;
  my $val = $self->{'foreach'}->{'vars'}->[$index];
  my $check_for_mixed;

  if ($val =~ /^((\w+),\s*)?flag_overrides\((.*)\)$/) {
    ## If the user did not provide a name we have to pick one otherwise
    ## there would be no way to access the foreach values.
    $name = (defined $2 ? $2 : '__unnamed__');

    ## Now check to see if there were overrides for this value.  If there
    ## were, convert them into an array (if necessary) and continue
    ## processing.
    $val = $self->get_flag_overrides($3);
    if (defined $val) {
      $val = $self->create_array($val) if (!UNIVERSAL::isa($val, 'ARRAY'));
      @values = @$val;
    }
  }
  else {
    ## Pull out modifying commands first
    while($val =~ /(\w+)\((.+)\)/) {
      my $cmd = $1;
      $val = $2;
      if (($keywords{$cmd} & $perform_type) != 0) {
        push(@cmds, 'perform_' . $cmd);
        if (($keywords{$cmd} & $perform_no_eval_type) != 0) {
          my @params = $self->split_parameters($val);
          $val = \@params;
          last;
        }
      }
      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
    if (UNIVERSAL::isa($val, 'ARRAY')) {
      @values = @$val;
    }
    else {
      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$//;
        }
        ## We only want to check for the mixing of scalar and hash
        ## variables if the variable name is not a keyword (or the
        ## special 'features' template variable).
        if (!$check_for_mixed &&
            !$self->{'prjc'}->is_keyword($n) && $n ne 'features') {
          $check_for_mixed = 1;
        }
      }
    }
  }

  ## 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];
    my $base  = $self->{'foreach'}->{'base'}->[$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.
    if ($check_for_mixed) {
      my %mixed;
      my $mixed = 0;
      foreach my $mval (@values) {
        $mixed{$mval} = $self->set_current_values($mval);
        $mixed |= $mixed{$mval};
      }
      if ($mixed) {
        my @nvalues;
        foreach my $key (sort keys %mixed) {
          push(@nvalues, $key) if ($mixed{$key});
        }

        ## Set the new values only if they are different
        ## from the original (except for order).
        my @sorted = sort(@values);
        @values = @nvalues if (@sorted != @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 + $base;

      ## 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->get_value_with_default('platform') ne '') {
        $self->{'prjc'}->update_project_info($self, 1,
                                             ['configuration', 'platform'],
                                             '|');
      }

      ## Now parse the line of text, each time
      ## with different values
      ++$self->{'foreach'}->{'processing'};
      my($status, $error) = $self->parse_line(undef, $text);
      --$self->{'foreach'}->{'processing'};
      return $error if (defined $error);
    }
  }

  return undef;
}


sub generic_handle {
  my($self, $func, $str) = @_;

  if (defined $str) {
    my $val = $self->$func([$str]);

    if (defined $val) {
      $self->append_current($val);
    }
    else {
      $self->append_current(0);
    }
  }
}


sub handle_endif {
  my($self, $name) = @_;
  my $end = pop(@{$self->{'sstack'}});
  pop(@{$self->{'lstack'}});

  if (!defined $end) {
    return "Unmatched $name";
  }
  else {
    my $in = index($end, $name);
    if ($in == 0) {
      $self->{'if_skip'} = 0;
    }
    elsif ($in == -1) {
      return "Unmatched $name";
    }
  }

  return undef;
}


sub handle_endfor {
  my($self, $name) = @_;
  my $end = pop(@{$self->{'sstack'}});
  pop(@{$self->{'lstack'}});

  if (!defined $end) {
    return "Unmatched $name";
  }
  else {
    my $in = index($end, $name);
    if ($in == 0) {
      my $index = $self->{'foreach'}->{'count'};
      my $error = $self->process_foreach();
      if (!defined $error) {
        --$self->{'foreach'}->{'count'};
        $self->append_current($self->{'foreach'}->{'text'}->[$index]);
      }
      return $error;
    }
    elsif ($in == -1) {
      return "Unmatched $name";
    }
  }

  return undef;
}


sub get_flag_overrides {
  my($self, $name) = @_;
  my $type;

  ## Split the name and type parameters
  ($name, $type) = split(/,\s*/, $name);

  my $file = $self->get_value($name);
  if (defined $file) {
    ## Save the name prefix (if there is one) for
    ## command parameter conversion at the end
    my $pre;
    if ($name =~ /^(\w+)->/) {
      $pre = $1;

      ## Replace the custom_type key with the actual custom type
      if ($pre eq 'custom_type') {
        my $ct = $self->get_value($pre);
        $name = $ct if (defined $ct);
      }
      elsif ($pre =~ /^grouped_(.*_file)$/) {
        $name = $1;
      }
    }

    my $fo  = $self->{'prjc'}->{'flag_overrides'};
    my $key = (defined $$fo{$name . 's'} ? $name . 's' :
                       (defined $$fo{$name} ? $name : undef));

    if (defined $key) {
      ## Convert the file name into a unix style file name
      my $ustyle = $file;
      $ustyle =~ s/\\/\//g if ($self->{'cslashes'});

      ## 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) {
        my $prjc = $self->{'prjc'};
        foreach my $aname (@{$prjc->{'matching_assignments'}->{$key}}) {
          if ($aname eq $type && defined $$fo{$key}->{$of}->{$aname}) {
            my $value = $$fo{$key}->{$of}->{$aname};

            ## 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 && $prjc->requires_parameters($type)) {
              $value = $prjc->convert_command_parameters(
                                      $key, $value,
                                      $self->prepare_parameters($pre));
            }

            return $prjc->relative($value);
          }
        }
      }
    }
  }

  return undef;
}


sub get_multiple {
  my($self, $name) = @_;
  return $self->doif_multiple(
                  $self->create_array($self->get_value_with_default($name)));
}


sub doif_multiple {
  my($self, $value) = @_;
  return defined $value ? (scalar(@$value) > 1) : undef;
}


sub handle_multiple {
  my($self, $name) = @_;
  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, $str) = @_;
  return $self->doif_starts_with([$str]);
}


sub doif_starts_with {
  my($self, $val) = @_;

  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, $str) = @_;
  $self->generic_handle('doif_starts_with', $str);
}


sub get_ends_with {
  my($self, $str) = @_;
  return $self->doif_ends_with([$str]);
}


sub doif_ends_with {
  my($self, $val) = @_;

  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, $str) = @_;
  $self->generic_handle('doif_ends_with', $str);
}


sub handle_keyname_used {
  my($self, $str) = @_;

  if (defined $str) {
    my($name, $key) = $self->split_parameters($str);
    my $file = $self->get_value_with_default($name);
    if (defined $self->{'keyname_used'}->{$file}->{$key}) {
      $self->append_current($self->{'keyname_used'}->{$file}->{$key}++);
    }
    else {
      $self->{'keyname_used'}->{$file}->{$key} = 1;
    }
  }
}


sub handle_scope {
  my($self, $str) = @_;

  if (defined $str) {
    my($state, $func, $param) = $self->split_parameters($str);
    if (defined $state) {
      my $pscope;
      my $scope = $self->{'scopes'};

      while(defined $$scope{'scope'}) {
        $pscope = $scope;
        $scope = $$scope{'scope'};
      }
      if ($state eq 'enter') {
        if (defined $func) {
          $param = '' if (!defined $param);
          $$scope{'scope'}->{$func} = [$self->process_special($param),
                                       $_[0]->{'foreach'}->{'count'}];
        }
        else {
          $self->warning("The enter scope function requires a parameter.");
        }
      }
      elsif ($state eq 'leave') {
        if (defined $pscope) {
          delete $$pscope{'scope'};
        }
        else {
          $self->warning("leave scope function encountered without an enter.");
        }
      }
      else {
        $self->warning("Unrecognized scope function parameter: $state.");
      }
    }
    else {
      $self->warning("The scope function requires 1 to 3 parameters.");
    }
  }
}

sub get_has_extension {
  my($self, $str) = @_;
  return $self->doif_has_extension([$str]);
}


sub doif_has_extension {
  my($self, $val) = @_;

  if (defined $val) {
    return ($self->tp_basename(
                $self->get_value_with_default("@$val")) =~ /\.[^\.]*$/);
  }
  return undef;
}


sub handle_has_extension {
  my($self, $str) = @_;
  $self->generic_handle('doif_has_extension', $str);
}


sub get_contains {
  my($self, $str) = @_;
  return $self->doif_contains([$str]);
}


sub doif_contains {
  my($self, $val) = @_;

  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, $str) = @_;
  $self->generic_handle('doif_contains', $str);
}


sub get_remove_from {
  my($self, $str) = @_;
  return $self->doif_remove_from($str);
}


sub doif_remove_from {
  my($self, $str) = @_;
  my @params = $self->split_parameters($str);
  my @removed = $self->perform_remove_from(\@params);
  return (defined $removed[0] ? 1 : undef);
}


sub perform_remove_from {
  my($self, $val) = @_;
  my($source, $pattern, $target, $tremove) = @$val;

  ## $source should be a component name (e.g., source_files,
  ## header_files, etc.)  $target is a variable name
  ## $pattern and $tremove are optional; $pattern is a partial regular
  ## expression to match the end of the files found from $source.  The
  ## beginning of the regular expression is made from $target by removing
  ## $tremove from the end of it.
  if (defined $source && defined $target &&
      defined $self->{'values'}->{$source}) {
    my $tval = $self->get_value_with_default($target);
    if (defined $tval) {
      $tval =~ s/$tremove$// if (defined $tremove);
      $tval = $self->escape_regex_special($tval);
      my @removed;
      my $max = scalar(@{$self->{'values'}->{$source}});
      for(my $i = 0; $i < $max;) {
        if ($self->{'values'}->{$source}->[$i] =~ /^$tval$pattern$/) {
          push(@removed, splice(@{$self->{'values'}->{$source}}, $i, 1));
          $max--;
        }
        else {
          $i++;
        }
      }
      return @removed;
    }
  }

  return ();
}


sub handle_remove_from {
  my($self, $str) = @_;

  if (defined $str) {
    my @params = $self->split_parameters($str);
    my $val = $self->perform_remove_from(\@params);
    $self->append_current("@$val") if (defined $val);
  }
}


sub get_compares {
  my($self, $str) = @_;
  return $self->doif_compares([$str]);
}


sub doif_compares {
  my($self, $val) = @_;

  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, $str) = @_;
  $self->generic_handle('doif_compares', $str);
}

sub get_vars_equal {
  my($self, $str) = @_;
  return $self->doif_vars_equal([$str]);
}


sub doif_vars_equal {
  my($self, $val) = @_;

  if (defined $val) {
    my($var1, $var2) = $self->split_parameters("@$val");
    if (defined $var1 && defined $var2) {
      return ($self->get_value_with_default($var1) eq $self->get_value_with_default($var2));
    }
  }
  return undef;
}


sub handle_vars_equal {
  my($self, $str) = @_;
  $self->generic_handle('doif_vars_equal', $str);
}


sub get_reverse {
  my($self, $name) = @_;
  my $value = $self->get_value_with_default($name);

  if (defined $value) {
    my @array = $self->perform_reverse($self->create_array($value));
    return \@array;
  }

  return undef;
}


sub perform_reverse {
  my($self, $value) = @_;
  return reverse(@$value);
}


sub handle_reverse {
  my($self, $name) = @_;
  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 get_sort {
  my($self, $name) = @_;
  my $value = $self->get_value_with_default($name);

  if (defined $value) {
    my @array = $self->perform_sort($self->create_array($value));
    return \@array;
  }

  return undef;
}


sub perform_sort {
  my($self, $value) = @_;
  return sort(@$value);
}


sub handle_sort {
  my($self, $name) = @_;
  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, $name) = @_;
  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, $value) = @_;
  my %value;
  @value{@$value} = ();
  return sort(keys %value);
}


sub handle_uniq {
  my($self, $name) = @_;
  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, $str) = @_;

  if (index($str, '||') >= 0) {
    my $ret = 0;
    foreach my $v (split(/\s*\|\|\s*/, $str)) {
      $ret |= $self->process_compound_if($v);
      return 1 if ($ret != 0);
    }
    return 0;
  }
  elsif (index($str, '&&') >= 0) {
    my $ret = 1;
    foreach my $v (split(/\s*\&\&\s*/, $str)) {
      $ret &&= $self->process_compound_if($v);
      return 0 if ($ret == 0);
    }
    return 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;
    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 = $get_type;
      my $prefix = 'get_';

      $val = $str;

      ## If there is only one command, we have to add it to the list
      ## again so that we can get the variable value and then use
      ## the doif_ version to test it, unless the get_ function
      ## also performs the doif_ functionality.
      if ($#cmds == 0 && defined $keywords{$cmds[0]} &&
          ($keywords{$cmds[0]} & $doif_type) != 0 &&
          ($keywords{$cmds[0]} & $get_combined_type) == 0) {
        push(@cmds, $cmds[0]);
      }

      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 = $doif_type;
          $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);
  }
}


sub handle_if {
  my($self, $val) = @_;
  my $name = 'endif';

  push(@{$self->{'lstack'}},
       "<%if($val)%> (" . $self->get_line_number() . '?)');
  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'}};
  my $index = index($scopy[$#scopy], 'endif');
  if ($index >= 0) {
    if ($index == 0) {
      $self->{'if_skip'} ^= 1;
    }
    $self->{'sstack'}->[$#scopy] .= ':';
  }

  return 'Unmatched else' if (($self->{'sstack'}->[$#scopy] =~ tr/:/:/) > 1);
  return undef;
}


sub handle_foreach {
  my $self        = shift;
  my $val = lc(shift);
  my $name = 'endfor';
  my $errorString;

  push(@{$self->{'lstack'}}, $self->get_line_number());
  if (!$self->{'if_skip'}) {
    my $base = 1;
    my $vname;
    if ($val =~ /flag_overrides\([^\)]+\)/) {
    }
    elsif ($val =~ /([^,]*),(.*)/) {
      $vname = $1;
      $val   = $2;
      $vname =~ s/^\s+//;
      $vname =~ s/\s+$//;
      $val   =~ s/^\s+//;
      $val   =~ s/\s+$//;

      if ($vname eq '') {
        $errorString = 'The foreach variable name is not valid';
      }

      if ($val =~ /([^,]*),(.*)/) {
        $base = $1;
        $val  = $2;
        $base =~ s/^\s+//;
        $base =~ s/\s+$//;
        $val  =~ s/^\s+//;
        $val  =~ s/\s+$//;

        if ($base !~ /^\d+$/) {
          $errorString = 'The forcount specified is not a valid number';
        }
      }
      elsif ($vname =~ /^\d+$/) {
        $base  = $vname;
        $vname = undef;
      }

      ## Due to the way flag_overrides works, we can't allow
      ## the user to name the foreach variable when dealing
      ## with variables that can be used with the -> operator
      if (defined $vname) {
        foreach my $ref (keys %arrow_op_ref) {
          my $name_re  = $ref . 's';
          if ($val =~ /^$ref\->/ || $val =~ /^$name_re$/) {
            $errorString = 'The foreach variable can not be ' .
                           'named when dealing with ' .
                           $arrow_op_ref{$ref};
          }
        }
      }
    }

    push(@{$self->{'sstack'}}, $name);
    my $index = ++$self->{'foreach'}->{'count'};

    $self->{'foreach'}->{'base'}->[$index]  = $base;
    $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 $errorString;
}


sub handle_special {
  my($self, $name, $val) = @_;

  ## If $name (fornotlast, forfirst, etc.) is set to 1
  ## Then we append the $val onto the current string that's
  ## being built.
  $self->append_current($val) if ($self->get_value($name));
}


sub get_uc {
  my($self, $name) = @_;
  return uc($self->get_value_with_default($name));
}


sub handle_uc {
  my($self, $name) = @_;
  $self->append_current($self->get_uc($name));
}


sub perform_uc {
  my($self, $value) = @_;
  my @val;
  foreach my $val (@$value) {
    push(@val, uc($val));
  }
  return @val;
}


sub get_lc {
  my($self, $name) = @_;
  return lc($self->get_value_with_default($name));
}


sub handle_lc {
  my($self, $name) = @_;
  $self->append_current($self->get_lc($name));
}


sub perform_lc {
  my($self, $value) = @_;
  my @val;
  foreach my $val (@$value) {
    push(@val, lc($val));
  }
  return @val;
}


sub handle_ucw {
  my($self, $name) = @_;
  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 actual_normalize {
  $_[1] =~ tr/ \t\/\\\-$()./_/;
  return $_[1];
}

sub perform_normalize {
  my($self, $value) = @_;
  my @val;
  foreach my $val (@$value) {
    push(@val, $self->actual_normalize($val));
  }
  return @val;
}


sub get_normalize {
  my($self, $name) = @_;
  return $self->actual_normalize($self->get_value_with_default($name));
}


sub handle_normalize {
  my($self, $name) = @_;
  $self->append_current($self->get_normalize($name));
}


sub actual_noextension {
  $_[1] =~ s/\.[^\.]*$//;
  return $_[1];
}


sub perform_noextension {
  my($self, $value) = @_;
  my @val;
  foreach my $val (@$value) {
    push(@val, $self->actual_noextension($val));
  }
  return @val;
}


sub get_noextension {
  my($self, $name) = @_;
  return $self->actual_noextension($self->get_value_with_default($name));
}

sub handle_noextension {
  my($self, $name) = @_;
  $self->append_current($self->get_noextension($name));
}


sub perform_full_path {
  my($self, $value) = @_;
  my @val;
  foreach my $val (@$value) {
    push(@val, $self->actual_full_path($val));
  }
  return @val;
}


sub get_full_path {
  my($self, $name) = @_;
  return $self->actual_full_path($self->get_value_with_default($name));
}


sub actual_full_path {
  my($self, $value) = @_;

  ## Expand all defined env vars
  $value =~ s/\$\((\w+)\)/$ENV{$1} || '$(' . $1 . ')'/ge;

  ## If we expanded all env vars, get absolute path
  if ($value =~ /\$\(\w+\)/) {
    $self->{'error_in_handle'} = "<%full_path%> couldn't expand " .
                                 "environment variables in $value";
    return $value;
  }

  ## Always convert the slashes since they may be in the OS native
  ## format and we need them in UNIX format.
  $value =~ s/\\/\//g;
  my $dir = $self->mpc_dirname($value);
  if (-e $dir) {
    $dir = Cwd::abs_path($dir);
  }
  elsif ($self->{'prjc'}->path_is_relative($dir)) {
    ## If the directory is is not already an absolute path, then we will
    ## assume that the directory is relative to the current directory
    ## (which will be the location of the MPC file).
    $dir = $self->getcwd() . '/' . $dir;
  }

  ## Create the full path value and convert the slashes if necessary.
  $value = $dir . '/' . $self->mpc_basename($value);
  $value =~ s/\//\\/g if ($self->{'cslashes'});
  return $value;
}


sub handle_full_path {
  my($self, $name) = @_;
  my $val = $self->get_value_with_default($name);

  $self->append_current($self->actual_full_path($val));
}


sub perform_extensions {
  my($self, $value) = @_;
  my @val;
  foreach my $val (@$value) {
    push(@val, $self->{'prjc'}->get_component_extensions($val));
  }
  return @val;
}


sub handle_extensions {
  my($self, $name) = @_;
  my @val = $self->perform_extensions([$name]);
  $self->append_current("@val");
}


sub evaluate_nested_functions {
  my($self, $funcname, $args) = @_;
  my @params = $self->split_parameters($args);
  my @results;
  foreach my $param (@params) {
    my @cmds;
    my $val = $param;

    while($val =~ /(\w+)\((.+)\)/) {
      push(@cmds, $1);
      $val = $2;
    }

    if (scalar @cmds == 0) {
      push @results, $val;
      next;
    }

    my $type = $get_type;
    my $prefix = 'get_';
    foreach my $cmd (reverse @cmds) {
      if (defined $keywords{$cmd} && ($keywords{$cmd} & $type) != 0) {
        my $func = "$prefix$cmd";
        if ($type == $get_type) {
          $val = $self->$func($val);
          $val = [ $val ] if (!UNIVERSAL::isa($val, 'ARRAY'));
          ## Now that we have a value, we need to switch over
          ## to calling perform_xxx
          $type = $perform_type;
          $prefix = 'perform_';
        }
        else {
          my @array = $self->$func($val);
          $val = \@array;
        }
      }
      else {
        $self->warning("Unable to use $cmd in nested " .
                       "functions (no $prefix method).");
      }
    }
    push @results, "@$val";
  }

  if (defined $keywords{$funcname} && ($keywords{$funcname} & $perform_type)) {
    my $func = 'perform_' . $funcname;
    my @array = $self->$func(\@results);
    $self->append_current("@array");
    if ($keywords{$funcname} & $post_type) {
      $func = 'post_' . $funcname;
      $self->$func();
    }
  }
  else {
    $self->warning("Unable to use $funcname in nested " .
                   "functions (no perform_ method).");
  }
}


sub perform_dirname {
  my($self, $value) = @_;
  my @val;
  foreach my $val (@$value) {
    push(@val, $self->tp_dirname($val));
  }
  return @val;
}


sub get_dirname {
  my($self, $name) = @_;
  return $self->tp_dirname($self->get_value_with_default($name));
}


sub doif_dirname {
  my($self, $value) = @_;

  if (defined $value) {
    $value = $self->tp_dirname($value);
    return ($value ne '.');
  }
  return undef;
}


sub handle_dirname {
  my($self, $name) = @_;

  $self->append_current(
            $self->tp_dirname($self->get_value_with_default($name)));
}


sub perform_basename {
  my($self, $value) = @_;
  my @val;
  foreach my $val (@$value) {
    push(@val, $self->tp_basename($val));
  }
  return @val;
}


sub get_basename {
  my($self, $name) = @_;
  return $self->tp_basename($self->get_value_with_default($name));
}


sub doif_basename {
  my($self, $value) = @_;

  if (defined $value) {
    $value = $self->tp_basename($value);
    return ($value ne '.');
  }
  return undef;
}


sub handle_basename {
  my($self, $name) = @_;

  $self->append_current(
            $self->tp_basename($self->get_value_with_default($name)));
}


sub handle_basenoextension {
  my($self, $name) = @_;
  my $val = $self->tp_basename($self->get_value_with_default($name));

  $val =~ s/\.[^\.]*$//;
  $self->append_current($val);
}


sub handle_flag_overrides {
  my($self, $name) = @_;
  my $value = $self->get_flag_overrides($name);
  $self->append_current(UNIVERSAL::isa($value, 'ARRAY') ?
                          "@$value" : $value) if (defined $value);
}


sub handle_marker {
  my($self, $name) = @_;
  my $val = $self->{'prjc'}->get_verbatim($name);
  $self->append_current($val) if (defined $val);
}


sub handle_eval {
  my($self, $name) = @_;
  my $val = $self->get_value_with_default($name);

  if (defined $val) {
    if (index($val, "<%eval($name)%>") >= 0) {
      $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, $name) = @_;
  $self->append_current($self->{'cmds'}->{$name});
}


sub get_duplicate_index {
  my($self, $name) = @_;
  return $self->doif_duplicate_index($self->get_value_with_default($name));
}


sub doif_duplicate_index {
  my($self, $value) = @_;

  if (defined $value) {
    my $base = lc($self->tp_basename($value));
    my $path = $self->validated_dirname($value);

    if (!defined $self->{'dupfiles'}->{$base}) {
      $self->{'dupfiles'}->{$base} = [$path];
    }
    else {
      my $index = 1;
      foreach my $file (@{$self->{'dupfiles'}->{$base}}) {
        return $index if ($file eq $path);
        ++$index;
      }

      push(@{$self->{'dupfiles'}->{$base}}, $path);
      return 1;
    }
  }

  return undef;
}


sub handle_duplicate_index {
  my($self, $name) = @_;
  my $value = $self->doif_duplicate_index(
                       $self->get_value_with_default($name));
  $self->append_current($value) if (defined $value);
}

sub actual_transdir {
 my($self, $value) = @_;

  if ($value =~ /([\/\\])/) {
    return $self->{'prjc'}->translate_directory(
                                  $self->tp_dirname($value)) . $1;
  }

  return undef;
}

sub get_transdir {
  my($self, $name) = @_;
  return $self->actual_transdir($self->get_value_with_default($name));
}


sub doif_transdir {
  my($self, $value) = @_;

  return (defined $value ? $self->actual_transdir($value) : undef);
}


sub handle_transdir {
  my($self, $name) = @_;
  my $value = $self->actual_transdir($self->get_value_with_default($name));
  $self->append_current($value) if (defined $value);
}


sub handle_create_aux_file {
  my $self = shift;
  my @fname = $self->perform_create_aux_file([$self->split_parameters(shift)]);
  $self->append_current($fname[0]);
  $self->post_create_aux_file();
}


sub post_create_aux_file {
  my $self = shift;
  $self->{'aux_file'} = $self->{'aux_temp'};
  $self->{'aux_temp'} = undef;
}


sub perform_create_aux_file {
  my($self, $argsref) = @_;

  if (defined $self->{'aux_file'}) {
    $self->{'error_in_handle'} = "Can't nest create_aux_file commands.";
    return undef;
  }

  my $fname = '';
  foreach my $arg (@$argsref) {
    my $val = $self->get_value($arg);
    $fname .= defined $val ?
        (UNIVERSAL::isa($val, 'ARRAY') ? join('_', @$val) : $val) : $arg;
  }

  my $dir = $self->mpc_dirname($self->{'prjc'}->get_outdir() . '/' .
                               $self->{'prjc'}->{'assign'}->{'project_file'});
  $dir .= '/' . $self->mpc_dirname($fname) if ($fname =~ /[\/\\]/);

  $self->{'aux_temp'} = {'dir' => $dir,
                         'filename' => $self->mpc_basename($fname),
                         'foreach_baseline' => $self->{'foreach'}->{'count'}};
  return $fname;
}


sub handle_end_aux_file {
  my $self = shift;
  if (!defined $self->{'aux_file'}) {
    $self->{'error_in_handle'} = 'end_aux_file seen before create_aux_file';
  }
  else {
    my $af = $self->{'aux_file'};
    mkpath($af->{'dir'}, 0, 0777) if ($af->{'dir'} ne '.');
    my $fh = new FileHandle('> ' . $af->{'dir'} . '/' . $af->{'filename'});
    if (defined $fh) {
      print $fh $af->{'text'};
      close($fh);
    }
    else {
      $self->{'error_in_handle'} = "Couldn't open: " . $af->{'dir'} . '/' .
                                   $af->{'filename'};
    }
    $self->{'aux_file'} = undef;
  }
}


sub handle_translate_vars {
  my($self, $arg) = @_;
  my @params = $self->split_parameters($arg);
  $self->append_current($self->perform_translate_vars([@params]));
}

sub get_translate_vars {
  my ($self, $str) = @_;
  my @params = $self->split_parameters($str);
  return $self->perform_translate_vars([@params]);
}

sub perform_translate_vars {
  my($self, $arg) = @_;

  ## If the first parameter is a template variable with a value, use it.
  ## Otherwise, use the parameter as the value.
  my $val = $self->get_value($arg->[0]);
  $val = $arg->[0] unless defined $val;

  ## If the second optional parameter is provided, use it.  Otherwise,
  ## use the operating system found in the command substitution map.
  my $os = (defined $arg->[1] && $arg->[1] ne '') ?
           $arg->[1] : $self->{'prjc'}->{'command_subs'}->{'os'};

  ## Get the variable reference characters based on the operating system
  ## for which we are generating this project.
  my ($pre, $post) = ($os eq 'win32') ? ('%', '%') : ('${', '}');

  ## Replace $() with the environment variable reference characters.
  $val =~ s{\$\(([^)]+)\)([^\s\$]*)}{my ($var, $rest) = ($1, $2);
                                     $rest =~ s!/!\\!g if $os eq 'win32';
                                     "$pre$var$post$rest"}ge;
  return $val;
}


sub handle_convert_slashes {
  my($self, $arg) = @_;
  my @params = $self->split_parameters($arg);
  $self->append_current($self->perform_convert_slashes([@params]));
}


sub perform_convert_slashes {
  my($self, $arg) = @_;

  ## If the first parameter is a template variable with a value, use it.
  ## Otherwise, use the parameter as the value.
  my $val = $self->get_value($arg->[0]);
  $val = $arg->[0] unless defined $val;

  ## If the second optional parameter is provided, use it.  Otherwise,
  ## use the operating system found in the command substitution map.
  my $os = (defined $arg->[1] && $arg->[1] ne '') ?
           $arg->[1] : $self->{'prjc'}->{'command_subs'}->{'os'};

  ## Replace forward slashes with backslashes if we're generating this
  ## project specific to Windows.
  $val =~ s!/!\\!g if $os eq 'win32';

  return $val;
}


sub handle_new_guid {
  my($self, $name) = @_;
  my $val = $self->get_value_with_default($name);
  my $prjc = $self->{'prjc'};
  my $guid = GUID::generate($val ? $val : $name,
                            $prjc->{'current_input'},
                            File::Spec->abs2rel($prjc->getcwd(),
                                                $prjc->getstartdir()));
  $self->append_current($guid);
}


sub handle_deref {
  my($self, $name) = @_;
  my $val = $self->get_value_with_default($self->get_value_with_default($name));
  $self->append_current($val);
}


sub handle_set {
  my($self, $val) = @_;
  my @params = $self->split_parameters($val);
  if ($#params == 1) {
    $self->{'values'}->{lc($params[0])} = $params[1];
  }
  else {
    $self->{'error_in_handle'} = 'set() requires a name and a value';
  }
}

sub prepare_parameters {
  my($self, $prefix) = @_;
  my $input = $self->get_value($prefix . '->input_file');
  my $output;

  if (defined $input) {
    $input =~ s/\//\\/g if ($self->{'cslashes'});
    $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 eq '.' ? '' : $fo . '/') .
                         $self->tp_basename($$output[$i]);
        }
        $$output[$i] =~ s/\//\\/g if ($self->{'cslashes'});
      }
    }
  }

  ## Set the parameters array with the determined input and output files
  return $input, $output;
}


sub process_name {
  my($self, $line) = @_;
  my $length = 0;
  my $errorString;

  ## Split the line into a name and value
  if ($line =~ /([^%\(]+)(\(([^%]+)\))?%>/) {
    my $name = lc($1);
    my $val  = $3;
    $length += length($name);

    if (defined $val) {
      ## Check for the parenthesis
      if (($val =~ tr/(//) != ($val =~ tr/)//)) {
        return 'Missing the closing parenthesis', $length;
      }

      ## Add the length of the value plus 2 for the surrounding ()
      $length += length($val) + 2;
    }

    if (defined $keywords{$name}) {
      if ($name eq 'if') {
        $self->handle_if($val);
      }
      elsif ($name eq 'endif') {
        $errorString = $self->handle_endif($name);
      }
      elsif ($name eq 'else') {
        $errorString = $self->handle_else();
      }
      elsif ($name eq 'endfor') {
        $errorString = $self->handle_endfor($name);
      }
      elsif ($name eq 'foreach') {
        $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 'comment') {
        ## Ignore the contents of the comment
      }
      else {
        if (!$self->{'if_skip'}) {
          if (index($val, '(') >= 0) {
            $self->evaluate_nested_functions($name, $val);
          }
          else {
            my $func = 'handle_' . $name;
            $self->$func($val);
            if ($self->{'error_in_handle'}) {
              $errorString = $self->{'error_in_handle'};
            }
          }
        }
      }
    }
    elsif (defined $self->{'cmds'}->{$name}) {
      $self->handle_pseudo($name) if (!$self->{'if_skip'});
    }
    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;
      }
    }
    $errorString = "Unable to parse line starting at '$error'";
  }

  return $errorString, $length;
}


sub collect_data {
  my $self  = shift;
  my $prjc = $self->{'prjc'};
  my $cwd = $self->getcwd();

  ## Set the current working directory
  $cwd =~ s/\//\\/g if ($self->{'cslashes'});
  $self->{'values'}->{'cwd'} = $cwd;

  ## Collect the components into {'values'} somehow
  foreach my $key (keys %{$prjc->{'valid_components'}}) {
    my @list = $prjc->get_component_list($key);
    $self->{'values'}->{$key} = \@list if (defined $list[0]);
  }

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

  ## In order for VC7 to mix languages, we need to keep track
  ## of the language associated with each project.
  $prjc->update_project_info($self, 1, ['language']);

  ## For VC7+ to properly work with wince, which is cross compiled,
  ## a new platform-specific token is added, nocross, which is used
  ## to determine if a project is even to be built for non-native
  ## targets. Additionally, custom-only projects are built but not
  ## deployed, thus these are added to the project_info mix
  $prjc->update_project_info($self, 1, ['custom_only']);
  $prjc->update_project_info($self, 1, ['nocross']);

  ## For VC8 to be able to add references to managed DLL's to the current
  ## managed DLL project (if it is one), we need to keep track of whether
  ## the project is 'managed' or not.
  $prjc->update_project_info($self, 1, ['managed']);

  ## For WiX, only generate top-level groups for projects marked with "make_group"
  $prjc->update_project_info($self, 1, ['make_group']);

  ## 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, $ih, $line) = @_;
  my $errorString;
  my $startempty = ($line eq '');

  ## 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->{'foreach'}->{'processing'} == 0 && !$self->{'eval'} &&
      ($line !~ /^[ ]*<%(\w+)(?:\((?:(?:\w+\s*,\s*)*[!]?\w+\(.+\)|[^\)]+)\))?%>$/ ||
       !defined $keywords{$1})) {
    $line .= $self->{'crlf'};
  }

  if ($self->{'foreach'}->{'count'} < 0 && !$self->{'eval'}) {
    $self->{'built'} = '';
  }

  my $start = index($line, '<%');
  if ($start >= 0) {
    my $append_name;
    if ($start > 0) {
      if (!$self->{'if_skip'}) {
        $self->append_current(substr($line, 0, $start));
      }
      $line = substr($line, $start);
    }

    my $nlen = 0;
    foreach my $item (split('<%', $line)) {
      my $name   = 1;
      my $length = length($item);
      my $endi   = index($item, '%>');
      for(my $i = 0; $i < $length; ++$i) {
        if ($i == $endi) {
          ++$i;
          $endi = index($item, '%>', $i);
          $name = undef;
          if ($append_name) {
            $append_name = undef;
            if (!$self->{'if_skip'}) {
              $self->append_current('%>');
            }
          }
          if ($length != $i + 1) {
            if (!$self->{'if_skip'}) {
              $self->append_current(substr($item, $i + 1));
            }
            last;
          }
        }
        elsif ($name) {
          my $efcheck = (index($item, 'endfor%>') == 0);
          my $focheck = ($efcheck ? 0 : (index($item, 'foreach(') == 0));

          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'})) {
            ($errorString, $nlen) = $self->process_name($item);

            if (defined $errorString) {
              return 0, $errorString;
            }
            elsif ($nlen == 0) {
              return 0, "Could not parse this line at column $i";
            }

            $i += ($nlen - 1);
          }
          else  {
            $name = undef;
            $nlen = ($i < $endi ? $endi : $length) - $i;
            if (!$self->{'if_skip'}) {
              $self->append_current('<%' . substr($item, $i, $nlen));
              $append_name = 1;
            }
            $i += ($nlen - 1);
          }

          if ($efcheck && $self->{'foreach'}->{'nested'} > 0) {
            --$self->{'foreach'}->{'nested'};
          }
        }
        else {
          $nlen = ($i < $endi ? $endi : $length) - $i;
          if (!$self->{'if_skip'}) {
            $self->append_current(substr($item, $i, $nlen));
          }
          $i += ($nlen - 1);
        }
      }
    }
  }
  else {
    $self->append_current($line) if (!$self->{'if_skip'});
  }

  if ($self->{'foreach'}->{'count'} < 0 && !$self->{'eval'} &&
    ## If the line started out empty and we're not
    ## skipping from the start or the built up line is not empty
      ($startempty ||
        ($self->{'built'} ne $self->{'crlf'} && $self->{'built'} ne ''))) {
    push(@{$self->{'lines'}}, $self->{'built'});
  }

  return !defined $errorString, $errorString;
}


sub parse_file {
  my($self, $input) = @_;

  $self->collect_data();
  my($status, $errorString) = $self->cached_file_read($input);

  ## If there was no error, check the stack to make sure that we aren't
  ## missing an <%endif%> or an <%endfor%>.
  if ($status && defined $self->{'sstack'}->[0]) {
    $status = 0;
    $errorString = "Missing an '$self->{'sstack'}->[0]' starting at " .
                   $self->{'lstack'}->[0];
  }

  ## Add in the line number if there is an error
  $errorString = "$input: line " .
                 $self->get_line_number() . ":\n$errorString" if (!$status);

  return $status, $errorString;
}


sub get_lines {
  return $_[0]->{'lines'};
}


# ************************************************************
# Accessors used by support scripts
# ************************************************************

sub getKeywords {
  return \%keywords;
}


sub getArrowOp {
  return \%arrow_op_ref;
}


1;