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 Creator;
2 
 
3 
# ************************************************************
4 
# Description   : Base class for workspace and project creators
5 
# Author        : Chad Elliott
6 
# Create Date   : 5/13/2002
7 
# ************************************************************
8 
 
9 
# ************************************************************
10 
# Pragmas
11 
# ************************************************************
12 
 
13 
use strict;
14 
use FileHandle;
15 
use File::Basename;
16 
 
17 
use Parser;
18 
 
19 
use vars qw(@ISA);
20 
@ISA = qw(Parser);
21 
 
22 
# ************************************************************
23 
# Data Section
24 
# ************************************************************
25 
 
26 
my(@statekeys) = ('global', 'include', 'template', 'ti',
27 
                  'dynamic', 'static', 'relative', 'addtemp',
28 
                  'addproj', 'progress', 'toplevel', 'baseprojs',
29 
                  'feature_file', 'features', 'hierarchy',
30 
                  'name_modifier', 'apply_project', 'into', 'use_env',
31 
                  'expand_vars',
32 
                 );
33 
 
34 
my(%all_written) = ();
35 
 
36 
# ************************************************************
37 
# Subroutine Section
38 
# ************************************************************
39 
 
40 
sub new {
41 
  my($class)      = shift;
42 
  my($global)     = shift;
43 
  my($inc)        = shift;
44 
  my($template)   = shift;
45 
  my($ti)         = shift;
46 
  my($dynamic)    = shift;
47 
  my($static)     = shift;
48 
  my($relative)   = shift;
49 
  my($addtemp)    = shift;
50 
  my($addproj)    = shift;
51 
  my($progress)   = shift;
52 
  my($toplevel)   = shift;
53 
  my($baseprojs)  = shift;
54 
  my($feature)    = shift;
55 
  my($features)   = shift;
56 
  my($hierarchy)  = shift;
57 
  my($nmodifier)  = shift;
58 
  my($applypj)    = shift;
59 
  my($into)       = shift;
60 
  my($language)   = shift;
61 
  my($use_env)    = shift;
62 
  my($expandvars) = shift;
63 
  my($type)       = shift;
64 
  my($self)       = Parser::new($class, $inc);
65 
 
66 
  $self->{'relative'}        = $relative;
67 
  $self->{'template'}        = $template;
68 
  $self->{'ti'}              = $ti;
69 
  $self->{'global'}          = $global;
70 
  $self->{'grammar_type'}    = $type;
71 
  $self->{'type_check'}      = $type . '_defined';
72 
  $self->{'global_read'}     = 0;
73 
  $self->{'current_input'}   = '';
74 
  $self->{'progress'}        = $progress;
75 
  $self->{'addtemp'}         = $addtemp;
76 
  $self->{'addproj'}         = $addproj;
77 
  $self->{'toplevel'}        = $toplevel;
78 
  $self->{'files_written'}   = {};
79 
  $self->{'real_fwritten'}   = [];
80 
  $self->{'reading_global'}  = 0;
81 
  $self->{'global_assign'}   = {};
82 
  $self->{'assign'}          = {};
83 
  $self->{'baseprojs'}       = $baseprojs;
84 
  $self->{'dynamic'}         = $dynamic;
85 
  $self->{'static'}          = $static;
86 
  $self->{'feature_file'}    = $feature;
87 
  $self->{'features'}        = $features;
88 
  $self->{'hierarchy'}       = $hierarchy;
89 
  $self->{'name_modifier'}   = $nmodifier;
90 
  $self->{'apply_project'}   = $applypj;
91 
  $self->{'into'}            = $into;
92 
  $self->{'language'}        = $language;
93 
  $self->{'use_env'}         = $use_env;
94 
  $self->{'expand_vars'}     = $expandvars;
95 
  $self->{'convert_slashes'} = $self->convert_slashes();
96 
 
97 
  return $self;
98 
}
99 
 
100 
 
101 
sub preprocess_line {
102 
  my($self) = shift;
103 
  my($fh)   = shift;
104 
  my($line) = shift;
105 
 
106 
  $line = $self->strip_line($line);
107 
  while ($line =~ /\\$/) {
108 
    $line =~ s/\s*\\$/ /;
109 
    my($next) = $fh->getline();
110 
    if (defined $next) {
111 
      $line .= $self->strip_line($next);
112 
    }
113 
  }
114 
  return $line;
115 
}
116 
 
