PageRenderTime 194ms CodeModel.GetById 3ms app.highlight 177ms RepoModel.GetById 2ms app.codeStats 0ms

/dep/ACE_wrappers/MPC/modules/TemplateParser.pm

https://bitbucket.org/wownsk/core_tbc
Perl | 2036 lines | 1636 code | 268 blank | 132 comment | 219 complexity | 40716755ae6ca600fb20898d500a45d6 MD5 | raw file

Large files files are truncated, but you can click here to view the full file

   1package 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
  13use strict;
  14
  15use Parser;
  16use WinVersionTranslator;
  17
  18use vars qw(@ISA);
  19@ISA = qw(Parser);
  20
  21# ************************************************************
  22# Data Section
  23# ************************************************************
  24
  25# Valid keywords for use in template files.  Each has a handle_
  26# method available, but some have other methods too.
  27# Bit  Meaning
  28# 0 means there is a get_ method available (used by if and nested functions)
  29# 1 means there is a perform_ method available (used by foreach and nested)
  30# 2 means there is a doif_ method available (used by if)
  31# 3 means that parameters to perform_ should not be evaluated
  32#
  33# Perl Function		Parameter Type		Return Type
  34# get_			string			string or array
  35# perform_		array reference		array
  36# doif_			array reference		boolean
  37#
  38my %keywords = ('if'              => 0,
  39                'else'            => 0,
  40                'endif'           => 0,
  41                'noextension'     => 3,
  42                'dirname'         => 7,
  43                'basename'        => 0,
  44                'basenoextension' => 0,
  45                'foreach'         => 0,
  46                'forfirst'        => 0,
  47                'fornotfirst'     => 0,
  48                'fornotlast'      => 0,
  49                'forlast'         => 0,
  50                'endfor'          => 0,
  51                'eval'            => 0,
  52                'comment'         => 0,
  53                'marker'          => 0,
  54                'uc'              => 3,
  55                'lc'              => 3,
  56                'ucw'             => 0,
  57                'normalize'       => 3,
  58                'flag_overrides'  => 1,
  59                'reverse'         => 3,
  60                'sort'            => 3,
  61                'uniq'            => 3,
  62                'multiple'        => 5,
  63                'starts_with'     => 5,
  64                'ends_with'       => 5,
  65                'contains'        => 5,
  66                'remove_from'     => 0xf,
  67                'compares'        => 5,
  68                'duplicate_index' => 5,
  69                'transdir'        => 5,
  70                'has_extension'   => 5,
  71                'keyname_used'    => 0,
  72                'scope'           => 0,
  73                'full_path'       => 3,
  74                'extensions'      => 0xa,
  75               );
  76
  77my %target_type_vars = ('type_is_static'   => 1,
  78                        'need_staticflags' => 1,
  79                        'type_is_dynamic'  => 1,
  80                        'type_is_binary'   => 1,
  81                       );
  82
  83my %arrow_op_ref = ('custom_type'     => 'custom types',
  84                    'grouped_.*_file' => 'grouped files',
  85                    'feature'         => 'features',
  86                   );
  87
  88# ************************************************************
  89# Subroutine Section
  90# ************************************************************
  91
  92sub new {
  93  my($class, $prjc) = @_;
  94  my $self = $class->SUPER::new();
  95
  96  $self->{'prjc'}                 = $prjc;
  97  $self->{'ti'}                   = $prjc->get_template_input();
  98  $self->{'cslashes'}             = $prjc->convert_slashes();
  99  $self->{'crlf'}                 = $prjc->crlf();
 100  $self->{'cmds'}                 = $prjc->get_command_subs();
 101  $self->{'vnames'}               = $prjc->get_valid_names();
 102  $self->{'values'}               = {};
 103  $self->{'defaults'}             = {};
 104  $self->{'lines'}                = [];
 105  $self->{'built'}                = '';
 106  $self->{'sstack'}               = [];
 107  $self->{'lstack'}               = [];
 108  $self->{'if_skip'}              = 0;
 109  $self->{'eval'}                 = 0;
 110  $self->{'eval_str'}             = '';
 111  $self->{'dupfiles'}             = {};
 112  $self->{'override_target_type'} = undef;
 113  $self->{'keyname_used'}         = {};
 114  $self->{'scopes'}               = {};
 115
 116  $self->{'foreach'}  = {};
 117  $self->{'foreach'}->{'count'}      = -1;
 118  $self->{'foreach'}->{'nested'}     = 0;
 119  $self->{'foreach'}->{'name'}       = [];
 120  $self->{'foreach'}->{'vars'}       = [];
 121  $self->{'foreach'}->{'text'}       = [];
 122  $self->{'foreach'}->{'scope'}      = [];
 123  $self->{'foreach'}->{'scope_name'} = [];
 124  $self->{'foreach'}->{'temp_scope'} = [];
 125  $self->{'foreach'}->{'processing'} = 0;
 126
 127  return $self;
 128}
 129
 130
 131sub tp_basename {
 132  my($self, $file) = @_;
 133
 134  if ($self->{'cslashes'}) {
 135    $file =~ s/.*[\/\\]//;
 136  }
 137  else {
 138    $file =~ s/.*\///;
 139  }
 140  return $file;
 141}
 142
 143
 144sub validated_dirname {
 145  my($self, $file) = @_;
 146  my $index = rindex($file, ($self->{'cslashes'} ? '\\' : '/'));
 147
 148  if ($index >= 0) {
 149    return $self->{'prjc'}->validated_directory(substr($file, 0, $index));
 150  }
 151  else {
 152    return '.';
 153  }
 154}
 155
 156
 157sub tp_dirname {
 158  my($self, $file) = @_;
 159  my $index = rindex($file, ($self->{'cslashes'} ? '\\' : '/'));
 160
 161  if ($index >= 0) {
 162    return substr($file, 0, $index);
 163  }
 164  else {
 165    return '.';
 166  }
 167}
 168
 169
 170sub strip_line {
 171  #my $self = shift;
 172  #my $line = shift;
 173
 174  ## Override strip_line() from Parser.
 175  ## We need to preserve leading space and
 176  ## there is no comment string in templates.
 177  ++$_[0]->{'line_number'};
 178  $_[1] =~ s/\s+$//;
 179
 180  return $_[1];
 181}
 182
 183
 184## Append the current value to the line that is being
 185## built.  This line may be a foreach line or a general
 186## line without a foreach.
 187sub append_current {
 188  #my $self  = shift;
 189  #my $value = shift;
 190
 191  if ($_[0]->{'foreach'}->{'count'} >= 0) {
 192    $_[0]->{'foreach'}->{'text'}->[$_[0]->{'foreach'}->{'count'}] .= $_[1];
 193  }
 194  elsif ($_[0]->{'eval'}) {
 195    $_[0]->{'eval_str'} .= $_[1];
 196  }
 197  else {
 198    my $value = $_[1];
 199    my $scope = $_[0]->{'scopes'};
 200    while(defined $$scope{'scope'}) {
 201      $scope = $$scope{'scope'};
 202      if (defined $$scope{'escape'}) {
 203        my $key = $$scope{'escape'};
 204        if ($key eq '\\') {
 205          $value =~ s/\\/\\\\/g;
 206        }
 207        else {
 208          $value =~ s/$key/\\$key/g;
 209        }
 210      }
 211      else {
 212        foreach my $key (keys %$scope) {
 213          $_[0]->warning("Unrecognized scope function: $key.");
 214        }
 215      }
 216    }
 217
 218    $_[0]->{'built'} .= $value;
 219  }
 220}
 221
 222
 223sub split_parameters {
 224  my($self, $str) = @_;
 225  my @params;
 226
 227  while($str =~ /^(\w+\([^\)]+\))\s*,\s*(.*)/) {
 228    push(@params, $1);
 229    $str = $2;
 230  }
 231  while($str =~ /^([^,]+)\s*,\s*(.*)/) {
 232    push(@params, $1);
 233    $str = $2;
 234  }
 235
 236  ## Return the parameters (which includes whatever is left in the
 237  ## string).  Just return it instead of pushing it onto @params.
 238  return @params, $str;
 239}
 240
 241
 242sub set_current_values {
 243  my($self, $name) = @_;
 244  my $set = 0;
 245
 246  ## If any value within a foreach matches the name
 247  ## of a hash table within the template input we will
 248  ## set the values of that hash table in the current scope
 249  if (defined $self->{'ti'}) {
 250    my $counter = $self->{'foreach'}->{'count'};
 251    if ($counter >= 0) {
 252      ## Variable names are case-insensitive in MPC, however this can
 253      ## cause problems when dealing with template variable values that
 254      ## happen to match HASH names only by case-insensitivity.  So, we
 255      ## now make HASH names match with case-sensitivity.
 256      my $value = $self->{'ti'}->get_value($name);
 257      if (defined $value && UNIVERSAL::isa($value, 'HASH') &&
 258          $self->{'ti'}->get_realname($name) eq $name) {
 259        $self->{'foreach'}->{'scope_name'}->[$counter] = $name;
 260        my %copy;
 261        foreach my $key (keys %$value) {
 262          $copy{$key} = $self->{'prjc'}->adjust_value(
 263                    [$name . '::' . $key, $name], $$value{$key}, $self);
 264        }
 265        $self->{'foreach'}->{'temp_scope'}->[$counter] = \%copy;
 266        $set = 1;
 267      }
 268      else {
 269        ## Since we're not creating a temporary scope for this level, we
 270        ## need to empty out the scope that may have been held here from
 271        ## a previous foreach.
 272        $self->{'foreach'}->{'temp_scope'}->[$counter] = {};
 273      }
 274    }
 275  }
 276  return $set;
 277}
 278
 279
 280sub get_value {
 281  my($self, $name) = @_;
 282  my $value;
 283  my $counter = $self->{'foreach'}->{'count'};
 284  my $fromprj;
 285  my $scope;
 286  my $sname;
 287  my $adjust = 1;
 288
 289  ## $name should always be all lower-case
 290  $name = lc($name);
 291
 292  ## First, check the temporary scope (set inside a foreach)
 293  if ($counter >= 0) {
 294    ## Find the outer most scope for our variable name
 295    for(my $index = $counter; $index >= 0; --$index) {
 296      if (defined $self->{'foreach'}->{'scope_name'}->[$index]) {
 297        $scope = $self->{'foreach'}->{'scope_name'}->[$index];
 298        $sname = $scope . '::' . $name;
 299        last;
 300      }
 301    }
 302    while(!defined $value && $counter >= 0) {
 303      $value = $self->{'foreach'}->{'temp_scope'}->[$counter]->{$name};
 304      --$counter;
 305    }
 306    $counter = $self->{'foreach'}->{'count'};
 307
 308    if ($self->{'override_target_type'} &&
 309        defined $value && defined $target_type_vars{$name}) {
 310      $value = $self->{'values'}->{$name};
 311    }
 312  }
 313
 314  if (!defined $value) {
 315    if ($name =~ /^flag_overrides\((.*)\)$/) {
 316      $value = $self->get_flag_overrides($1);
 317    }
 318
 319    if (!defined $value) {
 320      ## Next, check for a template value
 321      if (defined $self->{'ti'}) {
 322        $value = $self->{'ti'}->get_value($name);
 323      }
 324
 325      if (!defined $value) {
 326        ## Calling adjust_value here allows us to pick up template
 327        ## overrides before getting values elsewhere.
 328        my $uvalue = $self->{'prjc'}->adjust_value([$sname, $name],
 329                                                   [], $self);
 330        if (defined $$uvalue[0]) {
 331          $value = $uvalue;
 332          $adjust = 0;
 333          $fromprj = 1;
 334        }
 335
 336        if (!defined $value) {
 337          ## Next, check the inner to outer foreach
 338          ## scopes for overriding values
 339          while(!defined $value && $counter >= 0) {
 340            $value = $self->{'foreach'}->{'scope'}->[$counter]->{$name};
 341            --$counter;
 342          }
 343
 344          ## Then get the value from the project creator
 345          if (!defined $value) {
 346            $fromprj = 1;
 347            $value = $self->{'prjc'}->get_assignment($name);
 348
 349            ## Then get it from our known values
 350            if (!defined $value) {
 351              $value = $self->{'values'}->{$name};
 352              if (!defined $value) {
 353                ## Call back onto the project creator to allow
 354                ## it to fill in the value before defaulting to undef.
 355                $value = $self->{'prjc'}->fill_value($name);
 356                if (!defined $value && $name =~ /^(.*)\->(\w+)/) {
 357                  my $pre  = $1;
 358                  my $post = $2;
 359                  my $base = $self->get_value($pre);
 360
 361                  if (defined $base) {
 362                    $value = $self->{'prjc'}->get_special_value(
 363                               $pre, $post, $base,
 364                               ($self->{'prjc'}->requires_parameters($post) ?
 365                                   $self->prepare_parameters($pre) : undef));
 366                  }
 367                }
 368              }
 369            }
 370          }
 371        }
 372      }
 373    }
 374  }
 375
 376  ## Adjust the value even if we haven't obtained one from an outside
 377  ## source.
 378  if ($adjust && defined $value) {
 379    $value = $self->{'prjc'}->adjust_value([$sname, $name], $value, $self);
 380  }
 381
 382  ## If the value did not come from the project creator, we
 383  ## check the variable name.  If it is a project keyword we then
 384  ## check to see if we need to add the project value to the template
 385  ## variable value.  If so, we make a copy of the value array and
 386  ## push the project value onto that (to avoid modifying the original).
 387  if (!$fromprj && defined $self->{'vnames'}->{$name} &&
 388      $self->{'prjc'}->add_to_template_input_value($name)) {
 389    my $pjval = $self->{'prjc'}->get_assignment($name);
 390    if (defined $pjval) {
 391      my @copy = @$value;
 392      if (!UNIVERSAL::isa($pjval, 'ARRAY')) {
 393        $pjval = $self->create_array($pjval);
 394      }
 395      push(@copy, @$pjval);
 396      $value = \@copy;
 397    }
 398  }
 399
 400  return $self->{'prjc'}->relative($value, undef, $scope);
 401}
 402
 403
 404sub get_value_with_default {
 405  my $self  = shift;
 406  my $name = lc(shift);
 407  my $value = $self->get_value($name);
 408
 409  if (!defined $value) {
 410    $value = $self->{'defaults'}->{$name};
 411    if (defined $value) {
 412      my $counter = $self->{'foreach'}->{'count'};
 413      my $sname;
 414
 415      if ($counter >= 0) {
 416        ## Find the outer most scope for our variable name
 417        for(my $index = $counter; $index >= 0; --$index) {
 418          if (defined $self->{'foreach'}->{'scope_name'}->[$index]) {
 419            $sname = $self->{'foreach'}->{'scope_name'}->[$index] .
 420                     '::' . $name;
 421            last;
 422          }
 423        }
 424      }
 425      $value = $self->{'prjc'}->relative(
 426                 $self->{'prjc'}->adjust_value(
 427                   [$sname, $name], $value, $self));
 428
 429      ## If the user set the variable to empty, we will go ahead and use
 430      ## the default value (since we know we have one at this point).
 431      $value = $self->{'defaults'}->{$name} if (!defined $value);
 432    }
 433    else {
 434      #$self->warning("$name defaulting to empty string.");
 435      $value = '';
 436    }
 437  }
 438
 439  return (UNIVERSAL::isa($value, 'ARRAY') ? "@$value" : $value);
 440}
 441
 442
 443sub process_foreach {
 444  my $self   = shift;
 445  my $index = $self->{'foreach'}->{'count'};
 446  my $text = $self->{'foreach'}->{'text'}->[$index];
 447  my @values;
 448  my $name = $self->{'foreach'}->{'name'}->[$index];
 449  my @cmds;
 450  my $val = $self->{'foreach'}->{'vars'}->[$index];
 451  my $check_for_mixed;
 452
 453  if ($val =~ /^((\w+),\s*)?flag_overrides\((.*)\)$/) {
 454    my $over = $self->get_flag_overrides($3);
 455    $name = $2;
 456    if (defined $over) {
 457      $val = $self->create_array($over);
 458      @values = @$val;
 459    }
 460    $name = '__unnamed__' if (!defined $name);
 461  }
 462  else {
 463    ## Pull out modifying commands first
 464    while ($val =~ /(\w+)\((.+)\)/) {
 465      my $cmd = $1;
 466      $val = $2;
 467      if (($keywords{$cmd} & 0x02) != 0) {
 468        push(@cmds, 'perform_' . $cmd);
 469        if (($keywords{$cmd} & 0x08) != 0) {
 470          my @params = $self->split_parameters($val);
 471          $val = \@params;
 472          last;
 473        }
 474      }
 475      else {
 476        $self->warning("Unable to use $cmd in foreach (no perform_ method).");
 477      }
 478    }
 479
 480    ## Get the values for all of the variable names
 481    ## contained within the foreach
 482    if (UNIVERSAL::isa($val, 'ARRAY')) {
 483      @values = @$val;
 484    }
 485    else {
 486      my $names = $self->create_array($val);
 487      foreach my $n (@$names) {
 488        my $vals = $self->get_value($n);
 489        if (defined $vals && $vals ne '') {
 490          if (!UNIVERSAL::isa($vals, 'ARRAY')) {
 491            $vals = $self->create_array($vals);
 492          }
 493          push(@values, @$vals);
 494        }
 495        if (!defined $name) {
 496          $name = $n;
 497          $name =~ s/s$//;
 498        }
 499        ## We only want to check for the mixing of scalar and hash
 500        ## variables if the variable name is not a keyword (or the
 501        ## special 'features' template variable).
 502        if (!$check_for_mixed &&
 503            !$self->{'prjc'}->is_keyword($n) && $n ne 'features') {
 504          $check_for_mixed = 1;
 505        }
 506      }
 507    }
 508  }
 509
 510  ## Perform the commands on the built up @values
 511  foreach my $cmd (reverse @cmds) {
 512    @values = $self->$cmd(\@values);
 513  }
 514
 515  ## Reset the text (it will be regenerated by calling parse_line
 516  $self->{'foreach'}->{'text'}->[$index] = '';
 517
 518  if (defined $values[0]) {
 519    my $scope = $self->{'foreach'}->{'scope'}->[$index];
 520    my $base  = $self->{'foreach'}->{'base'}->[$index];
 521
 522    $$scope{'forlast'}     = '';
 523    $$scope{'fornotlast'}  = 1;
 524    $$scope{'forfirst'}    = 1;
 525    $$scope{'fornotfirst'} = '';
 526
 527    ## If the foreach values are mixed (HASH and SCALAR), then
 528    ## remove the SCALAR values.
 529    if ($check_for_mixed) {
 530      my %mixed;
 531      my $mixed = 0;
 532      foreach my $mval (@values) {
 533        $mixed{$mval} = $self->set_current_values($mval);
 534        $mixed |= $mixed{$mval};
 535      }
 536      if ($mixed) {
 537        my @nvalues;
 538        foreach my $key (sort keys %mixed) {
 539          push(@nvalues, $key) if ($mixed{$key});
 540        }
 541
 542        ## Set the new values only if they are different
 543        ## from the original (except for order).
 544        my @sorted = sort(@values);
 545        @values = @nvalues if (@sorted != @nvalues);
 546      }
 547    }
 548
 549    for(my $i = 0; $i <= $#values; ++$i) {
 550      my $value = $values[$i];
 551
 552      ## Set the corresponding values in the temporary scope
 553      $self->set_current_values($value);
 554
 555      ## Set the special values that only exist
 556      ## within a foreach
 557      if ($i != 0) {
 558        $$scope{'forfirst'}    = '';
 559        $$scope{'fornotfirst'} = 1;
 560      }
 561      if ($i == $#values) {
 562        $$scope{'forlast'}    = 1;
 563        $$scope{'fornotlast'} = '';
 564      }
 565      $$scope{'forcount'} = $i + $base;
 566
 567      ## We don't use adjust_value here because these names
 568      ## are generated from a foreach and should not be adjusted.
 569      $$scope{$name} = $value;
 570
 571      ## A tiny hack for VC7
 572      if ($name eq 'configuration' &&
 573          $self->get_value_with_default('platform') ne '') {
 574        $self->{'prjc'}->update_project_info($self, 1,
 575                                             ['configuration', 'platform'],
 576                                             '|');
 577      }
 578
 579      ## Now parse the line of text, each time
 580      ## with different values
 581      ++$self->{'foreach'}->{'processing'};
 582      my($status, $error) = $self->parse_line(undef, $text);
 583      --$self->{'foreach'}->{'processing'};
 584      return $error if (defined $error);
 585    }
 586  }
 587
 588  return undef;
 589}
 590
 591
 592sub generic_handle {
 593  my($self, $func, $str) = @_;
 594
 595  if (defined $str) {
 596    my $val = $self->$func([$str]);
 597
 598    if (defined $val) {
 599      $self->append_current($val);
 600    }
 601    else {
 602      $self->append_current(0);
 603    }
 604  }
 605}
 606
 607
 608sub handle_endif {
 609  my($self, $name) = @_;
 610  my $end = pop(@{$self->{'sstack'}});
 611  pop(@{$self->{'lstack'}});
 612
 613  if (!defined $end) {
 614    return "Unmatched $name";
 615  }
 616  else {
 617    my $in = index($end, $name);
 618    if ($in == 0) {
 619      $self->{'if_skip'} = 0;
 620    }
 621    elsif ($in == -1) {
 622      return "Unmatched $name";
 623    }
 624  }
 625
 626  return undef;
 627}
 628
 629
 630sub handle_endfor {
 631  my($self, $name) = @_;
 632  my $end = pop(@{$self->{'sstack'}});
 633  pop(@{$self->{'lstack'}});
 634
 635  if (!defined $end) {
 636    return "Unmatched $name";
 637  }
 638  else {
 639    my $in = index($end, $name);
 640    if ($in == 0) {
 641      my $index = $self->{'foreach'}->{'count'};
 642      my $error = $self->process_foreach();
 643      if (!defined $error) {
 644        --$self->{'foreach'}->{'count'};
 645        $self->append_current($self->{'foreach'}->{'text'}->[$index]);
 646      }
 647      return $error;
 648    }
 649    elsif ($in == -1) {
 650      return "Unmatched $name";
 651    }
 652  }
 653
 654  return undef;
 655}
 656
 657
 658sub get_flag_overrides {
 659  my($self, $name) = @_;
 660  my $type;
 661
 662  ## Split the name and type parameters
 663  ($name, $type) = split(/,\s*/, $name);
 664
 665  my $file = $self->get_value($name);
 666  if (defined $file) {
 667    ## Save the name prefix (if there is one) for
 668    ## command parameter conversion at the end
 669    my $pre;
 670    if ($name =~ /^(\w+)->/) {
 671      $pre = $1;
 672
 673      ## Replace the custom_type key with the actual custom type
 674      if ($pre eq 'custom_type') {
 675        my $ct = $self->get_value($pre);
 676        $name = $ct if (defined $ct);
 677      }
 678      elsif ($pre =~ /^grouped_(.*_file)$/) {
 679        $name = $1;
 680      }
 681    }
 682
 683    my $fo  = $self->{'prjc'}->{'flag_overrides'};
 684    my $key = (defined $$fo{$name . 's'} ? $name . 's' :
 685                       (defined $$fo{$name} ? $name : undef));
 686
 687    if (defined $key) {
 688      ## Convert the file name into a unix style file name
 689      my $ustyle = $file;
 690      $ustyle =~ s/\\/\//g if ($self->{'cslashes'});
 691
 692      ## Save the directory portion for checking in the foreach
 693      my $dir = $self->mpc_dirname($ustyle);
 694
 695      my $of = (defined $$fo{$key}->{$ustyle} ? $ustyle :
 696                   (defined $$fo{$key}->{$dir} ? $dir : undef));
 697      if (defined $of) {
 698        my $prjc = $self->{'prjc'};
 699        foreach my $aname (@{$prjc->{'matching_assignments'}->{$key}}) {
 700          if ($aname eq $type && defined $$fo{$key}->{$of}->{$aname}) {
 701            my $value = $$fo{$key}->{$of}->{$aname};
 702
 703            ## If the name that we're overriding has a value and
 704            ## requires parameters, then we will convert all of the
 705            ## pseudo variables and provide parameters.
 706            if (defined $pre && $prjc->requires_parameters($type)) {
 707              $value = $prjc->convert_command_parameters(
 708                                      $key, $value,
 709                                      $self->prepare_parameters($pre));
 710            }
 711
 712            return $prjc->relative($value);
 713          }
 714        }
 715      }
 716    }
 717  }
 718
 719  return undef;
 720}
 721
 722
 723sub get_multiple {
 724  my($self, $name) = @_;
 725  return $self->doif_multiple(
 726                  $self->create_array($self->get_value_with_default($name)));
 727}
 728
 729
 730sub doif_multiple {
 731  my($self, $value) = @_;
 732  return defined $value ? (scalar(@$value) > 1) : undef;
 733}
 734
 735
 736sub handle_multiple {
 737  my($self, $name) = @_;
 738  my $val = $self->get_value_with_default($name);
 739
 740  if (defined $val) {
 741    my $array = $self->create_array($val);
 742    $self->append_current(scalar(@$array));
 743  }
 744  else {
 745    $self->append_current(0);
 746  }
 747}
 748
 749
 750sub get_starts_with {
 751  my($self, $str) = @_;
 752  return $self->doif_starts_with([$str]);
 753}
 754
 755
 756sub doif_starts_with {
 757  my($self, $val) = @_;
 758
 759  if (defined $val) {
 760    my($name, $pattern) = $self->split_parameters("@$val");
 761    if (defined $name && defined $pattern) {
 762      return ($self->get_value_with_default($name) =~ /^$pattern/);
 763    }
 764  }
 765  return undef;
 766}
 767
 768
 769sub handle_starts_with {
 770  my($self, $str) = @_;
 771  $self->generic_handle('doif_starts_with', $str);
 772}
 773
 774
 775sub get_ends_with {
 776  my($self, $str) = @_;
 777  return $self->doif_ends_with([$str]);
 778}
 779
 780
 781sub doif_ends_with {
 782  my($self, $val) = @_;
 783
 784  if (defined $val) {
 785    my($name, $pattern) = $self->split_parameters("@$val");
 786    if (defined $name && defined $pattern) {
 787      return ($self->get_value_with_default($name) =~ /$pattern$/);
 788    }
 789  }
 790  return undef;
 791}
 792
 793
 794sub handle_ends_with {
 795  my($self, $str) = @_;
 796  $self->generic_handle('doif_ends_with', $str);
 797}
 798
 799
 800sub handle_keyname_used {
 801  my($self, $str) = @_;
 802
 803  if (defined $str) {
 804    my($name, $key) = $self->split_parameters($str);
 805    my $file = $self->get_value_with_default($name);
 806    if (defined $self->{'keyname_used'}->{$file}->{$key}) {
 807      $self->append_current($self->{'keyname_used'}->{$file}->{$key}++);
 808    }
 809    else {
 810      $self->{'keyname_used'}->{$file}->{$key} = 1;
 811    }
 812  }
 813}
 814
 815
 816sub handle_scope {
 817  my($self, $str) = @_;
 818
 819  if (defined $str) {
 820    my($state, $func, $param) = $self->split_parameters($str);
 821    if (defined $state) {
 822      my $pscope;
 823      my $scope = $self->{'scopes'};
 824
 825      while(defined $$scope{'scope'}) {
 826        $pscope = $scope;
 827        $scope = $$scope{'scope'};
 828      }
 829      if ($state eq 'enter') {
 830        if (defined $func) {
 831          $param = '' if (!defined $param);
 832          $$scope{'scope'} = {$func => $self->process_special($param)};
 833        }
 834        else {
 835          $self->warning("The enter scope function requires a parameter.");
 836        }
 837      }
 838      elsif ($state eq 'leave') {
 839        if (defined $pscope) {
 840          delete $$pscope{'scope'};
 841        }
 842        else {
 843          $self->warning("leave scope function encountered without an enter.");
 844        }
 845      }
 846      else {
 847        $self->warning("Unrecognized scope function parameter: $state.");
 848      }
 849    }
 850    else {
 851      $self->warning("The scope function requires 1 to 3 parameters.");
 852    }
 853  }
 854}
 855
 856sub get_has_extension {
 857  my($self, $str) = @_;
 858  return $self->doif_has_extension([$str]);
 859}
 860
 861
 862sub doif_has_extension {
 863  my($self, $val) = @_;
 864
 865  if (defined $val) {
 866    return ($self->tp_basename(
 867                $self->get_value_with_default("@$val")) =~ /\.[^\.]+$/);
 868  }
 869  return undef;
 870}
 871
 872
 873sub handle_has_extension {
 874  my($self, $str) = @_;
 875  $self->generic_handle('doif_has_extension', $str);
 876}
 877
 878
 879sub get_contains {
 880  my($self, $str) = @_;
 881  return $self->doif_contains([$str]);
 882}
 883
 884
 885sub doif_contains {
 886  my($self, $val) = @_;
 887
 888  if (defined $val) {
 889    my($name, $pattern) = $self->split_parameters("@$val");
 890    if (defined $name && defined $pattern) {
 891      return ($self->get_value_with_default($name) =~ /$pattern/);
 892    }
 893  }
 894  return undef;
 895}
 896
 897
 898sub handle_contains {
 899  my($self, $str) = @_;
 900  $self->generic_handle('doif_contains', $str);
 901}
 902
 903
 904sub get_remove_from {
 905  my($self, $str) = @_;
 906  return $self->doif_remove_from($str);
 907}
 908
 909
 910sub doif_remove_from {
 911  my($self, $str) = @_;
 912  my @params = $self->split_parameters($str);
 913  my @removed = $self->perform_remove_from(\@params);
 914  return (defined $removed[0] ? 1 : undef);
 915}
 916
 917
 918sub perform_remove_from {
 919  my($self, $val) = @_;
 920  my($source, $pattern, $target, $tremove) = @$val;
 921
 922  ## $source should be a component name (e.g., source_files,
 923  ## header_files, etc.)  $target is a variable name
 924  ## $pattern and $tremove are optional; $pattern is a partial regular
 925  ## expression to match the end of the files found from $source.  The
 926  ## beginning of the regular expression is made from $target by removing
 927  ## $tremove from the end of it.
 928  if (defined $source && defined $target &&
 929      defined $self->{'values'}->{$source}) {
 930    my $tval = $self->get_value_with_default($target);
 931    if (defined $tval) {
 932      $tval =~ s/$tremove$// if (defined $tremove);
 933      $tval = $self->escape_regex_special($tval);
 934      my @removed;
 935      my $max = scalar(@{$self->{'values'}->{$source}});
 936      for(my $i = 0; $i < $max;) {
 937        if ($self->{'values'}->{$source}->[$i] =~ /^$tval$pattern$/) {
 938          push(@removed, splice(@{$self->{'values'}->{$source}}, $i, 1));
 939          $max--;
 940        }
 941        else {
 942          $i++;
 943        }
 944      }
 945      return @removed;
 946    }
 947  }
 948
 949  return ();
 950}
 951
 952
 953sub handle_remove_from {
 954  my($self, $str) = @_;
 955
 956  if (defined $str) {
 957    my @params = $self->split_parameters($str);
 958    my $val = $self->perform_remove_from(\@params);
 959    $self->append_current("@$val") if (defined $val);
 960  }
 961}
 962
 963
 964sub get_compares {
 965  my($self, $str) = @_;
 966  return $self->doif_compares([$str]);
 967}
 968
 969
 970sub doif_compares {
 971  my($self, $val) = @_;
 972
 973  if (defined $val) {
 974    my($name, $pattern) = $self->split_parameters("@$val");
 975    if (defined $name && defined $pattern) {
 976      return ($self->get_value_with_default($name) eq $pattern);
 977    }
 978  }
 979  return undef;
 980}
 981
 982
 983sub handle_compares {
 984  my($self, $str) = @_;
 985  $self->generic_handle('doif_compares', $str);
 986}
 987
 988
 989sub get_reverse {
 990  my($self, $name) = @_;
 991  my $value = $self->get_value_with_default($name);
 992
 993  if (defined $value) {
 994    my @array = $self->perform_reverse($self->create_array($value));
 995    return \@array;
 996  }
 997
 998  return undef;
 999}
