Subversion Repositories gelsvn

Rev

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