117 
 
118 
sub generate_default_input {
119 
  my($self)  = shift;
120 
  my($status,
121 
     $error) = $self->parse_line(undef, "$self->{'grammar_type'} {");
122 
 
123 
  if ($status) {
124 
    ($status, $error) = $self->parse_line(undef, '}');
125 
  }
126 
 
127 
  if (!$status) {
128 
    $self->error($error);
129 
  }
130 
 
131 
  return $status;
132 
}
133 
 
134 
 
135 
sub parse_file {
136 
  my($self)  = shift;
137 
  my($input) = shift;
138 
  my($oline) = $self->get_line_number();
139 
 
140 
  ## Read the input file and get the last line number
141 
  my($status, $errorString) = $self->read_file($input);
142 
 
143 
  if (!$status) {
144 
    $self->error($errorString,
145 
                 "$input: line " . $self->get_line_number() . ':');
146 
  }
147 
  elsif ($status && $self->{$self->{'type_check'}}) {
148 
    ## If we are at the end of the file and the type we are looking at
149 
    ## is still defined, then we have an error
150 
    $self->error("Did not " .
151 
                 "find the end of the $self->{'grammar_type'}",
152 
                 "$input: line " . $self->get_line_number() . ':');
153 
    $status = 0;
154 
  }
155 
  $self->set_line_number($oline);
156 
 
157 
  return $status;
158 
}
159 
 
160 
 
161 
sub generate {
162 
  my($self)   = shift;
163 
  my($input)  = shift;
164 
  my($status) = 1;
165 
 
166 
  ## Reset the files_written hash array between processing each file
167 
  $self->{'files_written'} = {};
168 
  $self->{'real_fwritten'} = [];
169 
 
170 
  ## Allow subclasses to reset values before
171 
  ## each call to generate().
172 
  $self->reset_values();
173 
 
174 
  ## Read the global configuration file
175 
  if (!$self->{'global_read'}) {
176 
    $status = $self->read_global_configuration();
177 
    $self->{'global_read'} = 1;
178 
  }
179 
 
180 
  if ($status) {
181 
    $self->{'current_input'} = $input;
182 
 
183 
    ## An empty input file name says that we
184 
    ## should generate a default input file and use that
185 
    if ($input eq '') {
186 
      $status = $self->generate_default_input();
187 
    }
188 
    else {
189 
      $status = $self->parse_file($input);
190 
    }
191 
  }
192 
 
193 
  return $status;
194 
}
195 
 
196 
 
197 
sub parse_assignment {
198 
  my($self)   = shift;
199 
  my($line)   = shift;
200 
  my($values) = shift;
201 
 
202 
  if ($line =~ /^(\w+(::\w+)*)\s*\+=\s*(.*)?/) {
203 
    my($name)  = lc($1);
204 
    my($value) = $3;
205 
    push(@$values, 'assign_add', $name, $value);
206 
    return 1;
207 
  }
208 
  elsif ($line =~ /^(\w+(::\w+)*)\s*=\s*(.*)?/) {
209 
    my($name)  = lc($1);
210 
    my($value) = $3;
211 
    push(@$values, 'assignment', $name, $value);
212 
    return 1;
213 
  }
214 
  elsif ($line =~ /^(\w+(::\w+)*)\s*\-=\s*(.*)?/) {
215 
    my($name)  = lc($1);
216 
    my($value) = $3;
217 
    push(@$values, 'assign_sub', $name, $value);
218 
    return 1;
219 
  }
220 
 
221 
  return 0;
222 
}
223 
 
224 
 