1000
1001
1002sub perform_reverse {
1003  my($self, $value) = @_;
1004  return reverse(@$value);
1005}
1006
1007
1008sub handle_reverse {
1009  my($self, $name) = @_;
1010  my $val = $self->get_value_with_default($name);
1011
1012  if (defined $val) {
1013    my @array = $self->perform_reverse($self->create_array($val));
1014    $self->append_current("@array");
1015  }
1016}
1017
1018
1019sub get_sort {
1020  my($self, $name) = @_;
1021  my $value = $self->get_value_with_default($name);
1022
1023  if (defined $value) {
1024    my @array = $self->perform_sort($self->create_array($value));
1025    return \@array;
1026  }
1027
1028  return undef;
1029}
1030
1031
1032sub perform_sort {
1033  my($self, $value) = @_;
1034  return sort(@$value);
1035}
1036
1037
1038sub handle_sort {
1039  my($self, $name) = @_;
1040  my $val = $self->get_value_with_default($name);
1041
1042  if (defined $val) {
1043    my @array = $self->perform_sort($self->create_array($val));
1044    $self->append_current("@array");
1045  }
1046}
1047
1048
1049sub get_uniq {
1050  my($self, $name) = @_;
1051  my $value = $self->get_value_with_default($name);
1052
1053  if (defined $value) {
1054    my @array = $self->perform_uniq($self->create_array($value));
1055    return \@array;
1056  }
1057
1058  return undef;
1059}
1060
1061
1062sub perform_uniq {
1063  my($self, $value) = @_;
1064  my %value;
1065  @value{@$value} = ();
1066  return sort(keys %value);
1067}
1068
1069
1070sub handle_uniq {
1071  my($self, $name) = @_;
1072  my $val = $self->get_value_with_default($name);
1073
1074  if (defined $val) {
1075    my @array = $self->perform_uniq($self->create_array($val));
1076    $self->append_current("@array");
1077  }
1078}
1079
1080
1081sub process_compound_if {
1082  my($self, $str) = @_;
1083
1084  if (index($str, '||') >= 0) {
1085    my $ret = 0;
1086    foreach my $v (split(/\s*\|\|\s*/, $str)) {
1087      $ret |= $self->process_compound_if($v);
1088      return 1 if ($ret != 0);
1089    }
1090    return 0;
1091  }
1092  elsif (index($str, '&&') >= 0) {
1093    my $ret = 1;
1094    foreach my $v (split(/\s*\&\&\s*/, $str)) {
1095      $ret &&= $self->process_compound_if($v);
1096      return 0 if ($ret == 0);
1097    }
1098    return 1;
1099  }
1100  else {
1101    ## See if we need to reverse the return value
1102    my $not = 0;
1103    if ($str =~ /^!+(.*)/) {
1104      $not = 1;
1105      $str = $1;
1106    }
1107
1108    ## Get the value based on the string
1109    my @cmds;
1110    my $val;
1111    while ($str =~ /(\w+)\((.+)\)(.*)/) {
1112      if ($3 eq '') {
1113        push(@cmds, $1);
1114        $str = $2;
1115      }
1116      else {
1117        ## If there is something trailing the closing parenthesis then
1118        ## the whole thing is considered a parameter to the first
1119        ## function.
1120        last;
1121      }
1122    }
1123
1124    if (defined $cmds[0]) {
1125      ## Start out calling get_xxx on the string
1126      my $type = 0x01;
1127      my $prefix = 'get_';
1128
1129      $val = $str;
1130      foreach my $cmd (reverse @cmds) {
1131        if (defined $keywords{$cmd} && ($keywords{$cmd} & $type) != 0) {
1132          my $func = "$prefix$cmd";
1133          $val = $self->$func($val);
1134
1135          ## Now that we have a value, we need to switch over
1136          ## to calling doif_xxx
1137          $type = 0x04;
1138          $prefix = 'doif_';
1139        }
1140        else {
1141          $self->warning("Unable to use $cmd in if (no $prefix method).");
1142        }
1143      }
1144    }
1145    else {
1146      $val = $self->get_value($str);
1147    }
1148
1149    ## See if any portion of the value is defined and not empty
1150    my $ret = 0;
1151    if (defined $val) {
1152      if (UNIVERSAL::isa($val, 'ARRAY')) {
1153        foreach my $v (@$val) {
1154          if ($v ne '') {
1155            $ret = 1;
1156            last;
1157          }
1158        }
1159      }
1160      elsif ($val ne '') {
1161        $ret = 1;
1162      }
1163    }
1164    return ($not ? !$ret : $ret);
1165  }
1166}
1167
1168
1169sub handle_if {
1170  my($self, $val) = @_;
1171  my $name = 'endif';
1172
1173  push(@{$self->{'lstack'}},
1174       "<%if($val)%> (" . $self->get_line_number() . '?)');
1175  if ($self->{'if_skip'}) {
1176    push(@{$self->{'sstack'}}, "*$name");
1177  }
1178  else {
1179    ## Determine if we are skipping the portion of this if statement
1180    ## $val will always be defined since we won't get into this method
1181    ## without properly parsing the if statement.
1182    $self->{'if_skip'} = !$self->process_compound_if($val);
1183    push(@{$self->{'sstack'}}, $name);
1184  }
1185}
1186
1187
1188sub handle_else {
1189  my $self  = shift;
1190  my @scopy = @{$self->{'sstack'}};
1191  my $index = index($scopy[$#scopy], 'endif');
1192  if ($index >= 0) {
1193    if ($index == 0) {
1194      $self->{'if_skip'} ^= 1;
1195    }
1196    $self->{'sstack'}->[$#scopy] .= ':';
1197  }
1198
1199  return 'Unmatched else' if (($self->{'sstack'}->[$#scopy] =~ tr/:/:/) > 1);
1200  return undef;
1201}
1202
1203
1204sub handle_foreach {
1205  my $self        = shift;
1206  my $val = lc(shift);
1207  my $name = 'endfor';
1208  my $errorString;
1209
1210  push(@{$self->{'lstack'}}, $self->get_line_number());
1211  if (!$self->{'if_skip'}) {
1212    my $base = 1;
1213    my $vname;
1214    if ($val =~ /flag_overrides\([^\)]+\)/) {
1215    }
1216    elsif ($val =~ /([^,]*),(.*)/) {
1217      $vname = $1;
1218      $val   = $2;
1219      $vname =~ s/^\s+//;
1220      $vname =~ s/\s+$//;
1221      $val   =~ s/^\s+//;
1222      $val   =~ s/\s+$//;
1223
1224      if ($vname eq '') {
1225        $errorString = 'The foreach variable name is not valid';
1226      }
1227
1228      if ($val =~ /([^,]*),(.*)/) {
1229        $base = $1;
1230        $val  = $2;
1231        $base =~ s/^\s+//;
1232        $base =~ s/\s+$//;
1233        $val  =~ s/^\s+//;
1234        $val  =~ s/\s+$//;
1235
1236        if ($base !~ /^\d+$/) {
1237          $errorString = 'The forcount specified is not a valid number';
1238        }
1239      }
1240      elsif ($vname =~ /^\d+$/) {
1241        $base  = $vname;
1242        $vname = undef;
1243      }
1244
1245      ## Due to the way flag_overrides works, we can't allow
1246      ## the user to name the foreach variable when dealing
1247      ## with variables that can be used with the -> operator
1248      if (defined $vname) {
1249        foreach my $ref (keys %arrow_op_ref) {
1250          my $name_re  = $ref . 's';
1251          if ($val =~ /^$ref\->/ || $val =~ /^$name_re$/) {
1252            $errorString = 'The foreach variable can not be ' .
1253                           'named when dealing with ' .
1254                           $arrow_op_ref{$ref};
1255          }
1256        }
1257      }
1258    }
1259
1260    push(@{$self->{'sstack'}}, $name);
1261    my $index = ++$self->{'foreach'}->{'count'};
1262
1263    $self->{'foreach'}->{'base'}->[$index]  = $base;
1264    $self->{'foreach'}->{'name'}->[$index]  = $vname;
1265    $self->{'foreach'}->{'vars'}->[$index]  = $val;
1266    $self->{'foreach'}->{'text'}->[$index]  = '';
1267    $self->{'foreach'}->{'scope'}->[$index] = {};
1268    $self->{'foreach'}->{'scope_name'}->[$index] = undef;
1269  }
1270  else {
1271    push(@{$self->{'sstack'}}, "*$name");
1272  }
1273
1274  return $errorString;
1275}
1276
1277
1278sub handle_special {
1279  my($self, $name, $val) = @_;
1280
1281  ## If $name (fornotlast, forfirst, etc.) is set to 1
1282  ## Then we append the $val onto the current string that's
1283  ## being built.
1284  $self->append_current($val) if ($self->get_value($name));
1285}
1286
1287
1288sub get_uc {
1289  my($self, $name) = @_;
1290  return uc($self->get_value_with_default($name));
1291}
1292
1293
1294sub handle_uc {
1295  my($self, $name) = @_;
1296  $self->append_current($self->get_uc($name));
1297}
1298
1299
1300sub perform_uc {
1301  my($self, $value) = @_;
1302  my @val;
1303  foreach my $val (@$value) {
1304    push(@val, uc($val));
1305  }
1306  return @val;
1307}
1308
1309
1310sub get_lc {
1311  my($self, $name) = @_;
1312  return lc($self->get_value_with_default($name));
1313}
1314
1315
1316sub handle_lc {
1317  my($self, $name) = @_;
1318  $self->append_current($self->get_lc($name));
1319}
1320
1321
1322sub perform_lc {
1323  my($self, $value) = @_;
1324  my @val;
1325  foreach my $val (@$value) {
1326    push(@val, lc($val));
1327  }
1328  return @val;
1329}
1330
1331
1332sub handle_ucw {
1333  my($self, $name) = @_;
1334  my $val = $self->get_value_with_default($name);
1335
1336  substr($val, 0, 1) = uc(substr($val, 0, 1));
1337  while($val =~ /[_\s]([a-z])/) {
1338    my $uc = uc($1);
1339    $val =~ s/[_\s][a-z]/ $uc/;
1340  }
1341  $self->append_current($val);
1342}
1343
1344
1345sub actual_normalize {
1346  $_[1] =~ tr/ \t\/\\\-$()./_/;
1347  return $_[1];
1348}
1349
1350sub perform_normalize {
1351  my($self, $value) = @_;
1352  my @val;
1353  foreach my $val (@$value) {
1354    push(@val, $self->actual_normalize($val));
1355  }
1356  return @val;
1357}
1358
1359
1360sub get_normalize {
1361  my($self, $name) = @_;
1362  return $self->actual_normalize($self->get_value_with_default($name));
1363}
1364
1365
1366sub handle_normalize {
1367  my($self, $name) = @_;
1368  $self->append_current($self->get_normalize($name));
1369}
1370
1371
1372sub actual_noextension {
1373  $_[1] =~ s/\.[^\.]+$//;
1374  return $_[1];
1375}
1376
1377
1378sub perform_noextension {
1379  my($self, $value) = @_;
1380  my @val;
1381  foreach my $val (@$value) {
1382    push(@val, $self->actual_noextension($val));
1383  }
1384  return @val;
1385}
1386
1387
1388sub get_noextension {
1389  my($self, $name) = @_;
1390  return $self->actual_noextension($self->get_value_with_default($name));
1391}
1392
1393sub handle_noextension {
1394  my($self, $name) = @_;
1395  $self->append_current($self->get_noextension($name));
1396}
1397
1398
1399sub perform_full_path {
1400  my($self, $value) = @_;
1401  my @val;
1402  foreach my $val (@$value) {
1403    push(@val, $self->actual_full_path($val));
1404  }
1405  return @val;
1406}
1407
1408
1409sub get_full_path {
1410  my($self, $name) = @_;
1411  return $self->actual_full_path($self->get_value_with_default($name));
1412}
1413
1414
1415sub actual_full_path {
1416  my($self, $value) = @_;
1417
1418  ## Expand all defined env vars
1419  $value =~ s/\$\((\w+)\)/$ENV{$1} || '$(' . $1 . ')'/ge;
1420
1421  ## If we expanded all env vars, get absolute path
1422  if ($value =~ /\$\(\w+\)/) {
1423    $self->{'error_in_handle'} = "<%full_path%> couldn't expand " .
1424                                 "environment variables in $value";
1425    return $value;
1426  }
1427
1428  ## Always convert the slashes since they may be in the OS native
1429  ## format and we need them in UNIX format.
1430  $value =~ s/\\/\//g;
1431  my $dir = $self->mpc_dirname($value);
1432  if (-e $dir) {
1433    $dir = Cwd::abs_path($dir);
1434  }
1435  elsif ($self->{'prjc'}->path_is_relative($dir)) {
1436    ## If the directory is is not already an absolute path, then we will
1437    ## assume that the directory is relative to the current directory
1438    ## (which will be the location of the MPC file).
1439    $dir = $self->getcwd() . '/' . $dir;
1440  }
1441
1442  ## Create the full path value and convert the slashes if necessary.
1443  $value = $dir . '/' . $self->mpc_basename($value);
1444  $value =~ s/\//\\/g if ($self->{'cslashes'});
1445  return $value;
1446}
1447
1448
1449sub handle_full_path {
1450  my($self, $name) = @_;
1451  my $val = $self->get_value_with_default($name);
1452
1453  $self->append_current($self->actual_full_path($val));
1454}
1455
1456
1457sub perform_extensions {
1458  my($self, $value) = @_;
1459  my @val;
1460  foreach my $val (@$value) {
1461    push(@val, $self->{'prjc'}->get_component_extensions($val));
1462  }
1463  return @val;
1464}
1465
1466
1467sub handle_extensions {
1468  my($self, $name) = @_;
1469  my @val = $self->perform_extensions([$name]);
1470  $self->append_current("@val");
1471}
1472
1473
1474sub evaluate_nested_functions {
1475  my($self, $name, $val) = @_;
1476
1477  ## Get the value based on the string
1478  my @cmds = ($name);
1479  while ($val =~ /(\w+)\((.+)\)/) {
1480    push(@cmds, $1);
1481    $val = $2;
1482  }
1483
1484  ## Start out calling get_xxx on the string
1485  my $type = 0x01;
1486  my $prefix = 'get_';
1487
1488  foreach my $cmd (reverse @cmds) {
1489    if (defined $keywords{$cmd} && ($keywords{$cmd} & $type) != 0) {
1490      my $func = "$prefix$cmd";
1491      if ($type == 0x01) {
1492        $val = $self->$func($val);
1493        $val = [ $val ] if (!UNIVERSAL::isa($val, 'ARRAY'));
1494      }
1495      else {
1496        my @array = $self->$func($val);
1497        $val = \@array;
1498      }
1499
1500      ## Now that we have a value, we need to switch over
1501      ## to calling perform_xxx
1502      $type = 0x02;
1503      $prefix = 'perform_';
1504    }
1505    else {
1506      $self->warning("Unable to use $cmd in nested " .
1507                     "functions (no $prefix method).");
1508    }
1509  }
1510  if (defined $val && UNIVERSAL::isa($val, 'ARRAY')) {
1511    $self->append_current("@$val");
1512  }
1513}
1514
1515
1516sub perform_dirname {
1517  my($self, $value) = @_;
1518  my @val;
1519  foreach my $val (@$value) {
1520    push(@val, $self->validated_dirname($val));
1521  }
1522  return @val;
1523}
1524
1525
1526sub get_dirname {
1527  my($self, $name) = @_;
1528  return $self->doif_dirname($self->get_value_with_default($name));
1529}
1530
1531
1532sub doif_dirname {
1533  my($self, $value) = @_;
1534
1535  if (defined $value) {
1536    $value = $self->validated_dirname($value);
1537    return ($value ne '.');
1538  }
1539  return undef;
1540}
1541
1542
1543sub handle_dirname {
1544  my($self, $name) = @_;
1545
1546  $self->append_current(
1547            $self->validated_dirname($self->get_value_with_default($name)));
1548}
1549
1550
1551sub handle_basename {
1552  my($self, $name) = @_;
1553
1554  $self->append_current(
1555            $self->tp_basename($self->get_value_with_default($name)));
1556}
1557
1558
1559sub handle_basenoextension {
1560  my($self, $name) = @_;
1561  my $val = $self->tp_basename($self->get_value_with_default($name));
1562
1563  $val =~ s/\.[^\.]+$//;
1564  $self->append_current($val);
1565}
1566
1567
1568sub handle_flag_overrides {
1569  my($self, $name) = @_;
1570  my $value = $self->get_flag_overrides($name);
1571  $self->append_current($value) if (defined $value);
1572}
1573
1574
1575sub handle_marker {
1576  my($self, $name) = @_;
1577  my $val = $self->{'prjc'}->get_verbatim($name);
1578  $self->append_current($val) if (defined $val);
1579}
1580
1581
1582sub handle_eval {
1583  my($self, $name) = @_;
1584  my $val = $self->get_value_with_default($name);
1585
1586  if (defined $val) {
1587    if (index($val, "<%eval($name)%>") >= 0) {
1588      $self->warning("Infinite recursion detected in '$name'.");
1589    }
1590    else {
1591      ## Enter the eval state
1592      ++$self->{'eval'};
1593
1594      ## Parse the eval line
1595      my($status, $error) = $self->parse_line(undef, $val);
1596      if ($status) {
1597        $self->{'built'} .= $self->{'eval_str'};
1598      }
1599      else {
1600        $self->warning($error);
1601      }
1602
1603      ## Leave the eval state
1604      --$self->{'eval'};
1605      $self->{'eval_str'} = '';
1606    }
1607  }
1608}
1609
1610
1611sub handle_pseudo {
1612  my($self, $name) = @_;
1613  $self->append_current($self->{'cmds'}->{$name});
1614}
1615
1616
1617sub get_duplicate_index {
1618  my($self, $name) = @_;
1619  return $self->doif_duplicate_index($self->get_value_with_default($name));
1620}
1621
1622
1623sub doif_duplicate_index {
1624  my($self, $value) = @_;
1625
1626  if (defined $value) {
1627    my $base = lc($self->tp_basename($value));
1628    my $path = $self->validated_dirname($value);
1629
1630    if (!defined $self->{'dupfiles'}->{$base}) {
1631      $self->{'dupfiles'}->{$base} = [$path];
1632    }
1633    else {
1634      my $index = 1;
1635      foreach my $file (@{$self->{'dupfiles'}->{$base}}) {
1636        return $index if ($file eq $path);
1637        ++$index;
1638      }
1639
1640      push(@{$self->{'dupfiles'}->{$base}}, $path);
1641      return 1;
1642    }
1643  }
1644
1645  return undef;
1646}
1647
1648
1649sub handle_duplicate_index {
1650  my($self, $name) = @_;
1651  my $value = $self->doif_duplicate_index(
1652                       $self->get_value_with_default($name));
1653  $self->append_current($value) if (defined $value);
1654}
1655
1656
1657sub get_transdir {
1658  my($self, $name) = @_;
1659  return $self->doif_transdir($self->get_value_with_default($name));
1660}
1661
1662
1663sub doif_transdir {
1664  my($self, $value) = @_;
1665
1666  if ($value =~ /([\/\\])/) {
1667    return $self->{'prjc'}->translate_directory(
1668                                  $self->tp_dirname($value)) . $1;
1669  }
1670
1671  return undef;
1672}
1673
1674
1675sub handle_transdir {
1676  my($self, $name) = @_;
1677  my $value = $self->doif_transdir($self->get_value_with_default($name));
1678  $self->append_current($value) if (defined $value);
1679}
1680
1681
1682sub prepare_parameters {
1683  my($self, $prefix) = @_;
1684  my $input = $self->get_value($prefix . '->input_file');
1685  my $output;
1686
1687  if (defined $input) {
1688    $input =~ s/\//\\/g if ($self->{'cslashes'});
1689    $output = $self->get_value($prefix . '->input_file->output_files');
1690
1691    if (defined $output) {
1692      my $size = scalar(@$output);
1693      for(my $i = 0; $i < $size; ++$i) {
1694        my $fo = $self->get_flag_overrides($prefix . '->input_file, gendir');
1695        if (defined $fo) {
1696          $$output[$i] = ($fo eq '.' ? '' : $fo . '/') .
1697                         $self->tp_basename($$output[$i]);
1698        }
1699        $$output[$i] =~ s/\//\\/g if ($self->{'cslashes'});
1700      }
1701    }
1702  }
1703
1704  ## Set the parameters array with the determined input and output files
1705  return $input, $output;
1706}
1707
1708
1709sub process_name {
1710  my($self, $line) = @_;
1711  my $length = 0;
1712  my $errorString;
1713
1714  ## Split the line into a name and value
1715  if ($line =~ /([^%\(]+)(\(([^%]+)\))?%>/) {
1716    my $name = lc($1);
1717    my $val  = $3;
1718    $length += length($name);
1719
1720    if (defined $val) {
1721      ## Check for the parenthesis
1722      if (($val =~ tr/(//) != ($val =~ tr/)//)) {
1723        return 'Missing the closing parenthesis', $length;
1724      }
1725
1726      ## Add the length of the value plus 2 for the surrounding ()
1727      $length += length($val) + 2;
1728    }
1729
1730    if (defined $keywords{$name}) {
1731      if ($name eq 'if') {
1732        $self->handle_if($val);
1733      }
1734      elsif ($name eq 'endif') {
1735        $errorString = $self->handle_endif($name);
1736      }
1737      elsif ($name eq 'else') {
1738        $errorString = $self->handle_else();
1739      }
1740      elsif ($name eq 'endfor') {
1741        $errorString = $self->handle_endfor($name);
1742      }
1743      elsif ($name eq 'foreach') {
1744        $errorString = $self->handle_foreach($val);
1745      }
1746      elsif ($name eq 'fornotlast'  || $name eq 'forlast' ||
1747             $name eq 'fornotfirst' || $name eq 'forfirst') {
1748        if (!$self->{'if_skip'}) {
1749          $self->handle_special($name, $self->process_special($val));
1750        }
1751      }
1752      elsif ($name eq 'comment') {
1753        ## Ignore the contents of the comment
1754      }
1755      else {
1756        if (!$self->{'if_skip'}) {
1757          if (index($val, '(') >= 0) {
1758            $self->evaluate_nested_functions($name, $val);
1759          }
1760          else {
1761            my $func = 'handle_' . $name;
1762            $self->$func($val);
1763            if ($self->{'error_in_handle'}) {
1764              $errorString = $self->{'error_in_handle'};
1765            }
1766          }
1767        }
1768      }
1769    }
1770    elsif (defined $self->{'cmds'}->{$name}) {
1771      $self->handle_pseudo($name) if (!$self->{'if_skip'});
1772    }
1773    else {
1774      if (!$self->{'if_skip'}) {
1775        if (defined $val && !defined $self->{'defaults'}->{$name}) {
1776          $self->{'defaults'}->{$name} = $self->process_special($val);
1777        }
1778        $self->append_current($self->get_value_with_default($name));
1779      }
1780    }
1781  }
1782  else {
1783    my $error  = $line;
1784    my $length = length($line);
1785    for(my $i = 0; $i < $length; ++$i) {
1786      my $part = substr($line, $i, 2);
1787      if ($part eq '%>') {
1788        $error = substr($line, 0, $i + 2);
1789        last;
1790      }
1791    }
1792    $errorString = "Unable to parse line starting at '$error'";
1793  }
1794
1795  return $errorString, $length;
1796}
1797
1798
1799sub collect_data {
1800  my $self  = shift;
1801  my $prjc = $self->{'prjc'};
1802  my $cwd = $self->getcwd();
1803
1804  ## Set the current working directory
1805  $cwd =~ s/\//\\/g if ($self->{'cslashes'});
1806  $self->{'values'}->{'cwd'} = $cwd;
1807
1808  ## Collect the components into {'values'} somehow
1809  foreach my $key (keys %{$prjc->{'valid_components'}}) {
1810    my @list = $prjc->get_component_list($key);
1811    $self->{'values'}->{$key} = \@list if (defined $list[0]);
1812  }
1813
1814  ## If there is a staticname and no sharedname then this project
1815  ## 'type_is_static'.  If we are generating static projects, let
1816  ## all of the templates know that we 'need_staticflags'.
1817  ## If there is a sharedname then this project 'type_is_dynamic'.
1818  my $sharedname = $prjc->get_assignment('sharedname');
1819  my $staticname = $prjc->get_assignment('staticname');
1820  if (!defined $sharedname && defined $staticname) {
1821    $self->{'override_target_type'} = 1;
1822    $self->{'values'}->{'type_is_static'}   = 1;
1823    $self->{'values'}->{'need_staticflags'} = 1;
1824  }
1825  elsif ($prjc->get_static() == 1) {
1826    $self->{'values'}->{'need_staticflags'} = 1;
1827  }
1828  elsif (defined $sharedname) {
1829    $self->{'values'}->{'type_is_dynamic'} = 1;
1830  }
1831
1832  ## If there is a sharedname or exename then this project
1833  ## 'type_is_binary'.
1834  if (defined $sharedname ||
1835      defined $prjc->get_assignment('exename')) {
1836    $self->{'values'}->{'type_is_binary'} = 1;
1837  }
1838
1839  ## A tiny hack (mainly for VC6 projects)
1840  ## for the workspace creator.  It needs to know the
1841  ## target names to match up with the project name.
1842  $prjc->update_project_info($self, 0, ['project_name']);
1843
1844  ## This is for all projects
1845  $prjc->update_project_info($self, 1, ['after']);
1846
1847  ## VC7 Projects need to know the GUID.
1848  ## We need to save this value in our known values
1849  ## since each guid generated will be different.  We need
1850  ## this to correspond to the same guid used in the workspace.
1851  my $guid = $prjc->update_project_info($self, 1, ['guid']);
1852  $self->{'values'}->{'guid'} = $guid;
1853
1854  ## In order for VC7 to mix languages, we need to keep track
1855  ## of the language associated with each project.
1856  $prjc->update_project_info($self, 1, ['language']);
1857
1858  ## For VC7+ to properly work with wince, which is cross compiled,
1859  ## a new platform-specific token is added, nocross, which is used
1860  ## to determine if a project is even to be built for non-native
1861  ## targets. Additionally, custom-only projects are built but not
1862  ## deployed, thus these are added to the project_info mix
1863  $prjc->update_project_info($self, 1, ['custom_only']);
1864  $prjc->update_project_info($self, 1, ['nocross']);
1865
1866  ## For VC8 to be able to add references to managed DLL's to the current
1867  ## managed DLL project (if it is one), we need to keep track of whether
1868  ## the project is 'managed' or not.
1869  $prjc->update_project_info($self, 1, ['managed']);
1870
1871  ## Some Windows based projects can't deal with certain version
1872  ## values.  So, for those we provide a translated version.
1873  my $version = $prjc->get_assignment('version');
1874  if (defined $version) {
1875    $self->{'values'}->{'win_version'} =
1876                        WinVersionTranslator::translate($version);
1877  }
1878}
1879
1880
1881sub parse_line {
1882  my($self, $ih, $line) = @_;
1883  my $errorString;
1884  my $startempty = ($line eq '');
1885
1886  ## If processing a foreach or the line only
1887  ## contains a keyword, then we do
1888  ## not need to add a newline to the end.
1889  if ($self->{'foreach'}->{'processing'} == 0 && !$self->{'eval'} &&
1890      ($line !~ /^[ ]*<%(\w+)(?:\((?:(?:\w+\s*,\s*)*[!]?\w+\(.+\)|[^\)]+)\))?%>$/ ||
1891       !defined $keywords{$1})) {
1892    $line .= $self->{'crlf'};
1893  }
1894
1895  if ($self->{'foreach'}->{'count'} < 0 && !$self->{'eval'}) {
1896    $self->{'built'} = '';
1897  }
1898
1899  my $start = index($line, '<%');
1900  if ($start >= 0) {
1901    my $append_name;
1902    if ($start > 0) {
1903      if (!$self->{'if_skip'}) {
1904        $self->append_current(substr($line, 0, $start));
1905      }
1906      $line = substr($line, $start);
1907    }
1908
1909    my $nlen = 0;
1910    foreach my $item (split('<%', $line)) {
1911      my $name   = 1;
1912      my $length = length($item);
1913      my $endi   = index($item, '%>');
1914      for(my $i = 0; $i < $length; ++$i) {
1915        if ($i == $endi) {
1916          ++$i;
1917          $endi = index($item, '%>', $i);
1918          $name = undef;
1919          if ($append_name) {
1920            $append_name = undef;
1921            if (!$self->{'if_skip'}) {
1922              $self->append_current('%>');
1923            }
1924          }
1925          if ($length != $i + 1) {
1926            if (!$self->{'if_skip'}) {
1927              $self->append_current(substr($item, $i + 1));
1928            }
1929            last;
1930          }
1931        }
1932        elsif ($name) {
1933          my $efcheck = (index($item, 'endfor%>') == 0);
1934          my $focheck = ($efcheck ? 0 : (index($item, 'foreach(') == 0));
1935
1936          if ($focheck && $self->{'foreach'}->{'count'} >= 0) {
1937            ++$self->{'foreach'}->{'nested'};
1938          }
1939
1940          if ($sel

Large files files are truncated, but you can click here to view the full file