modules/TemplateParser.pm

   1 package TemplateParser;
   2
   3 # ************************************************************
   4 # Description   : Parses the template and fills in missing values
   5 # Author        : Chad Elliott
   6 # Create Date   : 5/17/2002
   7 # ************************************************************
   8
   9 # ************************************************************
  10 # Pragmas
  11 # ************************************************************
  12
  13 use strict;
  14 use File::Path;
  15
  16 use Parser;
  17 use WinVersionTranslator;
  18
  19 use vars qw(@ISA);
  20 @ISA = qw(Parser);
  21
  22 # ************************************************************
  23 # Data Section
  24 # ************************************************************
  25
  26 # Valid keywords for use in template files.  Each has a handle_
  27 # method available, but some have other methods too.
  28 # Bit  Meaning
  29 # 0 means there is a get_ method available (used by if and nested functions)
  30 # 1 means there is a perform_ method available (used by foreach and nested)
  31 # 2 means there is a doif_ method available (used by if)
  32 # 3 means that parameters to perform_ should not be evaluated
  33 # 4 means there is a post_ method available (called after the results of
  34 #   calling perform_ for a nested function are written to the output)
  35 # 5 means that the get_ method performs the get_ and doif_ functionality
  36 #
  37 # Perl Function         Parameter Type          Return Type
  38 # get_                  string                  string or array
  39 # perform_              array reference         array
  40 # doif_                 array reference         boolean
  41 #
  42 my $get_type             = 1 << 0;
  43 my $perform_type         = 1 << 1;
  44 my $doif_type            = 1 << 2;
  45 my $perform_no_eval_type = 1 << 3;
  46 my $post_type            = 1 << 4;
  47 my $get_combined_type    = 1 << 5;
  48 my %keywords = ('if'              => 0,
  49                 'else'            => 0,
  50                 'endif'           => 0,
  51                 'noextension'     => $get_type|$perform_type,
  52                 'dirname'         => $get_type|$perform_type|$doif_type,
  53                 'basename'        => $get_type|$perform_type|$doif_type,
  54                 'basenoextension' => 0,
  55                 'foreach'         => 0,
  56                 'forfirst'        => 0,
  57                 'fornotfirst'     => 0,
  58                 'fornotlast'      => 0,
  59                 'forlast'         => 0,
  60                 'endfor'          => 0,
  61                 'eval'            => 0,
  62                 'comment'         => 0,
  63                 'marker'          => 0,
  64                 'uc'              => $get_type|$perform_type,
  65                 'lc'              => $get_type|$perform_type,
  66                 'ucw'             => 0,
  67                 'normalize'       => $get_type|$perform_type,
  68                 'flag_overrides'  => $get_type,
  69                 'reverse'         => $get_type|$perform_type,
  70                 'sort'            => $get_type|$perform_type,
  71                 'uniq'            => $get_type|$perform_type,
  72                 'multiple'        => $get_type|$doif_type|$get_combined_type,
  73                 'starts_with'     => $get_type|$doif_type|$get_combined_type,
  74                 'ends_with'       => $get_type|$doif_type|$get_combined_type,
  75                 'contains'        => $get_type|$doif_type|$get_combined_type,
  76                 'subst'           => $get_type|$doif_type|$get_combined_type,
  77                 'remove_from'     => $get_type|$perform_type|$doif_type|$perform_no_eval_type|$get_combined_type,
  78                 'compares'        => $get_type|$doif_type|$get_combined_type,
  79                 'vars_equal'      => $get_type|$perform_type,
  80                 'duplicate_index' => $get_type|$doif_type|$get_combined_type,
  81                 'transdir'        => $get_type|$doif_type,
  82                 'has_extension'   => $get_type|$doif_type|$get_combined_type,
  83                 'keyname_used'    => 0,
  84                 'scope'           => 0,
  85                 'full_path'       => $get_type|$perform_type,
  86                 'extensions'      => $perform_type|$perform_no_eval_type,
  87                 'create_aux_file' => $perform_type|$post_type,
  88                 'end_aux_file'    => 0,
  89                 'translate_vars'  => $get_type|$perform_type,
  90                 'convert_slashes' => $perform_type,
  91                 'new_guid'        => 0,
  92                 'deref'           => 0,
  93                 'set'             => 0,
  94                 'is_relative'     => $get_type|$doif_type|$get_combined_type,
  95                 'extension'       => $get_type,
  96                 'is_custom_input' => $get_type|$doif_type|$get_combined_type,
  97                );
  98
  99 my %target_type_vars = ('type_is_static'   => 1,
 100                         'need_staticflags' => 1,
 101                         'type_is_dynamic'  => 1,
 102                         'type_is_binary'   => 1,
 103                        );
 104
 105 my %arrow_op_ref = ('custom_type'     => 'custom types',
 106                     'grouped_.*_file' => 'grouped files',
 107                     'feature'         => 'features',
 108                    );
 109
 110 # optmized regex
 111 my $parse_line_re1 = qr/^[ ]*<%(\w+)(?:\((?:(?:\w+\s*,\s*)*[!]?\w+\(.+\)|[^\)]+)\))?%>$/;
 112 my $process_name_re1 = qr/([^%\(]+)(\(([^%]+)\))?%>/;
 113
 114 # ************************************************************
 115 # Subroutine Section
 116 # ************************************************************
 117
 118 sub new {
 119   my($class, $prjc) = @_;
 120   my $self = $class->SUPER::new();
 121
 122   $self->{'prjc'}                 = $prjc;
 123   $self->{'ti'}                   = $prjc->get_template_input();
 124   $self->{'cslashes'}             = $prjc->convert_slashes();
 125   $self->{'crlf'}                 = $prjc->crlf();
 126   $self->{'cmds'}                 = $prjc->get_command_subs();
 127   $self->{'vnames'}               = $prjc->get_valid_names();
 128   $self->{'values'}               = {};
 129   $self->{'defaults'}             = {};
 130   $self->{'lines'}                = [];
 131   $self->{'built'}                = '';
 132   $self->{'sstack'}               = [];
 133   $self->{'lstack'}               = [];
 134   $self->{'if_skip'}              = 0;
 135   $self->{'eval'}                 = 0;
 136   $self->{'eval_str'}             = '';
 137   $self->{'dupfiles'}             = {};
 138   $self->{'override_target_type'} = undef;
 139   $self->{'keyname_used'}         = {};
 140   $self->{'scopes'}               = {};
 141   $self->{'aux_file'}             = undef;
 142   $self->{'custom_input_cache'}   = {};
 143
 144   $self->{'foreach'}  = {};
 145   $self->{'foreach'}->{'count'}      = -1;
 146   $self->{'foreach'}->{'nested'}     = 0;
 147   $self->{'foreach'}->{'name'}       = [];
 148   $self->{'foreach'}->{'vars'}       = [];
 149   $self->{'foreach'}->{'text'}       = [];
 150   $self->{'foreach'}->{'scope'}      = [];
 151   $self->{'foreach'}->{'scope_name'} = [];
 152   $self->{'foreach'}->{'temp_scope'} = [];
 153   $self->{'foreach'}->{'processing'} = 0;
 154
 155   return $self;
 156 }
 157
 158
 159 sub tp_basename {
 160   my($self, $file) = @_;
 161
 162   if ($self->{'cslashes'}) {
 163     $file =~ s/.*[\/\\]//;
 164   }
 165   else {
 166     $file =~ s/.*\///;
 167   }
 168   return $file;
 169 }
 170
 171
 172 sub validated_dirname {
 173   my($self, $file) = @_;
 174   my $index = rindex($file, ($self->{'cslashes'} ? '\\' : '/'));
 175
 176   if ($index >= 0) {
 177     return $self->{'prjc'}->validated_directory(substr($file, 0, $index));
 178   }
 179   else {
 180     return '.';
 181   }
 182 }
 183
 184
 185 sub tp_dirname {
 186   my($self, $file) = @_;
 187   my $index = rindex($file, ($self->{'cslashes'} ? '\\' : '/'));
 188
 189   if ($index >= 0) {
 190     return substr($file, 0, $index);
 191   }
 192   else {
 193     return '.';
 194   }
 195 }
 196
 197
 198 sub strip_line {
 199   #my $self = shift;
 200   #my $line = shift;
 201
 202   ## Override strip_line() from Parser.
 203   ## We need to preserve leading space and
 204   ## there is no comment string in templates.
 205   ++$_[0]->{'line_number'};
 206   $_[1] =~ s/\s+$//;
 207
 208   return $_[1];
 209 }
 210
 211
 212 ## Append the current value to the line that is being
 213 ## built.  This line may be a foreach line or a general
 214 ## line without a foreach.
 215 sub append_current {
 216   my $value = $_[1];
 217   my $scope = $_[0]->{'scopes'};
 218   while(defined $$scope{'scope'}) {
 219     $scope = $$scope{'scope'};
 220     if (defined $$scope{'escape'}) {
 221       if ($$scope{'escape'}->[1] < 0 && $_[0]->{'foreach'}->{'count'} >= 0) {
 222         ## This scope was created outside of a foreach.  If we are
 223         ## processing a foreach, we need to skip this at this point as it
 224         ## will be handled once the foreach has been completed and is
 225         ## appended to the main project body.
 226         last;
 227       }
 228       else {
 229         my $key = $$scope{'escape'}->[0];
 230         if ($key eq '\\') {
 231           $value =~ s/\\/\\\\/g;
 232         }
 233         else {
 234           $value =~ s/($key)/\\$1/g;
 235         }
 236       }
 237     }
 238     else {
 239       foreach my $key (keys %$scope) {
 240         $_[0]->warning("Unrecognized scope function: $key.");
 241       }
 242     }
 243   }
 244
 245   my $foreach_count = $_[0]->{'foreach'}->{'count'};
 246   if ($_[0]->{'aux_file'}
 247       && $foreach_count == $_[0]->{'aux_file'}->{'foreach_baseline'}) {
 248     $_[0]->{'aux_file'}->{'text'} .= $value;
 249   }
 250   elsif ($foreach_count >= 0) {
 251     $_[0]->{'foreach'}->{'text'}->[$foreach_count] .= $value;
 252   }
 253   elsif ($_[0]->{'eval'}) {
 254     $_[0]->{'eval_str'} .= $value;
 255   }
 256   else {
 257     $_[0]->{'built'} .= $value;
 258   }
 259 }
 260
 261
 262 sub split_parameters {
 263   my($self, $str) = @_;
 264   my @params;
 265
 266   while($str =~ /^(\w+\([^\)]+\))(.*)/ || $str =~ /^([^,]+)(.*)/) {
 267     push(@params, $1);
 268     $str = $2;
 269     $str =~ s/^\s*,\s*//;
 270   }
 271
 272   ## Return the parameters (which includes whatever is left in the
 273   ## string).  Just return it instead of pushing it onto @params.
 274   return $str eq '' ? @params : (@params, $str);
 275 }
 276
 277
 278 sub set_current_values {
 279   my($self, $name) = @_;
 280   my $set = 0;
 281
 282   ## If any value within a foreach matches the name
 283   ## of a hash table within the template input we will
 284   ## set the values of that hash table in the current scope
 285   if (defined $self->{'ti'}) {
 286     my $counter = $self->{'foreach'}->{'count'};
 287     if ($counter >= 0) {
 288       ## Variable names are case-insensitive in MPC, however this can
 289       ## cause problems when dealing with template variable values that
 290       ## happen to match HASH names only by case-insensitivity.  So, we
 291       ## now make HASH names match with case-sensitivity.
 292       my $value = $self->{'ti'}->get_value($name);
 293       if (defined $value && UNIVERSAL::isa($value, 'HASH') &&
 294           $self->{'ti'}->get_realname($name) eq $name) {
 295         $self->{'foreach'}->{'scope_name'}->[$counter] = $name;
 296         my %copy;
 297         foreach my $key (keys %$value) {
 298           $copy{$key} = $self->{'prjc'}->adjust_value(
 299                     [$name . '::' . $key, $name], $$value{$key}, $self);
 300         }
 301         $self->{'foreach'}->{'temp_scope'}->[$counter] = \%copy;
 302         $set = 1;
 303       }
 304       else {
 305         ## Since we're not creating a temporary scope for this level, we
 306         ## need to empty out the scope that may have been held here from
 307         ## a previous foreach.
 308         $self->{'foreach'}->{'temp_scope'}->[$counter] = {};
 309       }
 310     }
 311   }
 312   return $set;
 313 }
 314
 315
 316 sub get_value {
 317   my($self, $name) = @_;
 318   my $value;
 319   my $counter = $self->{'foreach'}->{'count'};
 320   my $fromprj;
 321   my @scopes;
 322   my @snames;
 323   my $adjust = 1;
 324
 325   ## $name should always be all lower-case
 326   $name = lc($name);
 327
 328   ## First, check the temporary scope (set inside a foreach)
 329   if ($counter >= 0) {
 330     ## Create a list of possible scoped names
 331     @scopes = reverse @{$self->{'foreach'}->{'scope_name'}};
 332     @snames = map { (defined $_ ? $_ : '') . '::' . $name } @scopes;
 333     push(@snames, $name);
 334
 335     while(!defined $value && $counter >= 0) {
 336       $value = $self->{'foreach'}->{'temp_scope'}->[$counter]->{$name};
 337       --$counter;
 338     }
 339     $counter = $self->{'foreach'}->{'count'};
 340
 341     if ($self->{'override_target_type'} &&
 342         defined $value && defined $target_type_vars{$name}) {
 343       $value = $self->{'values'}->{$name};
 344     }
 345   }
 346   else {
 347     @snames = ($name);
 348   }
 349
 350   if (!defined $value) {
 351     if ($name =~ /^flag_overrides\((.*)\)$/) {
 352       $value = $self->get_flag_overrides($1);
 353     }
 354
 355     if (!defined $value) {
 356       ## Next, check for a template value
 357       if (defined $self->{'ti'}) {
 358         $value = $self->{'ti'}->get_value($name);
 359       }
 360
 361       if (!defined $value) {
 362         ## Calling adjust_value here allows us to pick up template
 363         ## overrides before getting values elsewhere.
 364         my $uvalue = $self->{'prjc'}->adjust_value(\@snames, [], $self);
 365         if (defined $$uvalue[0]) {
 366           $value = $uvalue;
 367           $adjust = 0;
 368           $fromprj = 1;
 369         }
 370
 371         if (!defined $value) {
 372           ## Next, check the inner to outer foreach
 373           ## scopes for overriding values
 374           while(!defined $value && $counter >= 0) {
 375             $value = $self->{'foreach'}->{'scope'}->[$counter]->{$name};
 376             --$counter;
 377           }
 378
 379           ## Then get the value from the project creator
 380           if (!defined $value) {
 381             $fromprj = 1;
 382             $value = $self->{'prjc'}->get_assignment($name);
 383
 384             ## Then get it from our known values
 385             if (!defined $value) {
 386               $value = $self->{'values'}->{$name};
 387               if (!defined $value) {
 388                 ## Call back onto the project creator to allow
 389                 ## it to fill in the value before defaulting to undef.
 390                 $value = $self->{'prjc'}->fill_value($name);
 391                 if (!defined $value && $name =~ /^(.*)\->(\w+)/) {
 392                   my $pre  = $1;
 393                   my $post = $2;
 394                   my $base = $self->get_value($pre);
 395
 396                   if (defined $base) {
 397                     $value = $self->{'prjc'}->get_special_value(
 398                                $pre, $post, $base,
 399                                ($self->{'prjc'}->requires_parameters($post) ?
 400                                    $self->prepare_parameters($pre) : undef));
 401                   }
 402                 }
 403               }
 404             }
 405           }
 406         }
 407       }
 408     }
 409   }
 410
 411   ## Adjust the value even if we haven't obtained one from an outside
 412   ## source.
 413   if ($adjust && defined $value) {
 414     $value = $self->{'prjc'}->adjust_value(\@snames, $value, $self);
 415   }
 416
 417   ## If the value did not come from the project creator, we
 418   ## check the variable name.  If it is a project keyword we then
 419   ## check to see if we need to add the project value to the template
 420   ## variable value.  If so, we make a copy of the value array and
 421   ## push the project value onto that (to avoid modifying the original).
 422   if (!$fromprj && defined $self->{'vnames'}->{$name} &&
 423       $self->{'prjc'}->add_to_template_input_value($name)) {
 424     my $pjval = $self->{'prjc'}->get_assignment($name);
 425     if (defined $pjval) {
 426       my @copy = @$value;
 427       if (!UNIVERSAL::isa($pjval, 'ARRAY')) {
 428         $pjval = $self->create_array($pjval);
 429       }
 430       push(@copy, @$pjval);
 431       $value = \@copy;
 432     }
 433   }
 434
 435   return (defined $value ?
 436             $self->{'prjc'}->relative($value, undef, \@scopes) : undef);
 437 }
 438
 439
 440 sub get_value_with_default {
 441   my $self  = shift;
 442   my $name = lc(shift);
 443   my $value = $self->get_value($name);
 444
 445   if (!defined $value) {
 446     $value = $self->{'defaults'}->{$name};
 447     if (defined $value) {
 448       my $counter = $self->{'foreach'}->{'count'};
 449       my $sname;
 450
 451       if ($counter >= 0) {
 452         ## Find the outer most scope for our variable name
 453         for(my $index = $counter; $index >= 0; --$index) {
 454           if (defined $self->{'foreach'}->{'scope_name'}->[$index]) {
 455             $sname = $self->{'foreach'}->{'scope_name'}->[$index] .
 456                      '::' . $name;
 457             last;
 458           }
 459         }
 460       }
 461       $value = $self->{'prjc'}->relative(
 462                  $self->{'prjc'}->adjust_value(
 463                    [$sname, $name], $value, $self));
 464
 465       ## If the user set the variable to empty, we will go ahead and use
 466       ## the default value (since we know we have one at this point).
 467       $value = $self->{'defaults'}->{$name} if (!defined $value);
 468     }
 469     else {
 470       #$self->warning("$name defaulting to empty string.");
 471       $value = '';
 472     }
 473   }
 474
 475   return (UNIVERSAL::isa($value, 'ARRAY') ? "@$value" : $value);
 476 }
 477
 478 sub get_match_pattern {
 479   my ($tp, $patarg) = @_;
 480
 481   my $patval = $tp->get_value($patarg);
 482   if (defined $patval) {
 483     return $patval;
 484   }
 485   else {
 486     return $patarg;
 487   }
 488 }
 489
 490 sub process_foreach {
 491   my $self   = shift;
 492   my $index = $self->{'foreach'}->{'count'};
 493   my $text = $self->{'foreach'}->{'text'}->[$index];
 494   my @values;
 495   my $name = $self->{'foreach'}->{'name'}->[$index];
 496   my @cmds;
 497   my $val = $self->{'foreach'}->{'vars'}->[$index];
 498   my $check_for_mixed;
 499
 500   if ($val =~ /^((\w+),\s*)?flag_overrides\((.*)\)$/) {
 501     ## If the user did not provide a name we have to pick one otherwise
 502     ## there would be no way to access the foreach values.
 503     $name = (defined $2 ? $2 : '__unnamed__');
 504
 505     ## Now check to see if there were overrides for this value.  If there
 506     ## were, convert them into an array (if necessary) and continue
 507     ## processing.
 508     $val = $self->get_flag_overrides($3);
 509     if (defined $val) {
 510       $val = $self->create_array($val) if (!UNIVERSAL::isa($val, 'ARRAY'));
 511       @values = @$val;
 512     }
 513   }
 514   else {
 515     ## Pull out modifying commands first
 516     while($val =~ /(\w+)\((.+)\)/) {
 517       my $cmd = $1;
 518       $val = $2;
 519       if (($keywords{$cmd} & $perform_type) != 0) {
 520         push(@cmds, 'perform_' . $cmd);
 521         if (($keywords{$cmd} & $perform_no_eval_type) != 0) {
 522           my @params = $self->split_parameters($val);
 523           $val = \@params;
 524           last;
 525         }
 526       }
 527       else {
 528         $self->warning("Unable to use $cmd in foreach (no perform_ method).");
 529       }
 530     }
 531
 532     ## Get the values for all of the variable names
 533     ## contained within the foreach
 534     if (UNIVERSAL::isa($val, 'ARRAY')) {
 535       @values = @$val;
 536     }
 537     else {
 538       my $names = $self->create_array($val);
 539       foreach my $n (@$names) {
 540         my $vals = $self->get_value($n);
 541         if (defined $vals && $vals ne '') {
 542           if (!UNIVERSAL::isa($vals, 'ARRAY')) {
 543             $vals = $self->create_array($vals);
 544           }
 545           push(@values, @$vals);
 546         }
 547         if (!defined $name) {
 548           $name = $n;
 549           $name =~ s/s$//;
 550         }
 551         ## We only want to check for the mixing of scalar and hash
 552         ## variables if the variable name is not a keyword (or the
 553         ## special 'features' template variable).
 554         if (!$check_for_mixed &&
 555             !$self->{'prjc'}->is_keyword($n) && $n ne 'features') {
 556           $check_for_mixed = 1;
 557         }
 558       }
 559     }
 560   }
 561
 562   ## Perform the commands on the built up @values
 563   foreach my $cmd (reverse @cmds) {
 564     @values = $self->$cmd(\@values);
 565   }
 566
 567   ## Reset the text (it will be regenerated by calling parse_line
 568   $self->{'foreach'}->{'text'}->[$index] = '';
 569
 570   if (defined $values[0]) {
 571     my $scope = $self->{'foreach'}->{'scope'}->[$index];
 572     my $base  = $self->{'foreach'}->{'base'}->[$index];
 573
 574     $$scope{'forlast'}     = '';
 575     $$scope{'fornotlast'}  = 1;
 576     $$scope{'forfirst'}    = 1;
 577     $$scope{'fornotfirst'} = '';
 578
 579     ## If the foreach values are mixed (HASH and SCALAR), then
 580     ## remove the SCALAR values.
 581     if ($check_for_mixed) {
 582       my %mixed;
 583       my $mixed = 0;
 584       foreach my $mval (@values) {
 585         $mixed{$mval} = $self->set_current_values($mval);
 586         $mixed |= $mixed{$mval};
 587       }
 588       if ($mixed) {
 589         my @nvalues;
 590         foreach my $key (sort keys %mixed) {
 591           push(@nvalues, $key) if ($mixed{$key});
 592         }
 593
 594         ## Set the new values only if they are different
 595         ## from the original (except for order).
 596         my @sorted = sort(@values);
 597         @values = @nvalues if (@sorted != @nvalues);
 598       }
 599     }
 600
 601     for(my $i = 0; $i <= $#values; ++$i) {
 602       my $value = $values[$i];
 603
 604       ## Set the corresponding values in the temporary scope
 605       $self->set_current_values($value);
 606
 607       ## Set the special values that only exist
 608       ## within a foreach
 609       if ($i != 0) {
 610         $$scope{'forfirst'}    = '';
 611         $$scope{'fornotfirst'} = 1;
 612       }
 613       if ($i == $#values) {
 614         $$scope{'forlast'}    = 1;
 615         $$scope{'fornotlast'} = '';
 616       }
 617       $$scope{'forcount'} = $i + $base;
 618
 619       ## We don't use adjust_value here because these names
 620       ## are generated from a foreach and should not be adjusted.
 621       $$scope{$name} = $value;
 622
 623       ## A tiny hack for VC7
 624       if ($name eq 'configuration' &&
 625           $self->get_value_with_default('platform') ne '') {
 626         $self->{'prjc'}->update_project_info($self, 1,
 627                                              ['configuration', 'platform'],
 628                                              '|');
 629       }
 630
 631       ## Now parse the line of text, each time
 632       ## with different values
 633       ++$self->{'foreach'}->{'processing'};
 634       my($status, $error) = $self->parse_line(undef, $text);
 635       --$self->{'foreach'}->{'processing'};
 636       return $error if (defined $error);
 637     }
 638   }
 639
 640   return undef;
 641 }
 642
 643
 644 sub generic_handle {
 645   my($self, $func, $str) = @_;
 646
 647   if (defined $str) {
 648     my $val = $self->$func([$str]);
 649
 650     if (defined $val) {
 651       $self->append_current($val);
 652     }
 653     else {
 654       $self->append_current(0);
 655     }
 656   }
 657 }
 658
 659
 660 sub handle_endif {
 661   my($self, $name) = @_;
 662   my $end = pop(@{$self->{'sstack'}});
 663   pop(@{$self->{'lstack'}});
 664
 665   if (!defined $end) {
 666     return "Unmatched $name";
 667   }
 668   else {
 669     my $in = index($end, $name);
 670     if ($in == 0) {
 671       $self->{'if_skip'} = 0;
 672     }
 673     elsif ($in == -1) {
 674       return "Unmatched $name";
 675     }
 676   }
 677
 678   return undef;
 679 }
 680
 681
 682 sub handle_endfor {
 683   my($self, $name) = @_;
 684   my $end = pop(@{$self->{'sstack'}});
 685   pop(@{$self->{'lstack'}});
 686
 687   if (!defined $end) {
 688     return "Unmatched $name";
 689   }
 690   else {
 691     my $in = index($end, $name);
 692     if ($in == 0) {
 693       my $index = $self->{'foreach'}->{'count'};
 694       my $error = $self->process_foreach();
 695       if (!defined $error) {
 696         --$self->{'foreach'}->{'count'};
 697         $self->append_current($self->{'foreach'}->{'text'}->[$index]);
 698       }
 699       return $error;
 700     }
 701     elsif ($in == -1) {
 702       return "Unmatched $name";
 703     }
 704   }
 705
 706   return undef;
 707 }
 708
 709
 710 sub get_flag_overrides {
 711   my($self, $name) = @_;
 712   my $type;
 713
 714   ## Split the name and type parameters
 715   ($name, $type) = split(/,\s*/, $name);
 716
 717   my $file = $self->get_value($name);
 718   if (defined $file) {
 719     ## Save the name prefix (if there is one) for
 720     ## command parameter conversion at the end
 721     my $pre;
 722     if ($name =~ /^(\w+)->/) {
 723       $pre = $1;
 724
 725       ## Replace the custom_type key with the actual custom type
 726       if ($pre eq 'custom_type') {
 727         my $ct = $self->get_value($pre);
 728         $name = $ct if (defined $ct);
 729       }
 730       elsif ($pre =~ /^grouped_(.*_file)$/) {
 731         $name = $1;
 732       }
 733     }
 734
 735     my $fo  = $self->{'prjc'}->{'flag_overrides'};
 736     my $key = (defined $$fo{$name . 's'} ? $name . 's' :
 737                        (defined $$fo{$name} ? $name : undef));
 738
 739     if (defined $key) {
 740       ## Convert the file name into a unix style file name
 741       my $ustyle = $file;
 742       $ustyle =~ s/\\/\//g if ($self->{'cslashes'});
 743
 744       ## Save the directory portion for checking in the foreach
 745       my $dir = $self->mpc_dirname($ustyle);
 746
 747       my $of = (defined $$fo{$key}->{$ustyle} ? $ustyle :
 748                    (defined $$fo{$key}->{$dir} ? $dir : undef));
 749       if (defined $of) {
 750         my $prjc = $self->{'prjc'};
 751         foreach my $aname (@{$prjc->{'matching_assignments'}->{$key}}) {
 752           if ($aname eq $type && defined $$fo{$key}->{$of}->{$aname}) {
 753             my $value = $$fo{$key}->{$of}->{$aname};
 754
 755             ## If the name that we're overriding has a value and
 756             ## requires parameters, then we will convert all of the
 757             ## pseudo variables and provide parameters.
 758             if (defined $pre && $prjc->requires_parameters($type)) {
 759               $value = $prjc->convert_command_parameters(
 760                                       $key, $value,
 761                                       $self->prepare_parameters($pre));
 762             }
 763
 764             return $prjc->relative($value);
 765           }
 766         }
 767       }
 768     }
 769   }
 770
 771   return undef;
 772 }
 773
 774
 775 sub get_multiple {
 776   my($self, $name) = @_;
 777   return $self->doif_multiple(
 778                   $self->create_array($self->get_value_with_default($name)));
 779 }
 780
 781
 782 sub doif_multiple {
 783   my($self, $value) = @_;
 784   return defined $value ? (scalar(@$value) > 1) : undef;
 785 }
 786
 787
 788 sub handle_multiple {
 789   my($self, $name) = @_;
 790   my $val = $self->get_value_with_default($name);
 791
 792   if (defined $val) {
 793     my $array = $self->create_array($val);
 794     $self->append_current(scalar(@$array));
 795   }
 796   else {
 797     $self->append_current(0);
 798   }
 799 }
 800
 801
 802 sub get_starts_with {
 803   my($self, $str) = @_;
 804   return $self->doif_starts_with([$str]);
 805 }
 806
 807
 808 sub doif_starts_with {
 809   my($self, $val) = @_;
 810
 811   if (defined $val) {
 812     my($name, $pattern) = $self->split_parameters("@$val");
 813     if (defined $name && defined $pattern) {
 814       return ($self->get_value_with_default($name) =~ /^$pattern/);
 815     }
 816   }
 817   return undef;
 818 }
 819
 820
 821 sub handle_starts_with {
 822   my($self, $str) = @_;
 823   $self->generic_handle('doif_starts_with', $str);
 824 }
 825
 826
 827 sub get_ends_with {
 828   my($self, $str) = @_;
 829   return $self->doif_ends_with([$str]);
 830 }
 831
 832
 833 sub doif_ends_with {
 834   my($self, $val) = @_;
 835
 836   if (defined $val) {
 837     my($name, $pattern) = $self->split_parameters("@$val");
 838     if (defined $name && defined $pattern) {
 839       return ($self->get_value_with_default($name) =~ /$pattern$/);
 840     }
 841   }
 842   return undef;
 843 }
 844
 845
 846 sub handle_ends_with {
 847   my($self, $str) = @_;
 848   $self->generic_handle('doif_ends_with', $str);
 849 }
 850
 851
 852 sub handle_keyname_used {
 853   my($self, $str) = @_;
 854
 855   if (defined $str) {
 856     my($name, $key) = $self->split_parameters($str);
 857     my $file = $self->get_value_with_default($name);
 858     if (defined $self->{'keyname_used'}->{$file}->{$key}) {
 859       $self->append_current($self->{'keyname_used'}->{$file}->{$key}++);
 860     }
 861     else {
 862       $self->{'keyname_used'}->{$file}->{$key} = 1;
 863     }
 864   }
 865 }
 866
 867
 868 sub handle_scope {
 869   my($self, $str) = @_;
 870
 871   if (defined $str) {
 872     my($state, $func, $param) = $self->split_parameters($str);
 873     if (defined $state) {
 874       my $pscope;
 875       my $scope = $self->{'scopes'};
 876
 877       while(defined $$scope{'scope'}) {
 878         $pscope = $scope;
 879         $scope = $$scope{'scope'};
 880       }
 881       if ($state eq 'enter') {
 882         if (defined $func) {
 883           $param = '' if (!defined $param);
 884           $$scope{'scope'}->{$func} = [$self->process_special($param),
 885                                        $_[0]->{'foreach'}->{'count'}];
 886         }
 887         else {
 888           $self->warning("The enter scope function requires a parameter.");
 889         }
 890       }
 891       elsif ($state eq 'leave') {
 892         if (defined $pscope) {
 893           delete $$pscope{'scope'};
 894         }
 895         else {
 896           $self->warning("leave scope function encountered without an enter.");
 897         }
 898       }
 899       else {
 900         $self->warning("Unrecognized scope function parameter: $state.");
 901       }
 902     }
 903     else {
 904       $self->warning("The scope function requires 1 to 3 parameters.");
 905     }
 906   }
 907 }
 908
 909 sub get_has_extension {
 910   my($self, $str) = @_;
 911   return $self->doif_has_extension([$str]);
 912 }
 913
 914
 915 sub doif_has_extension {
 916   my($self, $val) = @_;
 917
 918   if (defined $val) {
 919     return ($self->tp_basename(
 920                 $self->get_value_with_default("@$val")) =~ /\.[^\.]*$/);
 921   }
 922   return undef;
 923 }
 924
 925
 926 sub handle_has_extension {
 927   my($self, $str) = @_;
 928   $self->generic_handle('doif_has_extension', $str);
 929 }
 930
 931
 932 sub get_contains {
 933   my($self, $str) = @_;
 934   return $self->doif_contains([$str]);
 935 }
 936
 937
 938 sub doif_contains {
 939   my($self, $val) = @_;
 940
 941   if (defined $val) {
 942     my($name, $pattern) = $self->split_parameters("@$val");
 943     if (defined $name && defined $pattern) {
 944       $pattern = $self->get_match_pattern ($pattern);
 945       return ($self->get_value_with_default($name) =~ /$pattern/);
 946     }
 947   }
 948   return undef;
 949 }
 950
 951
 952 sub handle_contains {
 953   my($self, $str) = @_;
 954   $self->generic_handle('doif_contains', $str);
 955 }
 956
 957
 958 sub get_subst {
 959   my($self, $str) = @_;
 960   return $self->doif_subst([$str]);
 961 }
 962
 963
 964 sub doif_subst {
 965   my($self, $val) = @_;
 966
 967   if (defined $val) {
 968     my($name, $pattern, $replacement) = $self->split_parameters("@$val");
 969     if (defined $name && defined $pattern && defined $replacement) {
 970       my $result = $self->get_value_with_default($name);
 971       $result =~ s/$pattern/$replacement/g;
 972       return $result;
 973     }
 974   }
 975   return undef;
 976 }
 977
 978
 979 sub handle_subst {
 980   my($self, $str) = @_;
 981   $self->generic_handle('doif_subst', $str);
 982 }
 983
 984
 985 sub get_remove_from {
 986   my($self, $str) = @_;
 987   return $self->doif_remove_from($str);
 988 }
 989
 990
 991 sub doif_remove_from {
 992   my($self, $str) = @_;
 993   my @params = $self->split_parameters($str);
 994   my @removed = $self->perform_remove_from(\@params);
 995   return (defined $removed[0] ? 1 : undef);
 996 }
 997
 998
 999 sub perform_remove_from {
1000   my($self, $val) = @_;
1001   my($source, $pattern, $target, $tremove) = @$val;
1002
1003   ## $source should be a component name (e.g., source_files,
1004   ## header_files, etc.)  $target is a variable name
1005   ## $pattern and $tremove are optional; $pattern is a partial regular
1006   ## expression to match the end of the files found from $source.  The
1007   ## beginning of the regular expression is made from $target by removing
1008   ## $tremove from the end of it.
1009   if (defined $source && defined $target &&
1010       defined $self->{'values'}->{$source}) {
1011     my $tval = $self->get_value_with_default($target);
1012     if (defined $tval) {
1013       $tval =~ s/$tremove$// if (defined $tremove);
1014       $tval = $self->escape_regex_special($tval);
1015       my @removed;
1016       my $max = scalar(@{$self->{'values'}->{$source}});
1017       for(my $i = 0; $i < $max;) {
1018         if ($self->{'values'}->{$source}->[$i] =~ /^$tval$pattern$/) {
1019           push(@removed, splice(@{$self->{'values'}->{$source}}, $i, 1));
1020           $max--;
1021         }
1022         else {
1023           $i++;
1024         }
1025       }
1026       return @removed;
1027     }
1028   }
1029
1030   return ();
1031 }
1032
1033
1034 sub handle_remove_from {
1035   my($self, $str) = @_;
1036
1037   if (defined $str) {
1038     my @params = $self->split_parameters($str);
1039     my $val = $self->perform_remove_from(\@params);
1040     $self->append_current("@$val") if (defined $val);
1041   }
1042 }
1043
1044
1045 sub get_compares {
1046   my($self, $str) = @_;
1047   return $self->doif_compares([$str]);
1048 }
1049
1050
1051 sub doif_compares {
1052   my($self, $val) = @_;
1053
1054   if (defined $val) {
1055     my($name, $pattern) = $self->split_parameters("@$val");
1056     if (defined $name && defined $pattern) {
1057       return ($self->get_value_with_default($name) eq $pattern);
1058     }
1059   }
1060   return undef;
1061 }
1062
1063
1064 sub handle_compares {
1065   my($self, $str) = @_;
1066   $self->generic_handle('doif_compares', $str);
1067 }
1068
1069 sub get_vars_equal {
1070   my($self, $str) = @_;
1071   return $self->doif_vars_equal([$str]);
1072 }
1073
1074
1075 sub doif_vars_equal {
1076   my($self, $val) = @_;
1077
1078   if (defined $val) {
1079     my($var1, $var2) = $self->split_parameters("@$val");
1080     if (defined $var1 && defined $var2) {
1081       return ($self->get_value_with_default($var1) eq $self->get_value_with_default($var2));
1082     }
1083   }
1084   return undef;
1085 }
1086
1087
1088 sub handle_vars_equal {
1089   my($self, $str) = @_;
1090   $self->generic_handle('doif_vars_equal', $str);
1091 }
1092
1093
1094 sub get_reverse {
1095   my($self, $name) = @_;
1096   my $value = $self->get_value_with_default($name);
1097
1098   if (defined $value) {
1099     my @array = $self->perform_reverse($self->create_array($value));
1100     return \@array;
1101   }
1102
1103   return undef;
1104 }
1105
1106
1107 sub perform_reverse {
1108   my($self, $value) = @_;
1109   return reverse(@$value);
1110 }
1111
1112
1113 sub handle_reverse {
1114   my($self, $name) = @_;
1115   my $val = $self->get_value_with_default($name);
1116
1117   if (defined $val) {
1118     my @array = $self->perform_reverse($self->create_array($val));
1119     $self->append_current("@array");
1120   }
1121 }
1122
1123
1124 sub get_sort {
1125   my($self, $name) = @_;
1126   my $value = $self->get_value_with_default($name);
1127
1128   if (defined $value) {
1129     my @array = $self->perform_sort($self->create_array($value));
1130     return \@array;
1131   }
1132
1133   return undef;
1134 }
1135
1136
1137 sub perform_sort {
1138   my($self, $value) = @_;
1139   return sort(@$value);
1140 }
1141
1142
1143 sub handle_sort {
1144   my($self, $name) = @_;
1145   my $val = $self->get_value_with_default($name);
1146
1147   if (defined $val) {
1148     my @array = $self->perform_sort($self->create_array($val));
1149     $self->append_current("@array");
1150   }
1151 }
1152
1153
1154 sub get_uniq {
1155   my($self, $name) = @_;
1156   my $value = $self->get_value_with_default($name);
1157
1158   if (defined $value) {
1159     my @array = $self->perform_uniq($self->create_array($value));
1160     return \@array;
1161   }
1162
1163   return undef;
1164 }
1165
1166
1167 sub perform_uniq {
1168   my($self, $value) = @_;
1169   my %value;
1170   @value{@$value} = ();
1171   return sort(keys %value);
1172 }
1173
1174
1175 sub handle_uniq {
1176   my($self, $name) = @_;
1177   my $val = $self->get_value_with_default($name);
1178
1179   if (defined $val) {
1180     my @array = $self->perform_uniq($self->create_array($val));
1181     $self->append_current("@array");
1182   }
1183 }
1184
1185
1186 sub process_compound_if {
1187   my($self, $str) = @_;
1188
1189   if (index($str, '||') >= 0) {
1190     my $ret = 0;
1191     foreach my $v (split(/\s*\|\|\s*/, $str)) {
1192       $ret |= $self->process_compound_if($v);
1193       return 1 if ($ret != 0);
1194     }
1195     return 0;
1196   }
1197   elsif (index($str, '&&') >= 0) {
1198     my $ret = 1;
1199     foreach my $v (split(/\s*\&\&\s*/, $str)) {
1200       $ret &&= $self->process_compound_if($v);
1201       return 0 if ($ret == 0);
1202     }
1203     return 1;
1204   }
1205   else {
1206     ## See if we need to reverse the return value
1207     my $not = 0;
1208     if ($str =~ /^!+(.*)/) {
1209       $not = 1;
1210       $str = $1;
1211     }
1212
1213     ## Get the value based on the string
1214     my @cmds;
1215     my $val;
1216     while($str =~ /(\w+)\((.+)\)(.*)/) {
1217       if ($3 eq '') {
1218         push(@cmds, $1);
1219         $str = $2;
1220       }
1221       else {
1222         ## If there is something trailing the closing parenthesis then
1223         ## the whole thing is considered a parameter to the first
1224         ## function.
1225         last;
1226       }
1227     }
1228
1229     if (defined $cmds[0]) {
1230       ## Start out calling get_xxx on the string
1231       my $type = $get_type;
1232       my $prefix = 'get_';
1233
1234       $val = $str;
1235
1236       ## If there is only one command, we have to add it to the list
1237       ## again so that we can get the variable value and then use
1238       ## the doif_ version to test it, unless the get_ function
1239       ## also performs the doif_ functionality.
1240       if ($#cmds == 0 && defined $keywords{$cmds[0]} &&
1241           ($keywords{$cmds[0]} & $doif_type) != 0 &&
1242           ($keywords{$cmds[0]} & $get_combined_type) == 0) {
1243         push(@cmds, $cmds[0]);
1244       }
1245
1246       foreach my $cmd (reverse @cmds) {
1247         if (defined $keywords{$cmd} && ($keywords{$cmd} & $type) != 0) {
1248           my $func = "$prefix$cmd";
1249           $val = $self->$func($val);
1250
1251           ## Now that we have a value, we need to switch over
1252           ## to calling doif_xxx
1253           $type = $doif_type;
1254           $prefix = 'doif_';
1255         }
1256         else {
1257           $self->warning("Unable to use $cmd in if (no $prefix method).");
1258         }
1259       }
1260     }
1261     else {
1262       $val = $self->get_value($str);
1263     }
1264
1265     ## See if any portion of the value is defined and not empty
1266     my $ret = 0;
1267     if (defined $val) {
1268       if (UNIVERSAL::isa($val, 'ARRAY')) {
1269         foreach my $v (@$val) {
1270           if ($v ne '') {
1271             $ret = 1;
1272             last;
1273           }
1274         }
1275       }
1276       elsif ($val ne '') {
1277         $ret = 1;
1278       }
1279     }
1280     return ($not ? !$ret : $ret);
1281   }
1282 }
1283
1284
1285 sub handle_if {
1286   my($self, $val) = @_;
1287   my $name = 'endif';
1288
1289   push(@{$self->{'lstack'}},
1290        "<%if($val)%> (" . $self->get_line_number() . '?)');
1291   if ($self->{'if_skip'}) {
1292     push(@{$self->{'sstack'}}, "*$name");
1293   }
1294   else {
1295     ## Determine if we are skipping the portion of this if statement
1296     ## $val will always be defined since we won't get into this method
1297     ## without properly parsing the if statement.
1298     $self->{'if_skip'} = !$self->process_compound_if($val);
1299     push(@{$self->{'sstack'}}, $name);
1300   }
1301 }
1302
1303
1304 sub handle_else {
1305   my $self  = shift;
1306   my @scopy = @{$self->{'sstack'}};
1307   my $index = index($scopy[$#scopy], 'endif');
1308   if ($index >= 0) {
1309     if ($index == 0) {
1310       $self->{'if_skip'} ^= 1;
1311     }
1312     $self->{'sstack'}->[$#scopy] .= ':';
1313   }
1314
1315   return 'Unmatched else' if (($self->{'sstack'}->[$#scopy] =~ tr/:/:/) > 1);
1316   return undef;
1317 }
1318
1319
1320 sub handle_foreach {
1321   my $self        = shift;
1322   my $val = lc(shift);
1323   my $name = 'endfor';
1324   my $errorString;
1325
1326   push(@{$self->{'lstack'}}, $self->get_line_number());
1327   if (!$self->{'if_skip'}) {
1328     my $base = 1;
1329     my $vname;
1330     if ($val =~ /flag_overrides\([^\)]+\)/) {
1331     }
1332     elsif ($val =~ /([^,]*),(.*)/) {
1333       $vname = $1;
1334       $val   = $2;
1335       $vname =~ s/^\s+//;
1336       $vname =~ s/\s+$//;
1337       $val   =~ s/^\s+//;
1338       $val   =~ s/\s+$//;
1339
1340       if ($vname eq '') {
1341         $errorString = 'The foreach variable name is not valid';
1342       }
1343
1344       if ($val =~ /([^,]*),(.*)/) {
1345         $base = $1;
1346         $val  = $2;
1347         $base =~ s/^\s+//;
1348         $base =~ s/\s+$//;
1349         $val  =~ s/^\s+//;
1350         $val  =~ s/\s+$//;
1351
1352         if ($base !~ /^\d+$/) {
1353           $errorString = 'The forcount specified is not a valid number';
1354         }
1355       }
1356       elsif ($vname =~ /^\d+$/) {
1357         $base  = $vname;
1358         $vname = undef;
1359       }
1360
1361       ## Due to the way flag_overrides works, we can't allow
1362       ## the user to name the foreach variable when dealing
1363       ## with variables that can be used with the -> operator
1364       if (defined $vname) {
1365         foreach my $ref (keys %arrow_op_ref) {
1366           my $name_re  = $ref . 's';
1367           if ($val =~ /^$ref\->/ || $val =~ /^$name_re$/) {
1368             $errorString = 'The foreach variable can not be ' .
1369                            'named when dealing with ' .
1370                            $arrow_op_ref{$ref};
1371           }
1372         }
1373       }
1374     }
1375
1376     push(@{$self->{'sstack'}}, $name);
1377     my $index = ++$self->{'foreach'}->{'count'};
1378
1379     $self->{'foreach'}->{'base'}->[$index]  = $base;
1380     $self->{'foreach'}->{'name'}->[$index]  = $vname;
1381     $self->{'foreach'}->{'vars'}->[$index]  = $val;
1382     $self->{'foreach'}->{'text'}->[$index]  = '';
1383     $self->{'foreach'}->{'scope'}->[$index] = {};
1384     $self->{'foreach'}->{'scope_name'}->[$index] = undef;
1385   }
1386   else {
1387     push(@{$self->{'sstack'}}, "*$name");
1388   }
1389
1390   return $errorString;
1391 }
1392
1393
1394 sub handle_special {
1395   my($self, $name, $val) = @_;
1396
1397   ## If $name (fornotlast, forfirst, etc.) is set to 1
1398   ## Then we append the $val onto the current string that's
1399   ## being built.
1400   $self->append_current($val) if ($self->get_value($name));
1401 }
1402
1403
1404 sub get_uc {
1405   my($self, $name) = @_;
1406   return uc($self->get_value_with_default($name));
1407 }
1408
1409
1410 sub handle_uc {
1411   my($self, $name) = @_;
1412   $self->append_current($self->get_uc($name));
1413 }
1414
1415
1416 sub perform_uc {
1417   my($self, $value) = @_;
1418   my @val;
1419   foreach my $val (@$value) {
1420     push(@val, uc($val));
1421   }
1422   return @val;
1423 }
1424
1425
1426 sub get_lc {
1427   my($self, $name) = @_;
1428   return lc($self->get_value_with_default($name));
1429 }
1430
1431
1432 sub handle_lc {
1433   my($self, $name) = @_;
1434   $self->append_current($self->get_lc($name));
1435 }
1436
1437
1438 sub perform_lc {
1439   my($self, $value) = @_;
1440   my @val;
1441   foreach my $val (@$value) {
1442     push(@val, lc($val));
1443   }
1444   return @val;
1445 }
1446
1447
1448 sub handle_ucw {
1449   my($self, $name) = @_;
1450   my $val = $self->get_value_with_default($name);
1451
1452   substr($val, 0, 1) = uc(substr($val, 0, 1));
1453   while($val =~ /[_\s]([a-z])/) {
1454     my $uc = uc($1);
1455     $val =~ s/[_\s][a-z]/ $uc/;
1456   }
1457   $self->append_current($val);
1458 }
1459
1460
1461 sub actual_normalize {
1462   $_[1] =~ tr/ \t\/\\\-$()./_/;
1463   return $_[1];
1464 }
1465
1466 sub perform_normalize {
1467   my($self, $value) = @_;
1468   my @val;
1469   foreach my $val (@$value) {
1470     push(@val, $self->actual_normalize($val));
1471   }
1472   return @val;
1473 }
1474
1475
1476 sub get_normalize {
1477   my($self, $name) = @_;
1478   return $self->actual_normalize($self->get_value_with_default($name));
1479 }
1480
1481
1482 sub handle_normalize {
1483   my($self, $name) = @_;
1484   $self->append_current($self->get_normalize($name));
1485 }
1486
1487
1488 sub actual_noextension {
1489   $_[1] =~ s/\.[^\.]*$//;
1490   return $_[1];
1491 }
1492
1493
1494 sub perform_noextension {
1495   my($self, $value) = @_;
1496   my @val;
1497   foreach my $val (@$value) {
1498     push(@val, $self->actual_noextension($val));
1499   }
1500   return @val;
1501 }
1502
1503
1504 sub get_noextension {
1505   my($self, $name) = @_;
1506   return $self->actual_noextension($self->get_value_with_default($name));
1507 }
1508
1509 sub handle_noextension {
1510   my($self, $name) = @_;
1511   $self->append_current($self->get_noextension($name));
1512 }
1513
1514
1515 sub perform_full_path {
1516   my($self, $value) = @_;
1517   my @val;
1518   foreach my $val (@$value) {
1519     push(@val, $self->actual_full_path($val));
1520   }
1521   return @val;
1522 }
1523
1524
1525 sub get_full_path {
1526   my($self, $name) = @_;
1527   return $self->actual_full_path($self->get_value_with_default($name));
1528 }
1529
1530
1531 sub actual_full_path {
1532   my($self, $value) = @_;
1533
1534   ## Expand all defined env vars
1535   $value =~ s/\$\((\w+)\)/$ENV{$1} || '$(' . $1 . ')'/ge;
1536
1537   ## If we expanded all env vars, get absolute path
1538   if ($value =~ /\$\(\w+\)/) {
1539     $self->{'error_in_handle'} = "<%full_path%> couldn't expand " .
1540                                  "environment variables in $value";
1541     return $value;
1542   }
1543
1544   ## Always convert the slashes since they may be in the OS native
1545   ## format and we need them in UNIX format.
1546   $value =~ s/\\/\//g;
1547   my $dir = $self->mpc_dirname($value);
1548   if (-e $dir) {
1549     $dir = $self->abs_path($dir);
1550   }
1551   elsif ($self->{'prjc'}->path_is_relative($dir)) {
1552     ## If the directory is is not already an absolute path, then we will
1553     ## assume that the directory is relative to the current directory
1554     ## (which will be the location of the MPC file).
1555     $dir = $self->getcwd() . '/' . $dir;
1556   }
1557
1558   ## Create the full path value, remove directories represented as '.' and
1559   ## convert the slashes if necessary.
1560   $value = $dir . '/' . $self->mpc_basename($value);
1561   $value =~ s/\/\.\//\//g;
1562   $value =~ s/\/\.$//;
1563   $value =~ s/\//\\/g if ($self->{'cslashes'});
1564   return $value;
1565 }
1566
1567
1568 sub handle_full_path {
1569   my($self, $name) = @_;
1570   my $val = $self->get_value_with_default($name);
1571
1572   $self->append_current($self->actual_full_path($val));
1573 }
1574
1575
1576 sub perform_extensions {
1577   my($self, $value) = @_;
1578   my @val;
1579   foreach my $val (@$value) {
1580     push(@val, $self->{'prjc'}->get_component_extensions($val));
1581   }
1582   return @val;
1583 }
1584
1585
1586 sub handle_extensions {
1587   my($self, $name) = @_;
1588   my @val = $self->perform_extensions([$name]);
1589   $self->append_current("@val");
1590 }
1591
1592
1593 sub evaluate_nested_functions {
1594   my($self, $funcname, $args) = @_;
1595   my @params = $self->split_parameters($args);
1596   my @results;
1597   foreach my $param (@params) {
1598     my @cmds;
1599     my $val = $param;
1600
1601     while($val =~ /(\w+)\((.+)\)/) {
1602       push(@cmds, $1);
1603       $val = $2;
1604     }
1605
1606     if (scalar @cmds == 0) {
1607       push @results, $val;
1608       next;
1609     }
1610
1611     my $type = $get_type;
1612     my $prefix = 'get_';
1613     foreach my $cmd (reverse @cmds) {
1614       if (defined $keywords{$cmd} && ($keywords{$cmd} & $type) != 0) {
1615         my $func = "$prefix$cmd";
1616         if ($type == $get_type) {
1617           $val = $self->$func($val);
1618           $val = [ $val ] if (!UNIVERSAL::isa($val, 'ARRAY'));
1619           ## Now that we have a value, we need to switch over
1620           ## to calling perform_xxx
1621           $type = $perform_type;
1622           $prefix = 'perform_';
1623         }
1624         else {
1625           my @array = $self->$func($val);
1626           $val = \@array;
1627         }
1628       }
1629       else {
1630         $self->warning("Unable to use $cmd in nested " .
1631                        "functions (no $prefix method).");
1632       }
1633     }
1634     push @results, "@$val";
1635   }
1636
1637   if (defined $keywords{$funcname} && ($keywords{$funcname} & $perform_type)) {
1638     my $func = 'perform_' . $funcname;
1639     my @array = $self->$func(\@results);
1640     $self->append_current("@array");
1641     if ($keywords{$funcname} & $post_type) {
1642       $func = 'post_' . $funcname;
1643       $self->$func();
1644     }
1645   }
1646   else {
1647     $self->warning("Unable to use $funcname in nested " .
1648                    "functions (no perform_ method).");
1649   }
1650 }
1651
1652
1653 sub perform_dirname {
1654   my($self, $value) = @_;
1655   my @val;
1656   foreach my $val (@$value) {
1657     push(@val, $self->tp_dirname($val));
1658   }
1659   return @val;
1660 }
1661
1662
1663 sub get_dirname {
1664   my($self, $name) = @_;
1665   return $self->tp_dirname($self->get_value_with_default($name));
1666 }
1667
1668
1669 sub doif_dirname {
1670   my($self, $value) = @_;
1671
1672   if (defined $value) {
1673     $value = $self->tp_dirname($value);
1674     return ($value ne '.');
1675   }
1676   return undef;
1677 }
1678
1679
1680 sub handle_dirname {
1681   my($self, $name) = @_;
1682
1683   $self->append_current(
1684             $self->tp_dirname($self->get_value_with_default($name)));
1685 }
1686
1687
1688 sub perform_basename {
1689   my($self, $value) = @_;
1690   my @val;
1691   foreach my $val (@$value) {
1692     push(@val, $self->tp_basename($val));
1693   }
1694   return @val;
1695 }
1696
1697
1698 sub get_basename {
1699   my($self, $name) = @_;
1700   return $self->tp_basename($self->get_value_with_default($name));
1701 }
1702
1703
1704 sub doif_basename {
1705   my($self, $value) = @_;
1706
1707   if (defined $value) {
1708     $value = $self->tp_basename($value);
1709     return ($value ne '.');
1710   }
1711   return undef;
1712 }
1713
1714
1715 sub handle_basename {
1716   my($self, $name) = @_;
1717
1718   $self->append_current(
1719             $self->tp_basename($self->get_value_with_default($name)));
1720 }
1721
1722
1723 sub handle_basenoextension {
1724   my($self, $name) = @_;
1725   my $val = $self->tp_basename($self->get_value_with_default($name));
1726
1727   $val =~ s/\.[^\.]*$//;
1728   $self->append_current($val);
1729 }
1730
1731
1732 sub handle_flag_overrides {
1733   my($self, $name) = @_;
1734   my $value = $self->get_flag_overrides($name);
1735   $self->append_current(UNIVERSAL::isa($value, 'ARRAY') ?
1736                           "@$value" : $value) if (defined $value);
1737 }
1738
1739
1740 sub handle_marker {
1741   my($self, $name) = @_;
1742   my $val = $self->{'prjc'}->get_verbatim($name);
1743   $self->append_current($val) if (defined $val);
1744 }
1745
1746
1747 sub handle_eval {
1748   my($self, $name) = @_;
1749   my $val = $self->get_value_with_default($name);
1750
1751   if (defined $val) {
1752     if (index($val, "<%eval($name)%>") >= 0) {
1753       $self->warning("Infinite recursion detected in '$name'.");
1754     }
1755     else {
1756       ## Enter the eval state
1757       ++$self->{'eval'};
1758
1759       ## Parse the eval line
1760       my($status, $error) = $self->parse_line(undef, $val);
1761       if ($status) {
1762         $self->{'built'} .= $self->{'eval_str'};
1763       }
1764       else {
1765         $self->warning($error);
1766       }
1767
1768       ## Leave the eval state
1769       --$self->{'eval'};
1770       $self->{'eval_str'} = '';
1771     }
1772   }
1773 }
1774
1775
1776 sub handle_pseudo {
1777   my($self, $name) = @_;
1778   $self->append_current($self->{'cmds'}->{$name});
1779 }
1780
1781
1782 sub get_duplicate_index {
1783   my($self, $name) = @_;
1784   return $self->doif_duplicate_index($self->get_value_with_default($name));
1785 }
1786
1787
1788 sub doif_duplicate_index {
1789   my($self, $value) = @_;
1790
1791   if (defined $value) {
1792     my $base = lc($self->tp_basename($value));
1793     my $path = $self->validated_dirname($value);
1794
1795     if (!defined $self->{'dupfiles'}->{$base}) {
1796       $self->{'dupfiles'}->{$base} = [$path];
1797     }
1798     else {
1799       my $index = 1;
1800       foreach my $file (@{$self->{'dupfiles'}->{$base}}) {
1801         return $index if ($file eq $path);
1802         ++$index;
1803       }
1804
1805       push(@{$self->{'dupfiles'}->{$base}}, $path);
1806       return 1;
1807     }
1808   }
1809
1810   return undef;
1811 }
1812
1813
1814 sub handle_duplicate_index {
1815   my($self, $name) = @_;
1816   my $value = $self->doif_duplicate_index(
1817                        $self->get_value_with_default($name));
1818   $self->append_current($value) if (defined $value);
1819 }
1820
1821 sub actual_transdir {
1822  my($self, $value) = @_;
1823
1824   if ($value =~ /([\/\\])/) {
1825     return $self->{'prjc'}->translate_directory(
1826                                   $self->tp_dirname($value)) . $1;
1827   }
1828
1829   return undef;
1830 }
1831
1832 sub get_transdir {
1833   my($self, $name) = @_;
1834   return $self->actual_transdir($self->get_value_with_default($name));
1835 }
1836
1837
1838 sub doif_transdir {
1839   my($self, $value) = @_;
1840
1841   return (defined $value ? $self->actual_transdir($value) : undef);
1842 }
1843
1844
1845 sub handle_transdir {
1846   my($self, $name) = @_;
1847   my $value = $self->actual_transdir($self->get_value_with_default($name));
1848   $self->append_current($value) if (defined $value);
1849 }
1850
1851
1852 sub handle_create_aux_file {
1853   my $self = shift;
1854   my @fname = $self->perform_create_aux_file([$self->split_parameters(shift)]);
1855   $self->append_current($fname[0]);
1856   $self->post_create_aux_file();
1857 }
1858
1859
1860 sub post_create_aux_file {
1861   my $self = shift;
1862   $self->{'aux_file'} = $self->{'aux_temp'};
1863   $self->{'aux_temp'} = undef;
1864 }
1865
1866
1867 sub perform_create_aux_file {
1868   my($self, $argsref) = @_;
1869
1870   if (defined $self->{'aux_file'}) {
1871     $self->{'error_in_handle'} = "Can't nest create_aux_file commands.";
1872     return undef;
1873   }
1874
1875   my $fname = '';
1876   foreach my $arg (@$argsref) {
1877     my $val = $self->get_value($arg);
1878     $fname .= defined $val ?
1879         (UNIVERSAL::isa($val, 'ARRAY') ? join('_', @$val) : $val) : $arg;
1880   }
1881
1882   my $dir = $self->mpc_dirname($self->{'prjc'}->get_outdir() . '/' .
1883                                $self->{'prjc'}->{'assign'}->{'project_file'});
1884   $dir .= '/' . $self->mpc_dirname($fname) if ($fname =~ /[\/\\]/);
1885
1886   $self->{'aux_temp'} = {'dir' => $dir,
1887                          'filename' => $self->mpc_basename($fname),
1888                          'foreach_baseline' => $self->{'foreach'}->{'count'}};
1889   return $fname;
1890 }
1891
1892
1893 sub handle_end_aux_file {
1894   my $self = shift;
1895   if (!defined $self->{'aux_file'}) {
1896     $self->{'error_in_handle'} = 'end_aux_file seen before create_aux_file';
1897   }
1898   else {
1899     my $af = $self->{'aux_file'};
1900     mkpath($af->{'dir'}, 0, 0777) if ($af->{'dir'} ne '.');
1901     my $fh = new FileHandle('> ' . $af->{'dir'} . '/' . $af->{'filename'});
1902     if (defined $fh) {
1903       print $fh $af->{'text'};
1904       close($fh);
1905     }
1906     else {
1907       $self->{'error_in_handle'} = "Couldn't open: " . $af->{'dir'} . '/' .
1908                                    $af->{'filename'};
1909     }
1910     $self->{'aux_file'} = undef;
1911   }
1912 }
1913
1914
1915 sub handle_translate_vars {
1916   my($self, $arg) = @_;
1917   my @params = $self->split_parameters($arg);
1918   $self->append_current($self->perform_translate_vars([@params]));
1919 }
1920
1921 sub get_translate_vars {
1922   my ($self, $str) = @_;
1923   my @params = $self->split_parameters($str);
1924   return $self->perform_translate_vars([@params]);
1925 }
1926
1927 sub perform_translate_vars {
1928   my($self, $arg) = @_;
1929
1930   ## If the first parameter is a template variable with a value, use it.
1931   ## Otherwise, use the parameter as the value.
1932   my $val = $self->get_value($arg->[0]);
1933   $val = $arg->[0] unless defined $val;
1934
1935   ## If the second optional parameter is provided, use it.  Otherwise,
1936   ## use the operating system found in the command substitution map.
1937   my $os = (defined $arg->[1] && $arg->[1] ne '') ?
1938            $arg->[1] : $self->{'prjc'}->{'command_subs'}->{'os'};
1939
1940   ## Get the variable reference characters based on the operating system
1941   ## for which we are generating this project.
1942   my ($pre, $post) = ($os eq 'win32') ? ('%', '%') : ('${', '}');
1943
1944   ## Replace $() with the environment variable reference characters.
1945   $val =~ s{\$\(([^)]+)\)([^\s\$]*)}{my ($var, $rest) = ($1, $2);
1946                                      $rest =~ s!/!\\!g if $os eq 'win32';
1947                                      "$pre$var$post$rest"}ge;
1948   return $val;
1949 }
1950
1951
1952 sub handle_convert_slashes {
1953   my($self, $arg) = @_;
1954   my @params = $self->split_parameters($arg);
1955   $self->append_current($self->perform_convert_slashes([@params]));
1956 }
1957
1958
1959 sub perform_convert_slashes {
1960   my($self, $arg) = @_;
1961
1962   ## If the first parameter is a template variable with a value, use it.
1963   ## Otherwise, use the parameter as the value.
1964   my $val = $self->get_value($arg->[0]);
1965   $val = $arg->[0] unless defined $val;
1966
1967   ## If the second optional parameter is provided, use it.  Otherwise,
1968   ## use the operating system found in the command substitution map.
1969   my $os = (defined $arg->[1] && $arg->[1] ne '') ?
1970            $arg->[1] : $self->{'prjc'}->{'command_subs'}->{'os'};
1971
1972   ## Replace forward slashes with backslashes if we're generating this
1973   ## project specific to Windows.
1974   $val =~ s!/!\\!g if $os eq 'win32';
1975
1976   return $val;
1977 }
1978
1979
1980 sub handle_new_guid {
1981   my($self, $name) = @_;
1982   my $val = $self->get_value_with_default($name);
1983   my $prjc = $self->{'prjc'};
1984   my $guid = GUID::generate($val ? $val : $name,
1985                             $prjc->{'current_input'},
1986                             File::Spec->abs2rel($prjc->getcwd(),
1987                                                 $prjc->getstartdir()));
1988   $self->append_current($guid);
1989 }
1990
1991
1992 sub handle_deref {
1993   my($self, $name) = @_;
1994   my $val = $self->get_value_with_default($self->get_value_with_default($name));
1995   $self->append_current($val);
1996 }
1997
1998
1999 sub handle_set {
2000   my($self, $val) = @_;
2001   my @params = $self->split_parameters($val);
2002   if ($#params == 1) {
2003     $self->{'values'}->{lc($params[0])} = $params[1];
2004   }
2005   else {
2006     $self->{'error_in_handle'} = 'set() requires a name and a value';
2007   }
2008 }
2009
2010
2011 sub get_is_relative {
2012   my($self, $name) = @_;
2013   return $self->doif_is_relative($self->get_value_with_default($name));
2014 }
2015
2016
2017 sub doif_is_relative {
2018   my($self, $val) = @_;
2019   return $self->{'prjc'}->path_is_relative($val) if (defined $val);
2020   return undef;
2021 }
2022
2023
2024 sub handle_is_relative {
2025   my($self, $name) = @_;
2026   my $val = $self->get_value_with_default($name);
2027   $self->append_current(
2028          $self->{'prjc'}->path_is_relative($val) ? '1' : '0') if (defined $val);
2029 }
2030
2031
2032 sub get_is_custom_input {
2033   my($self, $name) = @_;
2034   return $self->doif_is_custom_input($self->get_value_with_default($name));
2035 }
2036
2037
2038 sub doif_is_custom_input {
2039   my($self, $val) = @_;
2040
2041   ## Create an array reference from the custom_types string value.
2042   my $custom_types = $self->{'prjc'}->get_assignment('custom_types');
2043   my $ctypes = $self->create_array(defined $custom_types ? $custom_types : '');
2044
2045   foreach my $ctype (@$ctypes) {
2046     ## Get the input files for each custom type.  We cache it to avoid
2047     ## generating the custom inputs for each and every call.  This function
2048     ## is usually called within a foreach context, so it will be called many
2049     ## times per run.
2050     my $inputs;
2051     if (defined $self->{'custom_input_cache'}->{$ctype}) {
2052       $inputs = $self->{'custom_input_cache'}->{$ctype};
2053     }
2054     else {
2055       $inputs = $self->{'prjc'}->get_custom_value('input_files', $ctype);
2056       $self->{'custom_input_cache'}->{$ctype} = $inputs;
2057     }
2058
2059     ## Once we have the inputs, see if any of them match the current file
2060     foreach my $input (@$inputs) {
2061       ## There are various ways that the user could list files such that
2062       ## a custom input could physically match a built-in file listing
2063       ## but not be equal, in a string comparison sense.  Resolving those
2064       ## differences requires path traversal and that the files actually
2065       ## exist (which isn't guaranteed at project generation time).  So,
2066       ## we do the minimal comparison using the file_sorter on the
2067       ## ProjectCreator to handle case sensitivity automatically.
2068       return 1 if ($self->{'prjc'}->file_sorter($input, $val) == 0);
2069     }
2070   }
2071
2072   ## There are either no custom types or there isn't a custom input file
2073   ## that matches the one we're currently processing.
2074   return undef;
2075 }
2076
2077
2078 sub handle_is_custom_input {
2079   my($self, $name) = @_;
2080   my $val = $self->get_value_with_default($name);
2081   $self->append_current(
2082     $self->doif_is_custom_input($val) ? '1' : '0') if (defined $val);
2083 }
2084
2085
2086 sub get_extension {
2087   my($self, $name) = @_;
2088   my $val = $self->get_value_with_default($name);
2089   return ($val =~ /(\.[^\.]+)$/ ? $1 : '');
2090 }
2091
2092
2093 sub handle_extension {
2094   my($self, $name) = @_;
2095   $self->append_current($self->get_extension($name));
2096 }
2097
2098
2099 sub prepare_parameters {
2100   my($self, $prefix) = @_;
2101   my $input = $self->get_value($prefix . '->input_file');
2102   my $output;
2103   my $indir;
2104   my $outdir;
2105
2106   if (defined $input) {
2107     $input =~ s/\//\\/g if ($self->{'cslashes'});
2108     $indir = $self->tp_dirname($input);
2109     $output = $self->get_value($prefix . '->input_file->output_files');
2110
2111     if (defined $output) {
2112       my $size = scalar(@$output);
2113       for(my $i = 0; $i < $size; ++$i) {
2114         my $fo = $self->get_flag_overrides($prefix . '->input_file, gendir');
2115         if (defined $fo) {
2116           $outdir = $self->tp_dirname($$output[$i]);
2117           if (!($outdir ne '' && $indir ne $outdir && $fo ne $outdir)) {
2118             $$output[$i] = ($fo eq '.' ? '' : $fo . '/') .
2119                           $self->tp_basename($$output[$i]);
2120           }
2121         }
2122         $$output[$i] =~ s/\//\\/g if ($self->{'cslashes'});
2123       }
2124     }
2125   }
2126
2127   ## Set the parameters array with the determined input and output files
2128   return $input, $output;
2129 }
2130
2131
2132 sub process_name {
2133   my($self, $line) = @_;
2134   my $length = 0;
2135   my $errorString;
2136
2137   ## Split the line into a name and value
2138   if ($line =~ /$process_name_re1/) {
2139     my $name = lc($1);
2140     my $val  = $3;
2141     $length += length($name);
2142
2143     if (defined $val) {
2144       ## Check for the parenthesis
2145       if (($val =~ tr/(//) != ($val =~ tr/)//)) {
2146         return 'Missing the closing parenthesis', $length;
2147       }
2148
2149       ## Add the length of the value plus 2 for the surrounding ()
2150       $length += length($val) + 2;
2151     }
2152
2153     if (defined $keywords{$name}) {
2154       if ($name eq 'if') {
2155         $self->handle_if($val);
2156       }
2157       elsif ($name eq 'endif') {
2158         $errorString = $self->handle_endif($name);
2159       }
2160       elsif ($name eq 'else') {
2161         $errorString = $self->handle_else();
2162       }
2163       elsif ($name eq 'endfor') {
2164         $errorString = $self->handle_endfor($name);
2165       }
2166       elsif ($name eq 'foreach') {
2167         $errorString = $self->handle_foreach($val);
2168       }
2169       elsif ($name eq 'fornotlast'  || $name eq 'forlast' ||
2170              $name eq 'fornotfirst' || $name eq 'forfirst') {
2171         if (!$self->{'if_skip'}) {
2172           $self->handle_special($name, $self->process_special($val));
2173         }
2174       }
2175       elsif ($name eq 'comment') {
2176         ## Ignore the contents of the comment
2177       }
2178       else {
2179         if (!$self->{'if_skip'}) {
2180           if (index($val, '(') >= 0) {
2181             $self->evaluate_nested_functions($name, $val);
2182           }
2183           else {
2184             my $func = 'handle_' . $name;
2185             $self->$func($val);
2186             if ($self->{'error_in_handle'}) {
2187               $errorString = $self->{'error_in_handle'};
2188             }
2189           }
2190         }
2191       }
2192     }
2193     elsif (defined $self->{'cmds'}->{$name}) {
2194       $self->handle_pseudo($name) if (!$self->{'if_skip'});
2195     }
2196     else {
2197       if (!$self->{'if_skip'}) {
2198         if (defined $val && !defined $self->{'defaults'}->{$name}) {
2199           $self->{'defaults'}->{$name} = $self->process_special($val);
2200         }
2201         $self->append_current($self->get_value_with_default($name));
2202       }
2203     }
2204   }
2205   else {
2206     my $error  = $line;
2207     my $length = length($line);
2208     for(my $i = 0; $i < $length; ++$i) {
2209       my $part = substr($line, $i, 2);
2210       if ($part eq '%>') {
2211         $error = substr($line, 0, $i + 2);
2212         last;
2213       }
2214     }
2215     $errorString = "Unable to parse line starting at '$error'";
2216   }
2217
2218   return $errorString, $length;
2219 }
2220
2221
2222 sub collect_data {
2223   my $self  = shift;
2224   my $prjc = $self->{'prjc'};
2225   my $cwd = $self->getcwd();
2226
2227   ## Set the current working directory
2228   $cwd =~ s/\//\\/g if ($self->{'cslashes'});
2229   $self->{'values'}->{'cwd'} = $cwd;
2230
2231   ## Collect the components into {'values'} somehow
2232   foreach my $key (keys %{$prjc->{'valid_components'}}) {
2233     my @list = $prjc->get_component_list($key);
2234     $self->{'values'}->{$key} = \@list if (defined $list[0]);
2235   }
2236
2237   ## If there is a staticname and no sharedname then this project
2238   ## 'type_is_static'.  If we are generating static projects, let
2239   ## all of the templates know that we 'need_staticflags'.
2240   ## If there is a sharedname then this project 'type_is_dynamic'.
2241   my $sharedname = $prjc->get_assignment('sharedname');
2242   my $staticname = $prjc->get_assignment('staticname');
2243   if (!defined $sharedname && defined $staticname) {
2244     $self->{'override_target_type'} = 1;
2245     $self->{'values'}->{'type_is_static'}   = 1;
2246     $self->{'values'}->{'need_staticflags'} = 1;
2247   }
2248   elsif ($prjc->get_static() == 1) {
2249     $self->{'values'}->{'need_staticflags'} = 1;
2250   }
2251   elsif (defined $sharedname) {
2252     $self->{'values'}->{'type_is_dynamic'} = 1;
2253   }
2254
2255   ## If there is a sharedname or exename then this project
2256   ## 'type_is_binary'.
2257   if (defined $sharedname ||
2258       defined $prjc->get_assignment('exename')) {
2259     $self->{'values'}->{'type_is_binary'} = 1;
2260   }
2261
2262   ## A tiny hack (mainly for VC6 projects)
2263   ## for the workspace creator.  It needs to know the
2264   ## target names to match up with the project name.
2265   $prjc->update_project_info($self, 0, ['project_name']);
2266
2267   ## This is for all projects
2268   $prjc->update_project_info($self, 1, ['after']);
2269
2270   ## VC7 Projects need to know the GUID.
2271   ## We need to save this value in our known values
2272   ## since each guid generated will be different.  We need
2273   ## this to correspond to the same guid used in the workspace.
2274   my $guid = $prjc->update_project_info($self, 1, ['guid']);
2275   $self->{'values'}->{'guid'} = $guid;
2276
2277   ## In order for VC7 to mix languages, we need to keep track
2278   ## of the language associated with each project.
2279   $prjc->update_project_info($self, 1, ['language']);
2280
2281   ## For VC7+ to properly work with wince, which is cross compiled,
2282   ## a new platform-specific token is added, nocross, which is used
2283   ## to determine if a project is even to be built for non-native
2284   ## targets. Additionally, custom-only projects are built but not
2285   ## deployed, thus these are added to the project_info mix
2286   $prjc->update_project_info($self, 1, ['custom_only']);
2287   $prjc->update_project_info($self, 1, ['nocross']);
2288
2289   ## For VC8 to be able to add references to managed DLL's to the current
2290   ## managed DLL project (if it is one), we need to keep track of whether
2291   ## the project is 'managed' or not.
2292   $prjc->update_project_info($self, 1, ['managed']);
2293
2294   ## For WiX, only generate top-level groups for projects marked with "make_group"
2295   $prjc->update_project_info($self, 1, ['make_group']);
2296
2297   ## Some Windows based projects can't deal with certain version
2298   ## values.  So, for those we provide a translated version.
2299   my $version = $prjc->get_assignment('version');
2300   if (defined $version) {
2301     $self->{'values'}->{'win_version'} =
2302                         WinVersionTranslator::translate($version);
2303   }
2304 }
2305
2306
2307 sub parse_line {
2308   my($self, $ih, $line) = @_;
2309   my $errorString;
2310   my $startempty = ($line eq '');
2311
2312   ## If processing a foreach or the line only
2313   ## contains a keyword, then we do
2314   ## not need to add a newline to the end.
2315   if ($self->{'foreach'}->{'processing'} == 0 && !$self->{'eval'} &&
2316       ($line !~ /$parse_line_re1/ || !defined $keywords{$1})) {
2317     $line .= $self->{'crlf'};
2318   }
2319
2320   if ($self->{'foreach'}->{'count'} < 0 && !$self->{'eval'}) {
2321     $self->{'built'} = '';
2322   }
2323
2324   my $start = index($line, '<%');
2325   if ($start >= 0) {
2326     my $append_name;
2327     if ($start > 0) {
2328       if (!$self->{'if_skip'}) {
2329         $self->append_current(substr($line, 0, $start));
2330       }
2331       $line = substr($line, $start);
2332     }
2333
2334     my $nlen = 0;
2335     foreach my $item (split('<%', $line)) {
2336       my $name   = 1;
2337       my $length = length($item);
2338       my $endi   = index($item, '%>');
2339       for(my $i = 0; $i < $length; ++$i) {
2340         if ($i == $endi) {
2341           ++$i;
2342           $endi = index($item, '%>', $i);
2343           $name = undef;
2344           if ($append_name) {
2345             $append_name = undef;
2346             if (!$self->{'if_skip'}) {
2347               $self->append_current('%>');
2348             }
2349           }
2350           if ($length != $i + 1) {
2351             if (!$self->{'if_skip'}) {
2352               $self->append_current(substr($item, $i + 1));
2353             }
2354             last;
2355           }
2356         }
2357         elsif ($name) {
2358           my $efcheck = (index($item, 'endfor%>') == 0);
2359           my $focheck = ($efcheck ? 0 : (index($item, 'foreach(') == 0));
2360
2361           if ($focheck && $self->{'foreach'}->{'count'} >= 0) {
2362             ++$self->{'foreach'}->{'nested'};
2363           }
2364
2365           if ($self->{'foreach'}->{'count'} < 0 ||
2366               $self->{'foreach'}->{'processing'} > $self->{'foreach'}->{'nested'} ||
2367               (($efcheck || $focheck) &&
2368                $self->{'foreach'}->{'nested'} == $self->{'foreach'}->{'processing'})) {
2369             ($errorString, $nlen) = $self->process_name($item);
2370
2371             if (defined $errorString) {
2372               return 0, $errorString;
2373             }
2374             elsif ($nlen == 0) {
2375               return 0, "Could not parse this line at column $i";
2376             }
2377
2378             $i += ($nlen - 1);
2379           }
2380           else  {
2381             $name = undef;
2382             $nlen = ($i < $endi ? $endi : $length) - $i;
2383             if (!$self->{'if_skip'}) {
2384               $self->append_current('<%' . substr($item, $i, $nlen));
2385               $append_name = 1;
2386             }
2387             $i += ($nlen - 1);
2388           }
2389
2390           if ($efcheck && $self->{'foreach'}->{'nested'} > 0) {
2391             --$self->{'foreach'}->{'nested'};
2392           }
2393         }
2394         else {
2395           $nlen = ($i < $endi ? $endi : $length) - $i;
2396           if (!$self->{'if_skip'}) {
2397             $self->append_current(substr($item, $i, $nlen));
2398           }
2399           $i += ($nlen - 1);
2400         }
2401       }
2402     }
2403   }
2404   else {
2405     $self->append_current($line) if (!$self->{'if_skip'});
2406   }
2407
2408   if ($self->{'foreach'}->{'count'} < 0 && !$self->{'eval'} &&
2409     ## If the line started out empty and we're not
2410     ## skipping from the start or the built up line is not empty
2411       ($startempty ||
2412         ($self->{'built'} ne $self->{'crlf'} && $self->{'built'} ne ''))) {
2413     push(@{$self->{'lines'}}, $self->{'built'});
2414   }
2415
2416   return !defined $errorString, $errorString;
2417 }
2418
2419
2420 sub parse_file {
2421   my($self, $input) = @_;
2422
2423   $self->collect_data();
2424   my($status, $errorString) = $self->cached_file_read($input);
2425
2426   ## If there was no error, check the stack to make sure that we aren't
2427   ## missing an <%endif%> or an <%endfor%>.
2428   if ($status && defined $self->{'sstack'}->[0]) {
2429     $status = 0;
2430     $errorString = "Missing an '$self->{'sstack'}->[0]' starting at " .
2431                    $self->{'lstack'}->[0];
2432   }
2433
2434   ## Add in the line number if there is an error
2435   $errorString = "$input: line " .
2436                  $self->get_line_number() . ":\n$errorString" if (!$status);
2437
2438   return $status, $errorString;
2439 }
2440
2441
2442 sub get_lines {
2443   return $_[0]->{'lines'};
2444 }
2445
2446
2447 # ************************************************************
2448 # Accessors used by support scripts
2449 # ************************************************************
2450
2451 sub getKeywords {
2452   return \%keywords;
2453 }
2454
2455
2456 sub getArrowOp {
2457   return \%arrow_op_ref;
2458 }
2459
2460
2461 1;