225 
sub parse_known {
226 
  my($self)        = shift;
227 
  my($line)        = shift;
228 
  my($status)      = 1;
229 
  my($errorString) = undef;
230 
  my($type)        = $self->{'grammar_type'};
231 
  my(@values)      = ();
232 
 
233 
  ##
234 
  ## Each regexp that looks for the '{' looks for it at the
235 
  ## end of the line.  It is purposely this way to decrease
236 
  ## the amount of extra lines in each file.  This
237 
  ## allows for the most compact file as human readably
238 
  ## possible.
239 
  ##
240 
  if ($line eq '') {
241 
  }
242 
  elsif ($line =~ /^$type\s*(\([^\)]+\))?\s*(:.*)?\s*{$/) {
243 
    my($name)    = $1;
244 
    my($parents) = $2;
245 
    if ($self->{$self->{'type_check'}}) {
246 
      $errorString = "Did not find the end of the $type";
247 
      $status = 0;
248 
    }
249 
    else {
250 
      if (defined $parents) {
251 
        my(@parents) = ();
252 
        $parents =~ s/^://;
253 
        foreach my $parent (split(',', $parents)) {
254 
          $parent =~ s/^\s+//;
255 
          $parent =~ s/\s+$//;
256 
          if ($parent ne '') {
257 
            push(@parents, $parent);
258 
          }
259 
        }
260 
        if (!defined $parents[0]) {
261 
          ## The : was used, but no parents followed.  This
262 
          ## is an error.
263 
          $errorString = 'No parents listed';
264 
          $status = 0;
265 
        }
266 
        $parents = \@parents;
267 
      }
268 
      push(@values, $type, $name, $parents);
269 
    }
270 
  }
271 
  elsif ($line =~ /^}$/) {
272 
    if ($self->{$self->{'type_check'}}) {
273 
      push(@values, $type, $line);
274 
    }
275 
    else {
276 
      $errorString = "Did not find the beginning of the $type";
277 
      $status = 0;
278 
    }
279 
  }
280 
  elsif ($line =~ /^(feature)\s*\(([^\)]+)\)\s*(:.*)?\s*{$/) {
281 
    my($type)    = $1;
282 
    my($name)    = $2;
283 
    my($parents) = $3;
284 
    my(@names)   = split(/\s*,\s*/, $name);
285 
 
286 
    if (defined $parents) {
287 
      my(@parents) = ();
288 
      $parents =~ s/^://;
289 
      foreach my $parent (split(',', $parents)) {
290 
        $parent =~ s/^\s+//;
291 
        $parent =~ s/\s+$//;
292 
        if ($parent ne '') {
293 
          push(@parents, $parent);
294 
        }
295 
      }
296 
      if (!defined $parents[0]) {
297 
        ## The : was used, but no parents followed.  This
298 
        ## is an error.
299 
        $errorString = 'No parents listed';
300 
        $status = 0;
301 
      }
302 
      $parents = \@parents;
303 
    }
304 
    push(@values, $type, \@names, $parents);
305 
  }
306 
  elsif (!$self->{$self->{'type_check'}}) {
307 
    $errorString = "No $type was defined";
308 
    $status = 0;
309 
  }
310 
  elsif ($self->parse_assignment($line, \@values)) {
311 
    ## If this returns true, then we've found an assignment
312 
  }
313 
  elsif ($line =~ /^(\w+)\s*(\([^\)]+\))?\s*{$/) {
314 
    my($comp) = lc($1);
315 
    my($name) = $2;
316 
 
317 
    if (defined $name) {
318 
      $name =~ s/^\(\s*//;
319 
      $name =~ s/\s*\)$//;
320 
    }
321 
    else {
322 
      $name = $self->get_default_component_name();
323 
    }
324 
    push(@values, 'component', $comp, $name);
325 
  }
326 
  else {
327 
    $errorString = "Unrecognized line: $line";
328 
    $status = -1;
329 
  }
330 
 
331 
  return $status, $errorString, @values;
332 
}
333 
 
334 
 
