<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">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 vars qw(@ISA);
@ISA = qw(Parser);

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

my(%keywords) = ('if'              =&gt; 1,
                 'else'            =&gt; 1,
                 'endif'           =&gt; 1,
                 'noextension'     =&gt; 1,
                 'dirname'         =&gt; 1,
                 'basename'        =&gt; 1,
                 'basenoextension' =&gt; 1,
                 'foreach'         =&gt; 1,
                 'forfirst'        =&gt; 1,
                 'fornotfirst'     =&gt; 1,
                 'fornotlast'      =&gt; 1,
                 'forlast'         =&gt; 1,
                 'endfor'          =&gt; 1,
                 'comment'         =&gt; 1,
                 'flag_overrides'  =&gt; 1,
                 'marker'          =&gt; 1,
                 'uc'              =&gt; 1,
                 'lc'              =&gt; 1,
                 'ucw'             =&gt; 1,
                 'normalize'       =&gt; 1,
                );

my(%filecache) = ();

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

sub new {
  my($class) = shift;
  my($prjc)  = shift;
  my($self)  = $class-&gt;SUPER::new();

  $self-&gt;{'prjc'}       = $prjc;
  $self-&gt;{'ti'}         = $prjc-&gt;get_template_input();
  $self-&gt;{'cslashes'}   = $prjc-&gt;convert_slashes();
  $self-&gt;{'crlf'}       = $prjc-&gt;crlf();
  $self-&gt;{'clen'}       = length($self-&gt;{'crlf'});
  $self-&gt;{'values'}     = {};
  $self-&gt;{'defaults'}   = {};
  $self-&gt;{'lines'}      = [];
  $self-&gt;{'built'}      = '';
  $self-&gt;{'sstack'}     = [];
  $self-&gt;{'lstack'}     = [];
  $self-&gt;{'if_skip'}    = 0;
  $self-&gt;{'parameters'} = [];

  $self-&gt;{'foreach'}  = {};
  $self-&gt;{'foreach'}-&gt;{'count'}      = -1;
  $self-&gt;{'foreach'}-&gt;{'nested'}     = 0;
  $self-&gt;{'foreach'}-&gt;{'name'}       = [];
  $self-&gt;{'foreach'}-&gt;{'names'}      = [];
  $self-&gt;{'foreach'}-&gt;{'text'}       = [];
  $self-&gt;{'foreach'}-&gt;{'scope'}      = [];
  $self-&gt;{'foreach'}-&gt;{'temp_scope'} = [];
  $self-&gt;{'foreach'}-&gt;{'processing'} = 0;

  return $self;
}


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

  if ($file =~ s/.*[\/\\]//) {
    $self-&gt;{'values'}-&gt;{'basename_found'} = 1;
  }
  else {
    delete $self-&gt;{'values'}-&gt;{'basename_found'};
  }
  return $file;
}


sub dirname {
  my($self) = shift;
  my($file) = shift;
  for(my $i = length($file) - 1; $i != 0; --$i) {
    my($ch) = substr($file, $i, 1);
    if ($ch eq '/' || $ch eq '\\') {
      ## The template file may use this value (&lt;%dirname_found%&gt;)
      ## to determine whether a dirname removed the basename or not
      $self-&gt;{'values'}-&gt;{'dirname_found'} = 1;
      return substr($file, 0, $i);
    }
  }
  delete $self-&gt;{'values'}-&gt;{'dirname_found'};
  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]-&gt;{'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 ($self-&gt;{'foreach'}-&gt;{'count'} &gt;= 0) {
    $self-&gt;{'foreach'}-&gt;{'text'}-&gt;[$self-&gt;{'foreach'}-&gt;{'count'}] .= $value;
  }
  else {
    $self-&gt;{'built'} .= $value;
  }
}


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-&gt;{'ti'}) {
    my($counter) = $self-&gt;{'foreach'}-&gt;{'count'};
    if ($counter &gt;= 0) {
      my($value) = $self-&gt;{'ti'}-&gt;get_value($name);
      if (defined $value &amp;&amp; UNIVERSAL::isa($value, 'HASH')) {
        my(%copy) = ();
        foreach my $key (keys %$value) {
          $copy{$key} = $self-&gt;{'prjc'}-&gt;adjust_value($key, $$value{$key});
        }
        $self-&gt;{'foreach'}-&gt;{'temp_scope'}-&gt;[$counter] = \%copy;
        $set = 1;
      }
    }
  }
  return $set;
}


