Subversion Repositories gelsvn

Rev

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