335 
sub parse_scope {
336 
  my($self)        = shift;
337 
  my($fh)          = shift;
338 
  my($name)        = shift;
339 
  my($type)        = shift;
340 
  my($validNames)  = shift;
341 
  my($flags)       = shift;
342 
  my($elseflags)   = shift;
343 
  my($status)      = 0;
344 
  my($errorString) = "Unable to process $name";
345 
 
346 
  if (!defined $flags) {
347 
    $flags = {};
348 
  }
349 
 
350 
  while(<$fh>) {
351 
    my($line) = $self->preprocess_line($fh, $_);
352 
 
353 
    if ($line eq '') {
354 
    }
355 
    elsif ($line =~ /^}$/) {
356 
      ($status, $errorString) = $self->handle_scoped_end($type, $flags);
357 
      last;
358 
    }
359 
    elsif (defined $elseflags && $line =~ /^}\s*else\s*{$/) {
360 
      ## From here on out anything after this goes into the $elseflags
361 
      $flags = $elseflags;
362 
      $elseflags = undef;
363 
 
364 
      ## We need to adjust the type also.  If there was a type
365 
      ## then the first part of the clause was used.  If there was
366 
      ## no type, then the first part was ignored and the second
367 
      ## part will be used.
368 
      if (defined $type) {
369 
        $type = undef;
370 
      }
371 
      else {
372 
        $type = $self->get_default_component_name();
373 
      }
374 
    }
375 
    else {
376 
      my(@values) = ();
377 
      if ($self->parse_assignment($line, \@values)) {
378 
        if (defined $$validNames{$values[1]}) {
379 
          if ($values[0] eq 'assignment') {
380 
            $self->process_assignment($values[1], $values[2], $flags);
381 
          }
382 
          elsif ($values[0] eq 'assign_add') {
383 
            $self->process_assignment_add($values[1], $values[2], $flags);
384 
          }
385 
          elsif ($values[0] eq 'assign_sub') {
386 
            $self->process_assignment_sub($values[1], $values[2], $flags);
387 
          }
388 
        }
389 
        else {
390 
          ($status,
391 
           $errorString) = $self->handle_unknown_assignment($type,
392 
                                                            @values);
393 
          if (!$status) {
394 
            last;
395 
          }
396 
        }
397 
      }
398 
      else {
399 
        ($status, $errorString) = $self->handle_scoped_unknown($fh,
400 
                                                               $type,
401 
                                                               $flags,
402 
                                                               $line);
403 
        if (!$status) {
404 
          last;
405 
        }
406 
      }
407 
    }
408 
  }
409 
  return $status, $errorString;
410 
}
411 
 
412 
 
413 
sub base_directory {
414 
  my($self) = shift;
415 
  return basename($self->getcwd());
416 
}
417 
 
418 
 
419 
sub generate_default_file_list {
420 
  my($self)    = shift;
421 
  my($dir)     = shift;
422 
  my($exclude) = shift;
423 
  my($recurse) = shift;
424 
  my($dh)      = new FileHandle();
425 
  my(@files)   = ();
426 
 
427 
  if (opendir($dh, $dir)) {
428 
    my($need_dir) = ($dir ne '.');
429 
    my($skip)     = 0;
430 
    foreach my $file (grep(!/^\.\.?$/, readdir($dh))) {
431 
      if ($^O eq 'VMS') {
432 
        $file =~ s/\.dir$//;
433 
      }
434 
      ## Prefix each file name with the directory only if it's not '.'
435 
      my($full) = ($need_dir ? "$dir/" : '') . $file;
436 
 
437 
      if (defined $$exclude[0]) {
438 
        foreach my $exc (@$exclude) {
439 
          if ($full eq $exc) {
440 
            $skip = 1;
441 
            last;
442 
          }
443 
        }
444 
      }
445 
 
446 
      if ($skip) {
447 
        $skip = 0;
448 
      }
449 
      else {
450 
        if ($recurse && -d $full) {
451 
          push(@files,
452 
               $self->generate_default_file_list($full, $exclude, $recurse));
453 
        }
454 
        else {
455 
          push(@files, $full);
456 
        }
457 
      }
458 
    }
459 
 
460 
    if ($self->sort_files()) {
461 
      @files = sort { $self->file_sorter($a, $b) } @files;
462 
    }
463 
 
464 
    closedir($dh);
465 
  }
466 
  return @files;
467 
}
468 
 
469 
 
470 
sub transform_file_name {
471 
  my($self) = shift;
472 
  my($name) = shift;
473 
 
474 
  $name =~ s/[\s\-]/_/g;
475 
  return $name;
476 
}
477 
 
478 
 