sub get_nested_value {
  my($self)  = shift;
  my($name)  = shift;
  my($value) = undef;

  if ($name =~ /^(.*)\-&gt;(\w+)/) {
    my($pre)  = $1;
    my($post) = $2;
    my($base) = $self-&gt;get_value($pre);
    if (defined $base) {
      $value = $self-&gt;{'prjc'}-&gt;get_special_value($pre, $post, $base,
                                                  @{$self-&gt;{'parameters'}});
    }
  }

  return $value;
}


sub get_value {
  my($self)    = shift;
  my($name)    = shift;
  my($value)   = undef;
  my($counter) = $self-&gt;{'foreach'}-&gt;{'count'};

  ## First, check the temporary scope (set inside a foreach)
  if ($counter &gt;= 0) {
    while(!defined $value &amp;&amp; $counter &gt;= 0) {
      $value = $self-&gt;{'foreach'}-&gt;{'temp_scope'}-&gt;[$counter]-&gt;{$name};
      --$counter;
    }
    $counter = $self-&gt;{'foreach'}-&gt;{'count'};
  }

  if (!defined $value) {
    ## Next, check for a template value
    if (defined $self-&gt;{'ti'}) {
      $value = $self-&gt;{'ti'}-&gt;get_value($name);
      if (defined $value) {
        $value = $self-&gt;{'prjc'}-&gt;adjust_value($name, $value);
      }
      else {
        my($uvalue) = $self-&gt;{'prjc'}-&gt;adjust_value($name, []);
        if (defined $$uvalue[0]) {
          $value = $uvalue;
        }
      }
    }

    if (!defined $value) {
      ## Next, check the inner to outer foreach
      ## scopes for overriding values
      while(!defined $value &amp;&amp; $counter &gt;= 0) {
        $value = $self-&gt;{'foreach'}-&gt;{'scope'}-&gt;[$counter]-&gt;{$name};
        --$counter;
      }

      ## Then get the value from the project creator
      if (!defined $value) {
        $value = $self-&gt;{'prjc'}-&gt;get_assignment($name);

        ## Then get it from our known values
        if (!defined $value) {
          $value = $self-&gt;{'values'}-&gt;{$name};
          if (!defined $value) {
            ## Call back onto the project creator to allow
            ## it to fill in the value before defaulting to undef.
            $value = $self-&gt;{'prjc'}-&gt;fill_value($name);
            if (!defined $value &amp;&amp; $name =~ /\-&gt;/) {
              $value = $self-&gt;get_nested_value($name);
            }
          }
        }
      }
    }
  }

  return $self-&gt;{'prjc'}-&gt;relative($value);
}


