Subversion Repositories gelsvn

Rev

Rev 198 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

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