479 
sub file_written {
480 
  my($self) = shift;
481 
  my($file) = shift;
482 
  return (defined $all_written{$self->getcwd() . '/' . $file});
483 
}
484 
 
485 
 
486 
sub add_file_written {
487 
  my($self) = shift;
488 
  my($file) = shift;
489 
  my($key)  = lc($file);
490 
 
491 
  if (defined $self->{'files_written'}->{$key}) {
492 
    $self->warning("$self->{'grammar_type'} $file has " .
493 
                   "possibly been overwritten.");
494 
  }
495 
  else {
496 
    $self->{'files_written'}->{$key} = $file;
497 
    push(@{$self->{'real_fwritten'}}, $file);
498 
  }
499 
 
500 
  $all_written{$self->getcwd() . '/' . $file} = 1;
501 
}
502 
 
503 
 
504 
sub extension_recursive_input_list {
505 
  my($self)    = shift;
506 
  my($dir)     = shift;
507 
  my($exclude) = shift;
508 
  my($ext)     = shift;
509 
  my($fh)      = new FileHandle();
510 
  my(@files)   = ();
511 
 
512 
  if (opendir($fh, $dir)) {
513 
    foreach my $file (grep(!/^\.\.?$/, readdir($fh))) {
514 
      if ($^O eq 'VMS') {
515 
        $file =~ s/\.dir$//;
516 
      }
517 
      my($skip) = 0;
518 
      my($full) = ($dir ne '.' ? "$dir/" : '') . $file;
519 
 
520 
      ## Check for command line exclusions
521 
      if (defined $$exclude[0]) {
522 
        foreach my $exc (@$exclude) {
523 
          if ($full eq $exc) {
524 
            $skip = 1;
525 
            last;
526 
          }
527 
        }
528 
      }
529 
 
530 
      ## If we are not skipping this directory or file, then check it out
531 
      if (!$skip) {
532 
        if (-d $full) {
533 
          push(@files, $self->extension_recursive_input_list($full,
534 
                                                             $exclude,
535 
                                                             $ext));
536 
        }
537 
        elsif ($full =~ /$ext$/) {
538 
          push(@files, $full);
539 
        }
540 
      }
541 
    }
542 
    closedir($fh);
543 
  }
544 
 
545 
  return @files;
546 
}
547 
 
548 
 
549 
sub modify_assignment_value {
550 
  my($self)  = shift;
551 
  my($name)  = shift;
552 
  my($value) = shift;
553 
 
554 
  if ($self->{'convert_slashes'} && $name !~ /flags/) {
555 
    $value = $self->slash_to_backslash($value);
556 
  }
557 
  return $value;
558 
}
559 
 
560 
 
561 
sub get_assignment_hash {
562 
  ## NOTE: If anything in this block changes, then you must make the
563 
  ## same change in process_assignment.
564 
  my($self)   = shift;
565 
  my($tag)    = ($self->{'reading_global'} ? 'global_assign' : 'assign');
566 
  my($assign) = $self->{$tag};
567 
 
568 
  ## If we haven't yet defined the hash table in this project
569 
  if (!defined $assign) {
570 
    $assign = {};
571 
    $self->{$tag} = $assign;
572 
  }
573 
 
574 
  return $assign;
575 
}
576 
 
577 
 
578 
sub process_assignment {
579 
  my($self)   = shift;
580 
  my($name)   = shift;
581 
  my($value)  = shift;
582 
  my($assign) = shift;
583 
 
584 
  ## If no hash table was passed in
585 
  if (!defined $assign) {
586 
    ## NOTE: If anything in this block changes, then you must make the
587 
    ## same change in get_assignment_hash.
588 
    my($tag) = ($self->{'reading_global'} ? 'global_assign' : 'assign');
589 
    $assign  = $self->{$tag};
590 
 
591 
    ## If we haven't yet defined the hash table in this project
592 
    if (!defined $assign) {
593 
      $assign = {};
594 
      $self->{$tag} = $assign;
595 
    }
596 
  }
597 
 
598 
  if (defined $value) {
599 
    $value =~ s/^\s+//;
600 
    $value =~ s/\s+$//;
601 
 
602 
    ## Modify the assignment value before saving it
603 
    $$assign{$name} = $self->modify_assignment_value($name, $value);
604 
  }
605 
  else {
606 
    $$assign{$name} = undef;
607 
  }
608 
}
609 
 