sub get_value_with_default {
  my($self)  = shift;
  my($name)  = shift;
  my($value) = $self-&gt;get_value($name);

  if (!defined $value) {
    $value = $self-&gt;{'defaults'}-&gt;{$name};
    if (defined $value) {
      $value = $self-&gt;{'prjc'}-&gt;relative(
                       $self-&gt;{'prjc'}-&gt;adjust_value($name, $value));
    }
    else {
      #$self-&gt;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-&gt;{'foreach'}-&gt;{'count'};
  my($text)   = $self-&gt;{'foreach'}-&gt;{'text'}-&gt;[$index];
  my($status) = 1;
  my($error)  = undef;
  my(@values) = ();
  my($names)  = $self-&gt;create_array($self-&gt;{'foreach'}-&gt;{'names'}-&gt;[$index]);
  my($name)   = $self-&gt;{'foreach'}-&gt;{'name'}-&gt;[$index];

  ## Get the values for all of the variable names
  ## contained within the foreach
  foreach my $n (@$names) {
    my($vals) = $self-&gt;get_value($n);
    if (defined $vals &amp;&amp; $vals ne '') {
      if (!UNIVERSAL::isa($vals, 'ARRAY')) {
        $vals = $self-&gt;create_array($vals);
      }
      push(@values, @$vals);
    }
    if (!defined $name) {
      $name = $n;
      $name =~ s/s$//;
    }
  }

  ## Reset the text (it will be regenerated by calling parse_line
  $self-&gt;{'foreach'}-&gt;{'text'}-&gt;[$index] = '';

  if (defined $values[0]) {
    my($scope) = $self-&gt;{'foreach'}-&gt;{'scope'}-&gt;[$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($pset) = undef;
    for(my $i = 0; $i &lt;= $#values; ++$i) {
      my($set) = $self-&gt;set_current_values($values[$i]);
      if (!defined $pset) {
        $pset |= $set;
      }
      else {
        if ($pset &amp;&amp; !$set) {
          splice(@values, $i, 1);
          $i = 0;
          $pset = undef;
        }
      }
    }

    for(my $i = 0; $i &lt;= $#values; ++$i) {
      my($value) = $values[$i];

      ## Set the corresponding values in the temporary scope
      $self-&gt;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-&gt;{'prjc'}-&gt;update_project_info($self, 1,
                                             ['configuration', 'platform'],
                                             '|');
      }

      ## Now parse the line of text, each time
      ## with different values
      ++$self-&gt;{'foreach'}-&gt;{'processing'};
      ($status, $error) = $self-&gt;parse_line(undef, $text);
      --$self-&gt;{'foreach'}-&gt;{'processing'};
      if (!$status) {
        last;
      }
    }
  }

  return $status, $error;
}


sub handle_endif {
  my($self) = shift;
  my($name) = shift;
  my($end)  = pop(@{$self-&gt;{'sstack'}});
  pop(@{$self-&gt;{'lstack'}});

  if (!defined $end) {
    return 0, "Unmatched $name";
  }
  else {
    my($in) = index($end, $name);
    if ($in == 0) {
      $self-&gt;{'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-&gt;{'sstack'}});
  pop(@{$self-&gt;{'lstack'}});

  if (!defined $end) {
    return 0, "Unmatched $name";
  }
  else {
    my($in) = index($end, $name);
    if ($in == 0) {
      my($index) = $self-&gt;{'foreach'}-&gt;{'count'};
      my($status, $error) = $self-&gt;process_foreach();
      if ($status) {
        --$self-&gt;{'foreach'}-&gt;{'count'};
        $self-&gt;append_current($self-&gt;{'foreach'}-&gt;{'text'}-&gt;[$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)  = shift;
  my($value) = undef;
  my($file)  = $self-&gt;get_value($name);
  my($prjc)  = $self-&gt;{'prjc'};
  my($fo)    = $prjc-&gt;{'flag_overrides'};

  if (defined $file) {
    ## Replace the custom_type key with the actual custom type
    if ($name =~ /^custom_type\-&gt;/) {
      my($ct) = $self-&gt;get_value('custom_type');
      if (defined $ct) {
        $name = $ct;
      }
    }

    foreach my $key (keys %$fo) {
      if ($key =~ /^$name/) {
        foreach my $of (keys %{$$fo{$key}}) {
          my($cv) = $of;
          if ($self-&gt;{'cslashes'}) {
            $cv = $prjc-&gt;slash_to_backslash($of);
          }
          if ($cv eq $file) {
            foreach my $ma (keys %{$prjc-&gt;{'matching_assignments'}}) {
              if ($ma eq $key) {
                foreach my $aname (@{$prjc-&gt;{'matching_assignments'}-&gt;{$ma}}) {
                  if ($aname eq $type &amp;&amp;
                      defined $$fo{$key}-&gt;{$of}-&gt;{$aname}) {
                    $value = $$fo{$key}-&gt;{$of}-&gt;{$aname};
                    last;
                  }
                }
                last;
              }
            }
            last;
          }
        }
        last;
      }
    }
  }

  return $prjc-&gt;relative($value);
}


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-&gt;process_compound_if($v);
      if ($ret != 0) {
        return 1;
      }
    }
  }
  elsif ($str =~ /\&amp;\&amp;/) {
    my($ret) = 1;
    foreach my $v (split(/\s*\&amp;\&amp;\s*/, $str)) {
      $ret &amp;&amp;= $self-&gt;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($val) = ($str =~ /flag_overrides\(([^\)]+),\s*([^\)]+)\)/ ?
                               $self-&gt;get_flag_overrides($1, $2) :
                               $self-&gt;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-&gt;{'lstack'}}, $self-&gt;get_line_number() . " $val");
  if ($self-&gt;{'if_skip'}) {
    push(@{$self-&gt;{'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-&gt;{'if_skip'} = !$self-&gt;process_compound_if($val);
    push(@{$self-&gt;{'sstack'}}, $name);
  }
}


sub handle_else {
  my($self)  = shift;
  my(@scopy) = @{$self-&gt;{'sstack'}};

  ## This method does not take into account that
  ## multiple else clauses could be supplied to a single if.
  ## Someday, this may be fixed.
  if (defined $scopy[$#scopy] &amp;&amp; $scopy[$#scopy] eq 'endif') {
    $self-&gt;{'if_skip'} ^= 1;
  }
}


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

  push(@{$self-&gt;{'lstack'}}, $self-&gt;get_line_number());
  if (!$self-&gt;{'if_skip'}) {
    my($vname) = undef;
    if ($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\-&gt;/ || $val eq 'custom_types') {
        $status = 0;
        $errorString = 'The foreach variable can not be ' .
                       'named when dealing with custom types';
      }
      elsif ($val =~ /^grouped_.*_file\-&gt;/ || $val =~ /^grouped_.*files$/) {
        $status = 0;
        $errorString = 'The foreach variable can not be ' .
                       'named when dealing with grouped files';
      }
    }

    push(@{$self-&gt;{'sstack'}}, $name);
    ++$self-&gt;{'foreach'}-&gt;{'count'};

    my($index) = $self-&gt;{'foreach'}-&gt;{'count'};
    $self-&gt;{'foreach'}-&gt;{'name'}-&gt;[$index]  = $vname;
    $self-&gt;{'foreach'}-&gt;{'names'}-&gt;[$index] = $val;
    $self-&gt;{'foreach'}-&gt;{'text'}-&gt;[$index]  = '';
    $self-&gt;{'foreach'}-&gt;{'scope'}-&gt;[$index] = {};
  }
  else {
    push(@{$self-&gt;{'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-&gt;get_value($name)) {
    $self-&gt;append_current($val);
  }
}


sub handle_uc {
  my($self) = shift;
  my($name) = shift;

  $self-&gt;append_current(uc($self-&gt;get_value_with_default($name)));
}


sub handle_lc {
  my($self) = shift;
  my($name) = shift;

  $self-&gt;append_current(lc($self-&gt;get_value_with_default($name)));
}


sub handle_ucw {
  my($self) = shift;
  my($name) = shift;
  my($val)  = $self-&gt;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-&gt;append_current($val);
}


sub handle_normalize {
  my($self) = shift;
  my($name) = shift;
  my($val)  = $self-&gt;get_value_with_default($name);

  $val =~ tr/\-/_/;
  $self-&gt;append_current($val);
}


sub handle_noextension {
  my($self) = shift;
  my($name) = shift;
  my($val)  = $self-&gt;get_value_with_default($name);

  $val =~ s/\.[^\.]+$//;
  $self-&gt;append_current($val);
}


sub handle_dirname {
  my($self) = shift;
  my($name) = shift;

  if (!$self-&gt;{'if_skip'}) {
    $self-&gt;append_current(
              $self-&gt;dirname($self-&gt;get_value_with_default($name)));
  }
}


sub handle_basename {
  my($self) = shift;
  my($name) = shift;

  if (!$self-&gt;{'if_skip'}) {
    $self-&gt;append_current(
              $self-&gt;basename($self-&gt;get_value_with_default($name)));
  }
}


sub handle_basenoextension {
  my($self) = shift;
  my($name) = shift;
  my($val)  = $self-&gt;basename($self-&gt;get_value_with_default($name));

  $val =~ s/\.[^\.]+$//;
  $self-&gt;append_current($val);
}


sub handle_flag_overrides {
  my($self) = shift;
  my($name) = shift;
  my($type) = '';

  ($name, $type) = split(/,\s*/, $name);

  my($value) = $self-&gt;get_flag_overrides($name, $type);
  if (defined $value) {
    $self-&gt;append_current($value);
  }
}


sub handle_marker {
  my($self) = shift;
  my($name) = shift;
  my($val)  = $self-&gt;{'prjc'}-&gt;get_verbatim($name);

  if (defined $val) {
    $self-&gt;append_current($val);
  }
}


sub handle_function {
  my($self)   = shift;
  my($name)   = shift;
  my($prefix) = shift;
  my($input)  = $self-&gt;get_value($prefix . '-&gt;input_file');
  my($output) = undef;

  if (defined $input) {
    if ($self-&gt;{'cslashes'}) {
      $input = $self-&gt;{'prjc'}-&gt;slash_to_backslash($input);
    }
    $output = $self-&gt;get_value($prefix . '-&gt;input_file-&gt;output_file');

    if (defined $output) {
      my($fo) = $self-&gt;get_flag_overrides($prefix . '-&gt;input_file',
                                          'gendir');
      if (defined $fo) {
        $output = $fo . '/' . File::Basename::basename($output);
      }
      if ($self-&gt;{'cslashes'}) {
        $output = $self-&gt;{'prjc'}-&gt;slash_to_backslash($output);
      }
    }
  }

  ## Set the parameters array with the determined input and output files
  $self-&gt;{'parameters'} = [ $input, $output ];

  ## Append the value returned by get_value_with_default.  It will use
  ## the parameters when it calls get_special_value on the ProjectCreator
  $self-&gt;append_current($self-&gt;get_value_with_default($name));

  ## Reset the parameters arary
  $self-&gt;{'parameters'} = [];
}


sub process_name {
  my($self)        = shift;
  my($line)        = shift;
  my($length)      = 0;
  my($status)      = 1;
  my($errorString) = undef;

  if ($line eq '') {
  }
  elsif ($line =~ /^(\w+)(\(([^\)]+|\".*\"|flag_overrides\([^\)]+,\s*[^\)]+\))\)|\-&gt;\w+([\w\-\&gt;]+)?)?%&gt;/) {
    ## Split the line into a name and value
    my($name, $val) = ();
    if ($line =~ /([^%\(]+)(\(([^%]+)\))?%&gt;/) {
      $name = lc($1);
      $val  = $3;
    }

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

    if (defined $keywords{$name}) {
      if ($name eq 'endif') {
        ($status, $errorString) = $self-&gt;handle_endif($name);
      }
      elsif ($name eq 'if') {
        $self-&gt;handle_if($val);
      }
      elsif ($name eq 'endfor') {
        ($status, $errorString) = $self-&gt;handle_endfor($name);
      }
      elsif ($name eq 'foreach') {
        ($status, $errorString) = $self-&gt;handle_foreach($val);
      }
      elsif ($name eq 'fornotlast'  || $name eq 'forlast' ||
             $name eq 'fornotfirst' || $name eq 'forfirst') {
        if (!$self-&gt;{'if_skip'}) {
          $self-&gt;handle_special($name, $self-&gt;process_special($val));
        }
      }
      elsif ($name eq 'else') {
        $self-&gt;handle_else();
      }
      elsif ($name eq 'flag_overrides') {
        if (!$self-&gt;{'if_skip'}) {
          $self-&gt;handle_flag_overrides($val);
        }
      }
      elsif ($name eq 'noextension') {
        if (!$self-&gt;{'if_skip'}) {
          $self-&gt;handle_noextension($val);
        }
      }
      elsif ($name eq 'basenoextension') {
        if (!$self-&gt;{'if_skip'}) {
          $self-&gt;handle_basenoextension($val);
        }
      }
      elsif ($name eq 'basename') {
        if (!$self-&gt;{'if_skip'}) {
          $self-&gt;handle_basename($val);
        }
      }
      elsif ($name eq 'marker') {
        if (!$self-&gt;{'if_skip'}) {
          $self-&gt;handle_marker($val);
        }
      }
      elsif ($name eq 'dirname') {
        if (!$self-&gt;{'if_skip'}) {
          $self-&gt;handle_dirname($val);
        }
      }
      elsif ($name eq 'comment') {
        ## Ignore the contents of the comment
      }
      elsif ($name eq 'uc') {
        if (!$self-&gt;{'if_skip'}) {
          $self-&gt;handle_uc($val);
        }
      }
      elsif ($name eq 'ucw') {
        if (!$self-&gt;{'if_skip'}) {
          $self-&gt;handle_ucw($val);
        }
      }
      elsif ($name eq 'lc') {
        if (!$self-&gt;{'if_skip'}) {
          $self-&gt;handle_lc($val);
        }
      }
      elsif ($name eq 'normalize') {
        if (!$self-&gt;{'if_skip'}) {
          $self-&gt;handle_normalize($val);
        }
      }
    }
    else {
      if (!$self-&gt;{'if_skip'}) {
        if (defined $val &amp;&amp; !defined $self-&gt;{'defaults'}-&gt;{$name}) {
          $self-&gt;{'defaults'}-&gt;{$name} = $self-&gt;process_special($val);
        }
        $self-&gt;append_current($self-&gt;get_value_with_default($name));
      }
    }
  }
  elsif ($line =~ /^((\w+)(-&gt;\w+)+)\(\)%&gt;/) {
    my($name) = $1;
    ## Handle all "function calls" separately
    if (!$self-&gt;{'if_skip'}) {
      $self-&gt;handle_function($name, $2);
    }
    $length += length($name) + 2;
  }
  else {
    my($error)  = $line;
    my($length) = length($line);
    for(my $i = 0; $i &lt; $length; ++$i) {
      my($part) = substr($line, $i, 2);
      if ($part eq '%&gt;') {
        $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-&gt;{'prjc'};
  my($cwd)   = $self-&gt;getcwd();
  my($relwd) = $prjc-&gt;reverse_relative($cwd);

  ## Set the current working directory
  if ($self-&gt;{'cslashes'}) {
    $cwd = $prjc-&gt;slash_to_backslash($cwd);
  }
  $self-&gt;{'values'}-&gt;{'cwd'} = $cwd;

  ## Set the relative working directory
  $relwd =~ s/\$\([^\)]+\)[\/\\]//;
  if ($self-&gt;{'cslashes'}) {
    $relwd = $prjc-&gt;slash_to_backslash($relwd);
  }
  $self-&gt;{'values'}-&gt;{'relwd'} = $relwd;

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

  ## 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-&gt;update_project_info($self, 0, ['project_name']);

  ## This is for all projects
  $prjc-&gt;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-&gt;update_project_info($self, 1, ['guid']);
  $self-&gt;{'values'}-&gt;{'guid'} = $guid;
}


sub parse_line {
  my($self)        = shift;
  my($ih)          = shift;
  my($line)        = shift;
  my($status)      = 1;
  my($errorString) = undef;
  my($length)      = length($line);
  my($name)        = 0;
  my($startempty)  = ($length == 0 ? 1 : 0);
  my($append_name) = 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-&gt;{'foreach'}-&gt;{'processing'} == 0) {
    my($is_only_keyword) = undef;
    if ($line =~ /^\s*&lt;%(\w+)(\([^\)]+\))?%&gt;$/) {
      $is_only_keyword = defined $keywords{$1};
    }

    if (!$is_only_keyword) {
      $line   .= $self-&gt;{'crlf'};
      $length += $self-&gt;{'clen'};
    }
  }

  if ($self-&gt;{'foreach'}-&gt;{'count'} &lt; 0) {
    $self-&gt;{'built'} = '';
  }

  for(my $i = 0; $i &lt; $length; ++$i) {
    my($part) = substr($line, $i, 2);
    if ($part eq '&lt;%') {
      ++$i;
      $name = 1;
    }
    elsif ($part eq '%&gt;') {
      ++$i;
      $name = 0;
      if ($append_name) {
        $append_name = 0;
        if (!$self-&gt;{'if_skip'}) {
          $self-&gt;append_current($part);
        }
      }
    }
    elsif ($name) {
      my($substr)  = substr($line, $i);
      my($efcheck) = ($substr =~ /^endfor\%\&gt;/);
      my($focheck) = ($efcheck ? 0 : ($substr =~ /^foreach\(/));

      if ($focheck &amp;&amp; $self-&gt;{'foreach'}-&gt;{'count'} &gt;= 0) {
        ++$self-&gt;{'foreach'}-&gt;{'nested'};
      }

      if ($self-&gt;{'foreach'}-&gt;{'count'} &lt; 0 ||
          $self-&gt;{'foreach'}-&gt;{'processing'} &gt; $self-&gt;{'foreach'}-&gt;{'nested'} ||
          (($efcheck || $focheck) &amp;&amp;
           $self-&gt;{'foreach'}-&gt;{'nested'} == $self-&gt;{'foreach'}-&gt;{'processing'})) {
        my($nlen) = 0;
        ($status,
         $errorString,
         $nlen) = $self-&gt;process_name($substr);

        if ($status &amp;&amp; $nlen == 0) {
          $errorString = "Could not parse this line at column $i";
          $status = 0;
        }
        if (!$status) {
          last;
        }

        $i += ($nlen - 1);
      }
      else  {
        $name = 0;
        if (!$self-&gt;{'if_skip'}) {
          $self-&gt;append_current('&lt;%' . substr($line, $i, 1));
          $append_name = 1;
        }
      }

      if ($efcheck &amp;&amp; $self-&gt;{'foreach'}-&gt;{'nested'} &gt; 0) {
        --$self-&gt;{'foreach'}-&gt;{'nested'};
      }
    }
    else {
      if (!$self-&gt;{'if_skip'}) {
        $self-&gt;append_current(substr($line, $i, 1));
      }
    }
  }

  if ($self-&gt;{'foreach'}-&gt;{'count'} &lt; 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-&gt;{'built'} ne $self-&gt;{'crlf'} &amp;&amp; $self-&gt;{'built'} ne '')) {
      push(@{$self-&gt;{'lines'}}, $self-&gt;{'built'});
    }
  }

  return $status, $errorString;
}


sub parse_file {
  my($self)  = shift;
  my($input) = shift;

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

  if ($status) {
    my($sstack) = $self-&gt;{'sstack'};
    if (defined $$sstack[0]) {
      my($lstack) = $self-&gt;{'lstack'};
      $status = 0;
      $errorString = "Missing an $$sstack[0] starting at $$lstack[0]";
    }
  }

  if (!$status) {
    my($linenumber) = $self-&gt;get_line_number();
    $errorString = "$input: line $linenumber:\n$errorString";
  }

  return $status, $errorString;
}


sub get_lines {
  my($self) = shift;
  return $self-&gt;{'lines'};
}


sub get_cache {
  my($self) = shift;
  my($key)  = shift;
  return $filecache{$key};
}


sub cache_line {
  my($self) = shift;
  my($key)  = shift;
  my($line) = shift;

  ## If we don't have an array for this key, then start one
  if (!defined $filecache{$key}) {
    $filecache{$key} = [];
  }

  ## Push the line onto the array for this key
  push(@{$filecache{$key}}, $line);
}


1;
</pre></body></html>