610 
 
611 
sub process_assignment_add {
612 
  my($self)   = shift;
613 
  my($name)   = shift;
614 
  my($value)  = shift;
615 
  my($assign) = shift;
616 
  my($nval)   = $self->get_assignment_for_modification($name, $assign);
617 
 
618 
  ## Remove all duplicate parts from the value to be added.
619 
  ## Whether anything gets removed or not is up to the implementation
620 
  ## of the sub classes.
621 
  $value = $self->remove_duplicate_addition($name, $value, $nval);
622 
 
623 
  ## If there is anything to add, then do so
624 
  if ($value ne '') {
625 
    if (defined $nval) {
626 
      if ($self->preserve_assignment_order($name)) {
627 
        $nval .= " $value";
628 
      }
629 
      else {
630 
        $nval = "$value $nval";
631 
      }
632 
    }
633 
    else {
634 
      $nval = $value;
635 
    }
636 
    $self->process_assignment($name, $nval, $assign);
637 
  }
638 
}
639 
 
640 
 
641 
sub process_assignment_sub {
642 
  my($self)   = shift;
643 
  my($name)   = shift;
644 
  my($value)  = shift;
645 
  my($assign) = shift;
646 
  my($nval)   = $self->get_assignment_for_modification($name, $assign, 1);
647 
 
648 
  if (defined $nval) {
649 
    ## Remove double quotes if there are any
650 
    $value =~ s/^\"(.*)\"$/$1/;
651 
 
652 
    ## Escape any regular expression special characters
653 
    $value = $self->escape_regex_special($value);
654 
 
655 
    ## Due to the way process_assignment() works, we only need to
656 
    ## attempt to remove a value that is either followed by a space
657 
    ## or at the end of the line (single values are always at the end
658 
    ## of the line).
659 
    if ($nval =~ s/$value\s+// || $nval =~ s/$value$//) {
660 
      $self->process_assignment($name, $nval, $assign);
661 
    }
662 
  }
663 
}
664 
 
665 
 
666 
sub fill_type_name {
667 
  my($self)  = shift;
668 
  my($names) = shift;
669 
  my($def)   = shift;
670 
  my($array) = ($names =~ /\s/ ? $self->create_array($names) : [$names]);
671 
 
672 
  $names = '';
673 
  foreach my $name (@$array) {
674 
    if ($name =~ /\*/) {
675 
      my($pre)  = $def . '_';
676 
      my($mid)  = '_' . $def . '_';
677 
      my($post) = '_' . $def;
678 
 
679 
      ## Replace the beginning and end first then the middle
680 
      $name =~ s/^\*/$pre/;
681 
      $name =~ s/\*$/$post/;
682 
      $name =~ s/\*/$mid/g;
683 
 
684 
      ## Remove any trailing underscore or any underscore that is followed
685 
      ## by a space.  This value could be a space separated list.
686 
      $name =~ s/_$//;
687 
      $name =~ s/_\s/ /g;
688 
      $name =~ s/\s_/ /g;
689 
 
690 
      ## If any one word is capitalized then capitalize each word
691 
      if ($name =~ /[A-Z][0-9a-z_]+/) {
692 
        ## Do the first word
693 
        if ($name =~ /^([a-z])([^_]+)/) {
694 
          my($first) = uc($1);
695 
          my($rest)  = $2;
696 
          $name =~ s/^[a-z][^_]+/$first$rest/;
697 
        }
698 
        ## Do subsequent words
699 
        while($name =~ /(_[a-z])([^_]+)/) {
700 
          my($first) = uc($1);
701 
          my($rest)  = $2;
702 
          $name =~ s/_[a-z][^_]+/$first$rest/;
703 
        }
704 
      }
705 
    }
706 
 
707 
    $names .= $name . ' ';
708 
  }
709 
  $names =~ s/\s+$//;
710 
 
711 
  return $names;
712 
}
713 
 
714 
 
715 
sub save_state {
716 
  my($self)     = shift;
717 
  my($selected) = shift;
718 
  my(%state)    = ();
719 
 
720 
  ## Make a deep copy of each state value.  That way our array
721 
  ## references and hash references do not get accidentally modified.
722 
  foreach my $skey (defined $selected ? $selected : @statekeys) {
723 
    if (defined $self->{$skey}) {
724 
      if (UNIVERSAL::isa($self->{$skey}, 'ARRAY')) {
725 
        $state{$skey} = [];
726 
        foreach my $element (@{$self->{$skey}}) {
727 
          push(@{$state{$skey}}, $element);
728 
        }
729 
      }
730 
      elsif (UNIVERSAL::isa($self->{$skey}, 'HASH')) {
731 
        $state{$skey} = {};
732 
        foreach my $key (keys %{$self->{$skey}}) {
733 
          $state{$skey}->{$key} = $self->{$skey}->{$key};
734 
        }
735 
      }
736 
      else {
737 
        $state{$skey} = $self->{$skey};
738 
      }
739 
    }
740 
  }
741 
 
742 
  return %state;
743 
}
744 
 
745 
 
746 
sub restore_state {
747 
  my($self)     = shift;
748 
  my($state)    = shift;
749 
  my($selected) = shift;
750 
 
751 
  ## Make a deep copy of each state value.  That way our array
752 
  ## references and hash references do not get accidentally modified.
753 
  foreach my $skey (defined $selected ? $selected : @statekeys) {
754 
    if (defined $state->{$skey}) {
755 
      if (UNIVERSAL::isa($state->{$skey}, 'ARRAY')) {
756 
        my(@arr) = @{$state->{$skey}};
757 
        $self->{$skey} = \@arr;
758 
      }
759 
      elsif (UNIVERSAL::isa($state->{$skey}, 'HASH')) {
760 
        my(%hash) = %{$state->{$skey}};
761 
        $self->{$skey} = \%hash;
762 
      }
763 
      else {
764 
        $self->{$skey} = $state->{$skey};
765 
      }
766 
    }
767 
  }
768 
}
769 
 
770 
 
771 
sub get_global_cfg {
772 
  my($self) = shift;
773 
  return $self->{'global'};
774 
}
775 
 
776 
 
777 
sub get_template_override {
778 
  my($self) = shift;
779 
  return $self->{'template'};
780 
}
781 
 
782 
 
783 
sub get_ti_override {
784 
  my($self) = shift;
785 
  return $self->{'ti'};
786 
}
787 
 
788 
 
789 
sub get_relative {
790 
  my($self) = shift;
791 
  return $self->{'relative'};
792 
}
793 
 
794 
 
795 
sub get_progress_callback {
796 
  my($self) = shift;
797 
  return $self->{'progress'};
798 
}
799 
 
800 
 
801 
sub get_addtemp {
802 
  my($self) = shift;
803 
  return $self->{'addtemp'};
804 
}
805 
 
806 
 
807 
sub get_addproj {
808 
  my($self) = shift;
809 
  return $self->{'addproj'};
810 
}
811 
 
812 
 
813 
sub get_toplevel {
814 
  my($self) = shift;
815 
  return $self->{'toplevel'};
816 
}
817 
 
818 
 
819 
sub get_into {
820 
  my($self) = shift;
821 
  return $self->{'into'};
822 
}
823 
 
824 
 
825 
sub get_use_env {
826 
  my($self) = shift;
827 
  return $self->{'use_env'};
828 
}
829 
 
830 
 
831 
sub get_expand_vars {
832 
  my($self) = shift;
833 
  return $self->{'expand_vars'};
834 
}
835 
 
836 
 
837 
sub get_files_written {
838 
  my($self)  = shift;
839 
  return $self->{'real_fwritten'};
840 
}
841 
 
842 
 
843 
sub get_assignment {
844 
  my($self)   = shift;
845 
  my($name)   = shift;
846 
  my($assign) = shift;
847 
 
848 
  ## If no hash table was passed in
849 
  if (!defined $assign) {
850 
    my($tag) = ($self->{'reading_global'} ? 'global_assign' : 'assign');
851 
    $assign = $self->{$tag};
852 
  }
853 
 
854 
  return $$assign{$name};
855 
}
856 
 
857 
 
858 
sub get_assignment_for_modification {
859 
  my($self)        = shift;
860 
  my($name)        = shift;
861 
  my($assign)      = shift;
862 
  my($subtraction) = shift;
863 
  return $self->get_assignment($name, $assign);
864 
}
865 
 
866 
 
867 
sub get_baseprojs {
868 
  my($self) = shift;
869 
  return $self->{'baseprojs'};
870 
}
871 
 
872 
 
873 
sub get_dynamic {
874 
  my($self) = shift;
875 
  return $self->{'dynamic'};
876 
}
877 
 
878 
 
879 
sub get_static {
880 
  my($self) = shift;
881 
  return $self->{'static'};
882 
}
883 
 
884 
 
885 
sub get_default_component_name {
886 
  #my($self) = shift;
887 
  return 'default';
888 
}
889 
 
890 
 
891 
sub get_hierarchy {
892 
  my($self) = shift;
893 
  return $self->{'hierarchy'};
894 
}
895 
 
896 
 
897 
sub get_name_modifier {
898 
  my($self) = shift;
899 
  return $self->{'name_modifier'};
900 
}
901 
 
902 
 
903 
sub get_apply_project {
904 
  my($self) = shift;
905 
  return $self->{'apply_project'};
906 
}
907 
 
908 
 
909 
sub get_language {
910 
  my($self) = shift;
911 
  return $self->{'language'};
912 
}
913 
 
914 
sub get_outdir {
915 
  my($self) = shift;
916 
  if (defined $self->{'into'}) {
917 
    my($outdir) = $self->getcwd();
918 
    my($re)     = $self->escape_regex_special($self->getstartdir());
919 
 
920 
    $outdir =~ s/^$re//;
921 
    return $self->{'into'} . $outdir;
922 
  }
923 
  else {
924 
    return '.';
925 
  }
926 
}
927 
 
928 
# ************************************************************
929 
# Virtual Methods To Be Overridden
930 
# ************************************************************
931 
 
932 
sub preserve_assignment_order {
933 
  #my($self) = shift;
934 
  #my($name) = shift;
935 
  return 1;
936 
}
937 
 
938 
 
939 
sub compare_output {
940 
  #my($self) = shift;
941 
  return 0;
942 
}
943 
 
944 
 
945 
sub handle_scoped_end {
946 
  #my($self)  = shift;
947 
  #my($type)  = shift;
948 
  #my($flags) = shift;
949 
  return 1, undef;
950 
}
951 
 
952 
 
953 
sub handle_unknown_assignment {
954 
  my($self)   = shift;
955 
  my($type)   = shift;
956 
  my(@values) = @_;
957 
  return 0, "Invalid assignment name: $values[1]";
958 
}
959 
 
960 
 
961 
sub handle_scoped_unknown {
962 
  my($self)  = shift;
963 
  my($fh)    = shift;
964 
  my($type)  = shift;
965 
  my($flags) = shift;
966 
  my($line)  = shift;
967 
  return 0, "Unrecognized line: $line";
968 
}
969 
 
970 
 
971 
sub remove_duplicate_addition {
972 
  my($self)    = shift;
973 
  my($name)    = shift;
974 
  my($value)   = shift;
975 
  my($current) = shift;
976 
  return $value;
977 
}
978 
 
979 
 
980 
sub generate_recursive_input_list {
981 
  #my($self)    = shift;
982 
  #my($dir)     = shift;
983 
  #my($exclude) = shift;
984 
  return ();
985 
}
986 
 
987 
 
988 
sub reset_values {
989 
  #my($self) = shift;
990 
}
991 
 
992 
 
993 
sub sort_files {
994 
  #my($self) = shift;
995 
  return 1;
996 
}
997 
 
998 
 
999 
sub file_sorter {
1000 
  my($self)  = shift;
1001 
  my($left)  = shift;
1002 
  my($right) = shift;
1003 
  return $left cmp $right;
1004 
}
1005 
 
1006 
 
1007 
sub read_global_configuration {
1008 
  #my($self)  = shift;
1009 
  #my($input) = shift;
1010 
  return 1;
1011 
}
1012 
 
1013 
 
1014 
1;