Subversion Repositories gelsvn

Rev

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

Rev Author Line No. Line
107 bj 1 
package ProjectCreator;
2 
 
3 
# ************************************************************
4 
# Description   : Base class for all project creators
5 
# Author        : Chad Elliott
6 
# Create Date   : 3/13/2002
7 
# ************************************************************
8 
 
9 
# ************************************************************
10 
# Pragmas
11 
# ************************************************************
12 
 
13 
use strict;
14 
use FileHandle;
15 
use File::Path;
16 
use File::Compare;
17 
use File::Basename;
18 
 
19 
use Creator;
20 
use TemplateInputReader;
21 
use TemplateParser;
22 
use FeatureParser;
23 
 
24 
use vars qw(@ISA);
25 
@ISA = qw(Creator);
26 
 
27 
# ************************************************************
28 
# Data Section
29 
# ************************************************************
30 
 
31 
my($BaseClassExtension)      = 'mpb';
32 
my($ProjectCreatorExtension) = 'mpc';
33 
my($TemplateExtension)       = 'mpd';
34 
my($TemplateInputExtension)  = 'mpt';
35 
 
36 
## Valid names for assignments within a project
37 
## Bit Meaning
38 
## 0   Preserve the order for additions (1) or invert it (0)
39 
## 1   Add this value to template input value (if there is one)
40 
my(%validNames) = ('exename'         => 1,
41 
                   'sharedname'      => 1,
42 
                   'staticname'      => 1,
43 
                   'libpaths'        => 3,
44 
                   'install'         => 1,
45 
                   'includes'        => 3,
46 
                   'after'           => 1,
47 
                   'custom_only'     => 1,
48 
                   'libs'            => 2,
49 
                   'lit_libs'        => 2,
50 
                   'pure_libs'       => 2,
51 
                   'pch_header'      => 1,
52 
                   'pch_source'      => 1,
53 
                   'postbuild'       => 1,
54 
                   'dllout'          => 1,
55 
                   'libout'          => 1,
56 
                   'dynamicflags'    => 3,
57 
                   'staticflags'     => 3,
58 
                   'version'         => 1,
59 
                   'recurse'         => 1,
60 
                   'requires'        => 3,
61 
                   'avoids'          => 3,
62 
                   'tagname'         => 1,
63 
                   'tagchecks'       => 1,
64 
                   'macros'          => 3,
65 
                  );
66 
 
67 
## Custom definitions only
68 
## Bit  Meaning
69 
## 0    Value is always an array
70 
## 1    Value is an array and name gets 'outputext' converted to 'files'
71 
## 2    Value is always scalar
72 
## 3    Name can also be used in an 'optional' clause
73 
## 4    Needs <%...%> conversion
74 
my(%customDefined) = ('automatic'                   => 0x04,
75 
                      'dependent'                   => 0x14,
76 
                      'command'                     => 0x14,
77 
                      'commandflags'                => 0x14,
78 
                      'precommand'                  => 0x14,
79 
                      'postcommand'                 => 0x14,
80 
                      'inputext'                    => 0x01,
81 
                      'libpath'                     => 0x04,
82 
                      'output_option'               => 0x14,
83 
                      'pch_postrule'                => 0x04,
84 
                      'pre_extension'               => 0x08,
85 
                      'source_pre_extension'        => 0x08,
86 
                      'template_pre_extension'      => 0x08,
87 
                      'header_pre_extension'        => 0x08,
88 
                      'inline_pre_extension'        => 0x08,
89 
                      'documentation_pre_extension' => 0x08,
90 
                      'resource_pre_extension'      => 0x08,
198 bj 91 
                      'generic_pre_extension'       => 0x08,
107 bj 92 
                      'pre_filename'                => 0x08,
93 
                      'source_pre_filename'         => 0x08,
94 
                      'template_pre_filename'       => 0x08,
95 
                      'header_pre_filename'         => 0x08,
96 
                      'inline_pre_filename'         => 0x08,
97 
                      'documentation_pre_filename'  => 0x08,
98 
                      'resource_pre_filename'       => 0x08,
198 bj 99 
                      'generic_pre_filename'        => 0x08,
107 bj 100 
                      'source_outputext'            => 0x0a,
101 
                      'template_outputext'          => 0x0a,
102 
                      'header_outputext'            => 0x0a,
103 
                      'inline_outputext'            => 0x0a,
104 
                      'documentation_outputext'     => 0x0a,
105 
                      'resource_outputext'          => 0x0a,
106 
                      'generic_outputext'           => 0x0a,
107 
                     );
108 
 
109 
## Custom sections as well as definitions
110 
## Value  Meaning
111 
## 0    No modifications
112 
## 1    Needs <%...%> conversion
113 
my(%custom) = ('command'       => 1,
114 
               'commandflags'  => 1,
115 
               'dependent'     => 1,
116 
               'gendir'        => 0,
117 
               'precommand'    => 1,
118 
               'postcommand'   => 1,
119 
              );
120 
 
121 
## All matching assignment arrays will get these keywords
122 
my(@default_matching_assignments) = ('recurse',
123 
                                    );
124 
 
125 
## Deal with these components in a special way
126 
my(%specialComponents) = ('header_files'   => 1,
127 
                          'inline_files'   => 1,
128 
                          'template_files' => 1,
129 
                         );
130 
my(%sourceComponents)  = ('source_files'   => 1,
131 
                          'template_files' => 1,
132 
                         );
133 
 
134 
my($defgroup)    = 'default_group';
135 
my($grouped_key) = 'grouped_';
136 
 
137 
## Matches with generic_outputext
138 
my($generic_key) = 'generic_files';
139 
 
140 
# ************************************************************
141 
# C++ Specific Component Settings
142 
# ************************************************************
143 
 
144 
## Valid component names within a project along with the valid file extensions
145 
my(%cppvc) = ('source_files'        => [ "\\.cpp", "\\.cxx", "\\.cc", "\\.c", "\\.C", ],
146 
              'template_files'      => [ "_T\\.cpp", "_T\\.cxx", "_T\\.cc", "_T\\.c", "_T\\.C", ],
147 
              'header_files'        => [ "\\.h", "\\.hpp", "\\.hxx", "\\.hh", ],
148 
              'inline_files'        => [ "\\.i", "\\.inl", ],
149 
              'documentation_files' => [ "README", "readme", "\\.doc", "\\.txt", "\\.html" ],
150 
              'resource_files'      => [ "\\.rc", ],
151 
             );
152 
 
153 
## Exclude these extensions when auto generating the component values
154 
my(%cppec) = ('source_files' => $cppvc{'template_files'},
155 
             );
156 
 
157 
# ************************************************************
158 
# C# Specific Component Settings
159 
# ************************************************************
160 
 
161 
## Valid component names within a project along with the valid file extensions
162 
my(%csvc) = ('source_files'        => [ "\\.cs" ],
163 
             'config_files'        => [ "\\.config" ],
164 
             'resx_files'          => [ "\\.resx" ],
165 
             'ico_files'           => [ "\\.ico" ],
166 
             'documentation_files' => [ "README", "readme", "\\.doc", "\\.txt", "\\.html" ],
167 
            );
168 
 
169 
my(%csma) = ('source_files' => [ 'subtype' ],
170 
            );
171 
 
172 
# ************************************************************
173 
# Java Specific Component Settings
174 
# ************************************************************
175 
 
176 
## Valid component names within a project along with the valid file extensions
177 
my(%jvc) = ('source_files'        => [ "\\.java" ],
178 
            'documentation_files' => [ "README", "readme", "\\.doc", "\\.txt", "\\.html" ],
179 
           );
180 
 
181 
# ************************************************************
182 
# Visual Basic Specific Component Settings
183 
# ************************************************************
184 
 
185 
## Valid component names within a project along with the valid file extensions
186 
my(%vbvc) = ('source_files'        => [ "\\.vb" ],
187 
             'config_files'        => [ "\\.config" ],
188 
             'resx_files'          => [ "\\.resx" ],
189 
             'ico_files'           => [ "\\.ico" ],
190 
             'documentation_files' => [ "README", "readme", "\\.doc", "\\.txt", "\\.html" ],
191 
            );
192 
 
193 
my(%vbma) = ('source_files' => [ 'subtype' ],
194 
            );
195 
 
196 
# ************************************************************
197 
# Language Specific Component Settings
198 
# ************************************************************
199 
 
200 
# Index Description
201 
# ----- -----------
202 
# 0     File types
203 
# 1     Files automatically excluded from source_files
204 
# 2     Assignments available in standard file types
205 
# 3     The entry point for executables
206 
# 4     The language uses a C preprocessor
207 
my(%language) = ('cplusplus' => [ \%cppvc, \%cppec, {}    , 'main', 1 ],
208 
                 'csharp'    => [ \%csvc,  {},      \%csma, 'Main', 0 ],
209 
                 'java'      => [ \%jvc,   {},      {}    , 'Main', 0 ],
210 
                 'vb'        => [ \%vbvc,  {},      \%vbma, 'Main', 0 ],
211 
                );
212 
 
213 
# ************************************************************
214 
# Subroutine Section
215 
# ************************************************************
216 
 
217 
sub new {
218 
  my($class)      = shift;
219 
  my($global)     = shift;
220 
  my($inc)        = shift;
221 
  my($template)   = shift;
222 
  my($ti)         = shift;
223 
  my($dynamic)    = shift;
224 
  my($static)     = shift;
225 
  my($relative)   = shift;
226 
  my($addtemp)    = shift;
227 
  my($addproj)    = shift;
228 
  my($progress)   = shift;
229 
  my($toplevel)   = shift;
230 
  my($baseprojs)  = shift;
231 
  my($gfeature)   = shift;
232 
  my($feature)    = shift;
233 
  my($features)   = shift;
234 
  my($hierarchy)  = shift;
235 
  my($exclude)    = shift;
236 
  my($makeco)     = shift;
237 
  my($nmod)       = shift;
238 
  my($applypj)    = shift;
239 
  my($genins)     = shift;
240 
  my($into)       = shift;
241 
  my($language)   = shift;
242 
  my($use_env)    = shift;
243 
  my($expandvars) = shift;
244 
  my($self)       = $class->SUPER::new($global, $inc,
245 
                                       $template, $ti, $dynamic, $static,
246 
                                       $relative, $addtemp, $addproj,
247 
                                       $progress, $toplevel, $baseprojs,
248 
                                       $feature, $features,
249 
                                       $hierarchy, $nmod, $applypj,
250 
                                       $into, $language, $use_env,
251 
                                       $expandvars,
252 
                                       'project');
253 
 
254 
  $self->{$self->{'type_check'}}   = 0;
255 
  $self->{'feature_defined'}       = 0;
256 
  $self->{'project_info'}          = [];
257 
  $self->{'lib_locations'}         = {};
258 
  $self->{'reading_parent'}        = [];
259 
  $self->{'dexe_template_input'}   = undef;
260 
  $self->{'lexe_template_input'}   = undef;
261 
  $self->{'lib_template_input'}    = undef;
262 
  $self->{'dll_template_input'}    = undef;
263 
  $self->{'flag_overrides'}        = {};
264 
  $self->{'custom_special_output'} = {};
265 
  $self->{'custom_special_depend'} = {};
266 
  $self->{'special_supplied'}      = {};
267 
  $self->{'pctype'}                = $self->extractType("$self");
268 
  $self->{'verbatim'}              = {};
269 
  $self->{'verbatim_accessed'}     = {$self->{'pctype'} => {}};
270 
  $self->{'defaulted'}             = {};
271 
  $self->{'custom_types'}          = {};
272 
  $self->{'parents_read'}          = {};
273 
  $self->{'inheritance_tree'}      = {};
274 
  $self->{'remove_files'}          = {};
198 bj 275 
  $self->{'expanded'}              = {};
107 bj 276 
 
198 bj 277 
  my($typefeaturef) = $self->mpc_dirname($gfeature) . '/' .
107 bj 278 
                      $self->{'pctype'} . '.features';
279 
  $typefeaturef = undef if (! -r $typefeaturef);
280 
  $self->{'feature_parser'}        = new FeatureParser($features,
281 
                                                       $gfeature,
282 
                                                       $typefeaturef,
283 
                                                       $feature);
284 
  $self->{'convert_slashes'}       = $self->convert_slashes();
285 
  $self->{'sort_files'}            = $self->sort_files();
286 
  $self->{'source_callback'}       = undef;
287 
  $self->{'dollar_special'}        = $self->dollar_special();
288 
  $self->{'generate_ins'}          = $genins;
289 
  $self->{'addtemp_state'}         = undef;
290 
  $self->{'command_subs'}          = $self->get_command_subs();
291 
  $self->{'escape_spaces'}         = $self->escape_spaces();
292 
 
293 
  $self->add_default_matching_assignments();
294 
  $self->reset_generating_types();
295 
 
296 
  return $self;
297 
}
298 
 
299 
 
300 
sub read_global_configuration {
301 
  my($self)   = shift;
302 
  my($input)  = $self->get_global_cfg();
303 
  my($status) = 1;
304 
 
305 
  if (defined $input) {
306 
    ## If it doesn't contain a path, search the include path
307 
    if ($input !~ /[\/\\]/) {
308 
      $input = $self->search_include_path($input);
309 
      if (!defined $input) {
310 
        $input = $self->get_global_cfg();
311 
      }
312 
    }
313 
 
314 
    ## Read and parse the global project file
315 
    $self->{'reading_global'} = 1;
316 
    $status = $self->parse_file($input);
317 
    $self->{'reading_global'} = 0;
318 
  }
319 
 
320 
  return $status;
321 
}
322 
 
323 
 
324 
sub process_assignment {
325 
  my($self)   = shift;
326 
  my($name)   = shift;
327 
  my($value)  = shift;
328 
  my($assign) = shift;
329 
 
330 
  ## Support the '*' mechanism as in the project name, to allow
331 
  ## the user to correctly depend on another project within the same
332 
  ## directory.
333 
  if ($name eq 'after' && $value =~ /\*/) {
334 
    $value = $self->fill_type_name($value,
335 
                                   $self->get_default_project_name());
336 
  }
337 
  if (defined $value && !$self->{'dollar_special'} && $value =~ /\$\$/) {
338 
    $value =~ s/\$\$/\$/g;
339 
  }
340 
  $self->SUPER::process_assignment($name, $value, $assign);
341 
 
342 
  ## Support keyword mapping here only at the project level scope. The
343 
  ## scoped keyword mapping is done through the parse_scoped_assignment()
344 
  ## method.
345 
  if (!defined $assign || $assign == $self->get_assignment_hash()) {
346 
    my($mapped) = $self->{'valid_names'}->{$name};
347 
    if (defined $mapped && UNIVERSAL::isa($mapped, 'ARRAY')) {
348 
      $self->parse_scoped_assignment($$mapped[0], 'assignment',
349 
                                     $$mapped[1], $value,
350 
                                     $self->{'generated_exts'}->{$$mapped[0]});
351 
    }
352 
  }
353 
}
354 
 
355 
 
356 
sub get_assignment_for_modification {
357 
  my($self)        = shift;
358 
  my($name)        = shift;
359 
  my($assign)      = shift;
360 
  my($subtraction) = shift;
361 
 
362 
  ## If we weren't passed an assignment hash, then we need to
363 
  ## look one up that may possibly correctly deal with keyword mappings
364 
  if (!defined $assign) {
365 
    my($mapped) = $self->{'valid_names'}->{$name};
366 
 
367 
    if (defined $mapped && UNIVERSAL::isa($mapped, 'ARRAY')) {
368 
      $name   = $$mapped[1];
369 
      $assign = $self->{'generated_exts'}->{$$mapped[0]};
370 
    }
371 
  }
372 
 
373 
  ## Get the assignment value
374 
  my($value) = $self->get_assignment($name, $assign);
375 
 
376 
  ## If we are involved in a subtraction, we get back a value and
377 
  ## it's a scoped or mapped assignment, then we need to possibly
378 
  ## expand any template variables.  Otherwise, the subtractions
379 
  ## may not work correctly.
380 
  if ($subtraction && defined $value && defined $assign) {
381 
    $value = $self->relative($value, 1);
382 
  }
383 
 
384 
  return $value;
385 
}
386 
 
387 
 
388 
sub begin_project {
389 
  my($self)    = shift;
390 
  my($parents) = shift;
391 
  my($status)  = 1;
392 
  my($error)   = undef;
393 
 
394 
  ## Deal with the inheritance hierarchy first
395 
  ## Add in the base projects from the command line
396 
  if (!$self->{'reading_global'} &&
397 
      !defined $self->{'reading_parent'}->[0]) {
398 
    my($baseprojs) = $self->get_baseprojs();
399 
 
400 
    if (defined $parents) {
401 
      foreach my $base (@$baseprojs) {
402 
        my($found) = 0;
403 
        foreach my $parent (@$parents) {
404 
          if ($base eq $parent) {
405 
            $found = 1;
406 
            last;
407 
          }
408 
        }
409 
        if (!$found) {
410 
          push(@$parents, $base);
411 
        }
412 
      }
413 
    }
414 
    else {
415 
      $parents = $baseprojs;
416 
    }
417 
  }
418 
 
419 
  if (defined $parents) {
420 
    foreach my $parent (@$parents) {
421 
      ## Read in the parent onto ourself
422 
      my($file) = $self->search_include_path(
423 
                           "$parent.$BaseClassExtension");
424 
      if (!defined $file) {
425 
        $file = $self->search_include_path(
426 
                             "$parent.$ProjectCreatorExtension");
427 
      }
428 
 
429 
      if (defined $file) {
430 
        if (defined $self->{'reading_parent'}->[0]) {
431 
          foreach my $currently (@{$self->{'reading_parent'}}) {
432 
            if ($currently eq $file) {
433 
              $status = 0;
434 
              $error = 'Cyclic inheritance detected: ' . $parent;
435 
            }
436 
          }
437 
        }
438 
 
439 
        if ($status) {
440 
          if (!defined $self->{'parents_read'}->{$file}) {
441 
            $self->{'parents_read'}->{$file} = 1;
442 
 
443 
            ## Push the base project file onto the parent stack
444 
            push(@{$self->{'reading_parent'}}, $file);
445 
 
446 
            ## Collect up some information about the inheritance tree
447 
            my($tree) = $self->{'current_input'};
448 
            if (!defined $self->{'inheritance_tree'}->{$tree}) {
449 
              $self->{'inheritance_tree'}->{$tree} = {};
450 
            }
451 
            my($hash) = $self->{'inheritance_tree'}->{$tree};
452 
            foreach my $p (@{$self->{'reading_parent'}}) {
453 
              if (!defined $$hash{$p}) {
454 
                $$hash{$p} = {};
455 
              }
456 
              $hash = $$hash{$p};
457 
            }
458 
 
459 
            ## Begin reading the parent
460 
            $status = $self->parse_file($file);
461 
 
462 
            ## Take the base project file off of the parent stack
463 
            pop(@{$self->{'reading_parent'}});
464 
 
465 
            if (!$status) {
466 
              $error = "Invalid parent: $parent";
467 
            }
468 
          }
469 
          else {
470 
            ## The base project has already been read.  So, if
471 
            ## we are reading the original project (not a parent base
472 
            ## project), then the current base project is redundant.
473 
            if (!defined $self->{'reading_parent'}->[0]) {
474 
              $file =~ s/\.[^\.]+$//;
475 
              $self->information('Inheriting from \'' . basename($file) .
476 
                                 '\' in ' . $self->{'current_input'} .
477 
                                 ' is redundant at line ' .
478 
                                 $self->get_line_number() . '.');
479 
            }
480 
          }
481 
        }
482 
      }
483 
      else {
484 
        $status = 0;
485 
        $error = "Unable to locate parent: $parent";
486 
      }
487 
    }
488 
  }
489 
 
490 
  ## Copy each value from global_assign into assign
491 
  if (!$self->{'reading_global'}) {
492 
    foreach my $key (keys %{$self->{'global_assign'}}) {
493 
      if (!defined $self->{'assign'}->{$key}) {
494 
        $self->{'assign'}->{$key} = $self->{'global_assign'}->{$key};
495 
      }
496 
    }
497 
  }
498 
 
499 
  return $status, $error;
500 
}
501 
 
502 
 
503 
sub get_process_project_type {
504 
  my($self)    = shift;
505 
  my($types)   = shift;
506 
  my($type)    = '';
507 
  my($defcomp) = $self->get_default_component_name();
508 
 
509 
  foreach my $t (split(/\s*,\s*/, $types)) {
510 
    my($not) = ($t =~ s/^!\s*//);
511 
    if ($not) {
512 
      if ($t eq $self->{'pctype'}) {
513 
        $type = '';
514 
        last;
515 
      }
516 
      else {
517 
        $type = $self->{'pctype'};
518 
      }
519 
    }
520 
    elsif ($t eq $self->{'pctype'} || $t eq $defcomp) {
521 
      $type = $t;
522 
      last;
523 
    }
524 
  }
525 
 
526 
  return $type;
527 
}
528 
 
529 
 
530 
sub parse_line {
531 
  my($self)   = shift;
532 
  my($ih)     = shift;
533 
  my($line)   = shift;
534 
  my($status,
535 
     $errorString,
536 
     @values) = $self->parse_known($line);
537 
 
538 
  ## parse_known() passes back an array of values
539 
  ## that make up the contents of the line parsed.
540 
  ## The array can have 0 to 3 items.  The first,
541 
  ## if defined, is always an identifier of some
542 
  ## sort.
543 
 
544 
  if ($status && defined $values[0]) {
545 
    if ($values[0] eq $self->{'grammar_type'}) {
546 
      my($name)      = $values[1];
547 
      my($typecheck) = $self->{'type_check'};
548 
      if (defined $name && $name eq '}') {
549 
        ## Project Ending
550 
        my($rp) = $self->{'reading_parent'};
551 
        if (!defined $$rp[0] && !$self->{'reading_global'}) {
552 
          ## Fill in all the default values
553 
          $self->generate_defaults();
554 
 
555 
          ## Perform any additions, subtractions
556 
          ## or overrides for the project values.
557 
          my($addproj) = $self->get_addproj();
558 
          foreach my $ap (keys %$addproj) {
559 
            if (defined $self->{'valid_names'}->{$ap}) {
560 
              my($val) = $$addproj{$ap};
561 
              if ($$val[0] > 0) {
562 
                $self->process_assignment_add($ap, $$val[1]);
563 
              }
564 
              elsif ($$val[0] < 0) {
565 
                $self->process_assignment_sub($ap, $$val[1]);
566 
              }
567 
              else {
568 
                $self->process_assignment($ap, $$val[1]);
569 
              }
570 
            }
571 
            else {
572 
              $errorString = 'Invalid ' .
573 
                             "assignment modification name: $ap";
574 
              $status = 0;
575 
            }
576 
          }
577 
 
578 
          if ($status) {
579 
            ## End of project; Write out the file.
580 
            ($status, $errorString) = $self->write_project();
581 
 
582 
            ## write_project() can return 0 for error, 1 for project
583 
            ## was written and 2 for project was skipped
584 
            if ($status == 1) {
585 
              ## Save the library name and location
586 
              foreach my $name ('sharedname', 'staticname') {
587 
                my($val) = $self->get_assignment($name);
588 
                if (defined $val) {
589 
                  my($cwd)   = $self->getcwd();
590 
                  my($start) = $self->getstartdir();
591 
                  my($amount) = 0;
592 
                  if ($cwd eq $start) {
593 
                    $amount = length($start);
594 
                  }
595 
                  elsif (index($cwd, $start) == 0) {
596 
                    $amount = length($start) + 1;
597 
                  }
598 
                  $self->{'lib_locations'}->{$val} =
599 
                      substr($cwd, $amount);
600 
                  last;
601 
                }
602 
              }
603 
 
604 
              ## Check for unused verbatim markers
605 
              foreach my $key (keys %{$self->{'verbatim'}}) {
606 
                if (defined $self->{'verbatim_accessed'}->{$key}) {
607 
                  foreach my $ikey (keys %{$self->{'verbatim'}->{$key}}) {
608 
                    if (!defined $self->{'verbatim_accessed'}->{$key}->{$ikey}) {
609 
                      $self->warning("Marker $ikey does not exist.");
610 
                    }
611 
                  }
612 
                }
613 
              }
614 
            }
615 
 
616 
            ## Reset all of the project specific data
617 
            foreach my $key (keys %{$self->{'valid_components'}}) {
618 
              delete $self->{$key};
619 
              $self->{'defaulted'}->{$key} = 0;
620 
            }
621 
            if (defined $self->{'addtemp_state'}) {
622 
              $self->restore_state($self->{'addtemp_state'}, 'addtemp');
623 
              $self->{'addtemp_state'} = undef;
624 
            }
625 
            $self->{'assign'}                = {};
626 
            $self->{'verbatim'}              = {};
627 
            $self->{'verbatim_accessed'}     = {$self->{'pctype'} => {}};
628 
            $self->{'special_supplied'}      = {};
629 
            $self->{'flag_overrides'}        = {};
630 
            $self->{'parents_read'}          = {};
631 
            $self->{'inheritance_tree'}      = {};
632 
            $self->{'remove_files'}          = {};
633 
            $self->{'custom_special_output'} = {};
634 
            $self->{'custom_special_depend'} = {};
198 bj 635 
            $self->{'expanded'}              = {};
107 bj 636 
            $self->reset_generating_types();
637 
          }
638 
        }
639 
        $self->{$typecheck} = 0;
640 
      }
641 
      else {
642 
        ## Project Beginning
643 
        ($status, $errorString) = $self->begin_project($values[2]);
644 
 
645 
        ## Set up the default project name
646 
        if ($status) {
647 
          if (defined $name) {
648 
            if ($name =~ /[\/\\]/) {
649 
              $status = 0;
650 
              $errorString = 'Projects can not have a slash ' .
651 
                             'or a back slash in the name';
652 
            }
653 
            else {
654 
              ## We should only set the project name if we are not
655 
              ## reading in a parent project.
656 
              if (!defined $self->{'reading_parent'}->[0]) {
657 
                $name =~ s/^\(\s*//;
658 
                $name =~ s/\s*\)$//;
659 
                $name = $self->transform_file_name($name);
660 
 
661 
                ## Replace any *'s with the default name
662 
                if ($name =~ /\*/) {
663 
                  $name = $self->fill_type_name(
664 
                                    $name,
665 
                                    $self->get_default_project_name());
666 
                }
667 
 
668 
                $self->set_project_name($name);
669 
              }
670 
              else {
671 
                $self->warning("Ignoring project name in a base project.");
672 
              }
673 
            }
674 
          }
675 
        }
676 
 
677 
        if ($status) {
678 
          ## Signify that we have a valid project
679 
          $self->{$typecheck} = 1;
680 
        }
681 
      }
682 
    }
683 
    elsif ($values[0] eq 'assignment') {
684 
      my($name)  = $values[1];
685 
      my($value) = $values[2];
686 
      if (defined $self->{'valid_names'}->{$name}) {
687 
        $self->process_assignment($name, $value);
688 
      }
689 
      else {
690 
        $errorString = "Invalid assignment name: $name";
691 
        $status = 0;
692 
      }
693 
    }
694 
    elsif ($values[0] eq 'assign_add') {
695 
      my($name)  = $values[1];
696 
      my($value) = $values[2];
697 
      if (defined $self->{'valid_names'}->{$name}) {
698 
        $self->process_assignment_add($name, $value);
699 
      }
700 
      else {
701 
        $errorString = "Invalid addition name: $name";
702 
        $status = 0;
703 
      }
704 
    }
705 
    elsif ($values[0] eq 'assign_sub') {
706 
      my($name)  = $values[1];
707 
      my($value) = $values[2];
708 
      if (defined $self->{'valid_names'}->{$name}) {
709 
        $self->process_assignment_sub($name, $value);
710 
      }
711 
      else {
712 
        $errorString = "Invalid subtraction name: $name";
713 
        $status = 0;
714 
      }
715 
    }
716 
    elsif ($values[0] eq 'component') {
717 
      my($comp) = $values[1];
718 
      my($name) = $values[2];
719 
      if (defined $name) {
720 
        $name =~ s/^\(\s*//;
721 
        $name =~ s/\s*\)$//;
722 
      }
723 
      else {
724 
        $name = $self->get_default_component_name();
725 
      }
726 
 
727 
      my($vc) = $self->{'valid_components'};
728 
      if (defined $$vc{$comp}) {
729 
        ($status, $errorString) = $self->parse_components($ih, $comp, $name);
730 
      }
731 
      else {
732 
        if ($comp eq 'verbatim') {
733 
          my($type, $loc) = split(/\s*,\s*/, $name);
734 
          ($status, $errorString) = $self->parse_verbatim($ih, $type, $loc);
735 
        }
736 
        elsif ($comp eq 'specific') {
737 
          my($type) = $self->get_process_project_type($name);
738 
          if ($type eq $self->{'pctype'} ||
739 
              $type eq $self->get_default_component_name()) {
740 
            ($status, $errorString) = $self->parse_scope(
198 bj 741 
                                        $ih, $comp, $type,
107 bj 742 
                                        $self->{'valid_names'},
743 
                                        $self->get_assignment_hash(),
744 
                                        {});
745 
          }
746 
          else {
747 
            ## We still need to parse the scope, but we will be
748 
            ## throwing away whatever is processed.  However, it
749 
            ## could still be invalid code that will cause an error.
750 
            ($status, $errorString) = $self->parse_scope(
198 bj 751 
                                        $ih, $comp, undef,
107 bj 752 
                                        $self->{'valid_names'},
753 
                                        undef,
754 
                                        $self->get_assignment_hash());
755 
          }
756 
        }
757 
        elsif ($comp eq 'define_custom') {
758 
          ($status, $errorString) = $self->parse_define_custom($ih, $name);
759 
        }
198 bj 760 
        elsif ($comp eq 'expand') {
761 
          ($status, $errorString) = $self->parse_scope($ih, $comp, $name);
762 
        }
107 bj 763 
        else {
764 
          $errorString = "Invalid component name: $comp";
765 
          $status = 0;
766 
        }
767 
      }
768 
    }
769 
    elsif ($values[0] eq 'feature') {
770 
      $self->{'feature_defined'} = 1;
771 
      $self->process_feature($ih, $values[1], $values[2]);
772 
      if ($self->{'feature_defined'}) {
773 
        $errorString = "Did not find the end of the feature";
774 
        $status = 0;
775 
      }
776 
    }
777 
    else {
778 
      $errorString = "Unrecognized line: $line";
779 
      $status = 0;
780 
    }
781 
  }
782 
  elsif ($status == -1) {
783 
    $status = 0;
784 
  }
785 
 
786 
  return $status, $errorString;
787 
}
788 
 
789 
 
790 
sub parse_scoped_assignment {
791 
  my($self)   = shift;
792 
  my($tag)    = shift;
793 
  my($type)   = shift;
794 
  my($name)   = shift;
795 
  my($value)  = shift;
796 
  my($flags)  = shift;
797 
  my($over)   = {};
798 
  my($status) = 0;
799 
 
800 
  ## Map the assignment name on a scoped assignment
801 
  my($mapped) = $self->{'valid_names'}->{$name};
802 
  if (defined $mapped && UNIVERSAL::isa($mapped, 'ARRAY')) {
803 
    $name = $$mapped[1];
804 
  }
805 
 
806 
  if (defined $self->{'matching_assignments'}->{$tag}) {
807 
    foreach my $possible (@{$self->{'matching_assignments'}->{$tag}}) {
808 
      if ($possible eq $name) {
809 
        $status = 1;
810 
        last;
811 
      }
812 
    }
813 
  }
814 
 
815 
  if ($status) {
816 
    if (defined $self->{'flag_overrides'}->{$tag}) {
817 
      $over = $self->{'flag_overrides'}->{$tag};
818 
    }
819 
    else {
820 
      $self->{'flag_overrides'}->{$tag} = $over;
821 
    }
822 
 
823 
    if ($type eq 'assignment') {
824 
      $self->process_assignment($name, $value, $flags);
825 
    }
826 
    elsif ($type eq 'assign_add') {
827 
      ## If there is no value in $$flags, then we need to get
828 
      ## the outer scope value and put it in there.
829 
      if (!defined $self->get_assignment($name, $flags)) {
830 
        my($outer) = $self->get_assignment($name);
831 
        $self->process_assignment($name, $outer, $flags);
832 
      }
833 
      $self->process_assignment_add($name, $value, $flags);
834 
    }
835 
    elsif ($type eq 'assign_sub') {
836 
      ## If there is no value in $$flags, then we need to get
837 
      ## the outer scope value and put it in there.
838 
      if (!defined $self->get_assignment($name, $flags)) {
839 
        my($outer) = $self->get_assignment($name);
840 
        $self->process_assignment($name, $outer, $flags);
841 
      }
842 
      $self->process_assignment_sub($name, $value, $flags);
843 
    }
844 
  }
845 
  return $status;
846 
}
847 
 
848 
 
849 
sub handle_unknown_assignment {
850 
  my($self)   = shift;
851 
  my($type)   = shift;
852 
  my(@values) = @_;
853 
 
854 
  ## Unknown assignments within a 'specific' section are handled as
855 
  ## template value modifications.  These are handled exactly as the
856 
  ## -value_template option in Options.pm.
857 
 
858 
  ## If $type is not defined, then we are skipping this section
859 
  if (defined $type) {
860 
    ## Save the addtemp state if we haven't done so before
861 
    if (!defined $self->{'addtemp_state'}) {
862 
      my(%state) = $self->save_state('addtemp');
863 
      $self->{'addtemp_state'} = \%state;
864 
    }
865 
 
866 
    ## Now modify the addtemp values
867 
    $self->information("'$values[1]' was used as a template modifier.");
868 
    if ($values[0] eq 'assign_add') {
869 
      $values[0] = 1;
870 
    }
871 
    elsif ($values[0] eq 'assign_sub') {
872 
      $values[0] = -1;
873 
    }
874 
    else {
875 
      $values[0] = 0;
876 
    }
877 
 
878 
    if (!defined $self->get_addtemp()->{$values[1]}) {
879 
      $self->get_addtemp()->{$values[1]} = [];
880 
    }
881 
    push(@{$self->get_addtemp()->{$values[1]}}, [$values[0], $values[2]]);
882 
  }
883 
 
884 
  return 1, undef;
885 
}
886 
 
887 
 
198 bj 888 
sub handle_scoped_unknown {
889 
  my($self)  = shift;
890 
  my($fh)    = shift;
891 
  my($type)  = shift;
892 
  my($flags) = shift;
893 
  my($line)  = shift;
894 
 
895 
  if (defined $type) {
896 
    if ($type eq $self->get_default_component_name()) {
897 
      return 0, 'Can not set expansion in this context';
898 
    }
899 
    else {
900 
      if (!defined $self->{'expanded'}->{$type}) {
901 
        my($ok) = 1;
902 
        while($line =~ /\$(\w+)/) {
903 
          my($name) = $1;
904 
          my($val)  = '';
905 
          if ($name eq 'PWD') {
906 
            $val = $self->getcwd();
907 
          }
908 
          elsif (defined $ENV{$name}) {
909 
            $val = $ENV{$name};
910 
          }
911 
          else {
912 
            $ok = undef;
913 
            last;
914 
          }
915 
          $line =~ s/\$\w+/$val/;
916 
        }
917 
        $self->{'expanded'}->{$type} = $line if ($ok);
918 
      }
919 
      return 1, undef;
920 
    }
921 
  }
922 
 
923 
  ## If the type is not defined, then this is something other than an
924 
  ## assignment in a 'specific' section and should be flagged as an error
925 
  return 0, "Unrecognized line: $line";
926 
}
927 
 
107 bj 928 
sub process_component_line {
929 
  my($self)    = shift;
930 
  my($tag)     = shift;
931 
  my($line)    = shift;
932 
  my($flags)   = shift;
933 
  my($grname)  = shift;
934 
  my($current) = shift;
935 
  my($excarr)  = shift;
936 
  my($comps)   = shift;
937 
  my($count)   = shift;
938 
  my($status)  = 1;
939 
  my($error)   = undef;
940 
  my(%exclude) = ();
941 
 
942 
  my(@values) = ();
943 
  ## If this returns true, then we've found an assignment
944 
  if ($self->parse_assignment($line, \@values)) {
945 
    $status = $self->parse_scoped_assignment($tag, @values, $flags);
946 
    if (!$status) {
947 
      $error = 'Unknown keyword: ' . $values[1];
948 
    }
949 
  }
950 
  else {
951 
    ## If we successfully remove a '!' from the front, then
952 
    ## the file(s) listed are to be excluded
953 
    my($rem) = ($line =~ s/^\^\s*//);
954 
    my($exc) = $rem || ($line =~ s/^!\s*//);
955 
 
956 
    ## Convert any $(...) in this line before we process any
957 
    ## wild card characters.  If we do not, scoped assignments will
958 
    ## not work nor will we get the correct wild carded file list.
959 
    ## We also need to make sure that any back slashes are converted to
960 
    ## slashes to ensure that later flag_overrides checks will happen
961 
    ## correctly.
962 
    $line = $self->relative($line);
963 
    if ($self->{'convert_slashes'}) {
964 
      $line =~ s/\\/\//g;
965 
    }
966 
 
967 
    ## Now look for specially listed files
968 
    if ($line =~ /(.*)\s+(>>|<<)\s+(.*)/) {
969 
      $line    = $1;
970 
      my($oop) = $2;
971 
      my($out) = ($oop eq '>>' ? $3 : undef);
972 
      my($dep) = ($oop eq '<<' ? $3 : undef);
973 
 
974 
      $line =~ s/\s+$//;
975 
      if ($line =~ /(.*)\s+(>>|<<)\s+(.*)/) {
976 
        $line = $1;
977 
        $out  = ($2 eq '>>' ? $3 : $out);
978 
        $dep  = ($2 eq '<<' ? $3 : $dep);
979 
 
980 
        $line =~ s/\s+$//;
981 
        if ($2 eq $oop) {
982 
          $status = 0;
983 
          $error  = "Duplicate $oop used";
984 
        }
985 
      }
986 
 
987 
      ## Since these (custom_special_*) are used by the TemplateParser,
988 
      ## the keys need to have slashes in the target format.  So, we will
989 
      ## convert slashes back to target.
990 
      my($key) = $line;
991 
      if ($self->{'convert_slashes'}) {
992 
        $key = $self->slash_to_backslash($key);
993 
      }
994 
      if (defined $out) {
995 
        if (!defined $self->{'custom_special_output'}->{$tag}) {
996 
          $self->{'custom_special_output'}->{$tag} = {};
997 
        }
998 
        $self->{'custom_special_output'}->{$tag}->{$key} = $self->create_array($out);
999 
      }
1000 
      if (defined $dep) {
1001 
        $self->{'custom_special_depend'}->{$key} = $self->create_array($dep);
1002 
      }
1003 
    }
1004 
 
1005 
    ## Set up the files array.  If the line contains a wild card
1006 
    ## character use CORE::glob() to get the files specified.
1007 
    my(@files) = ();
1008 
    if ($line =~ /^"([^"]+)"$/) {
1009 
      push(@files, $1);
1010 
    }
1011 
    elsif ($line =~ /[\?\*\[\]]/) {
198 bj 1012 
      @files = $self->mpc_glob($line);
107 bj 1013 
    }
1014 
    else {
1015 
      push(@files, $line);
1016 
    }
1017 
 
1018 
    ## If we want to remove these files at the end too, then
1019 
    ## add them to our remove_files hash array.
1020 
    if ($rem) {
1021 
      if (!defined $self->{'remove_files'}->{$tag}) {
1022 
        $self->{'remove_files'}->{$tag} = {};
1023 
      }
1024 
      foreach my $file (@files) {
1025 
        $self->{'remove_files'}->{$tag}->{$file} = 1;
1026 
      }
1027 
    }
1028 
 
1029 
    ## If we're excluding these files, then put them in the hash
1030 
    if ($exc) {
1031 
      $$grname = $current;
1032 
      @exclude{@files} = (@files);
1033 
      @$excarr = @files;
1034 
    }
1035 
    else {
1036 
      ## Set the flag overrides for each file
1037 
      my($over) = $self->{'flag_overrides'}->{$tag};
1038 
      if (defined $over) {
1039 
        foreach my $file (@files) {
1040 
          $$over{$file} = $flags;
1041 
        }
1042 
      }
1043 
 
1044 
      foreach my $file (@files) {
1045 
        ## Add the file if we're not excluding it
1046 
        if (!defined $exclude{$file}) {
1047 
          push(@{$$comps{$current}}, $file);
1048 
        }
1049 
 
1050 
        ## The user listed a file explicitly, whether we
1051 
        ## excluded it or not.
1052 
        ++$$count;
1053 
      }
1054 
    }
1055 
  }
1056 
 
1057 
  return $status, $error;
1058 
}
1059 
 
1060 
 
1061 
sub parse_conditional {
1062 
  my($self)    = shift;
1063 
  my($fh)      = shift;
1064 
  my($types)   = shift;
1065 
  my($tag)     = shift;
1066 
  my($flags)   = shift;
1067 
  my($grname)  = shift;
1068 
  my($current) = shift;
1069 
  my($exclude) = shift;
1070 
  my($comps)   = shift;
1071 
  my($count)   = shift;
1072 
  my($status)  = 1;
1073 
  my($error)   = undef;
1074 
  my($add)     = 0;
1075 
  my($type)    = $self->get_process_project_type($types);
1076 
 
1077 
  if ($type eq $self->{'pctype'}) {
1078 
    $add = 1;
1079 
  }
1080 
 
1081 
  while(<$fh>) {
1082 
    my($line) = $self->preprocess_line($fh, $_);
1083 
 
1084 
    if ($line eq '') {
1085 
    }
1086 
    elsif ($line =~ /^}\s*else\s*{$/) {
1087 
      $add ^= 1;
1088 
    }
1089 
    elsif ($line =~ /^}$/) {
1090 
      last;
1091 
    }
1092 
    elsif ($add) {
1093 
      ($status, $error) = $self->process_component_line(
1094 
                                              $tag, $line, $flags,
1095 
                                              $grname, $current,
1096 
                                              $exclude, $comps, $count);
1097 
      if (!$status) {
1098 
        last;
1099 
      }
1100 
    }
1101 
  }
1102 
 
1103 
  return $status, $error;
1104 
}
1105 
 
1106 
sub parse_components {
1107 
  my($self)    = shift;
1108 
  my($fh)      = shift;
1109 
  my($tag)     = shift;
1110 
  my($name)    = shift;
1111 
  my($current) = $defgroup;
1112 
  my($status)  = 1;
1113 
  my($error)   = undef;
1114 
  my($names)   = {};
1115 
  my($comps)   = {};
1116 
  my($set)     = undef;
1117 
  my(%flags)   = ();
1118 
  my(@exclude) = ();
1119 
  my($custom)  = defined $self->{'generated_exts'}->{$tag};
1120 
  my($grtag)   = $grouped_key . $tag;
1121 
  my($grname)  = undef;
1122 
 
1123 
  if ($custom) {
1124 
    ## For the custom scoped assignments, we want to put a copy of
1125 
    ## the original custom defined values in our flags associative array.
1126 
    foreach my $key (keys %custom) {
1127 
      if (defined $self->{'generated_exts'}->{$tag}->{$key}) {
1128 
        $flags{$key} = $self->{'generated_exts'}->{$tag}->{$key};
1129 
      }
1130 
    }
1131 
  }
1132 
 
1133 
  if (defined $self->{$tag}) {
1134 
    $names = $self->{$tag};
1135 
  }
1136 
  else {
1137 
    $self->{$tag} = $names;
1138 
  }
1139 
  if (defined $$names{$name}) {
1140 
    $comps = $$names{$name};
1141 
  }
1142 
  else {
1143 
    $$names{$name} = $comps;
1144 
  }
1145 
  if (!defined $$comps{$current}) {
1146 
    $$comps{$current} = [];
1147 
  }
1148 
 
1149 
  my($count) = 0;
1150 
  if (defined $specialComponents{$tag}) {
1151 
    $self->{'special_supplied'}->{$tag} = 1;
1152 
  }
1153 
 
1154 
  while(<$fh>) {
1155 
    my($line) = $self->preprocess_line($fh, $_);
1156 
 
1157 
    if ($line eq '') {
1158 
    }
1159 
    elsif ($line =~ /^(\w+)\s*{$/) {
1160 
      if (!defined $current || !$set) {
1161 
        $current = $1;
1162 
        $set = 1;
1163 
        if (!defined $$comps{$current}) {
1164 
          $$comps{$current} = [];
1165 
        }
1166 
      }
1167 
      else {
1168 
        $status = 0;
1169 
        $error  = 'Can not nest groups';
1170 
        last;
1171 
      }
1172 
    }
1173 
    elsif ($line =~ /^conditional\s*(\(([^\)]+)\))\s*{$/) {
1174 
      ($status, $error) = $self->parse_conditional(
1175 
                                         $fh, $2, $tag, \%flags, \$grname,
1176 
                                         $current, \@exclude, $comps,
1177 
                                         \$count);
1178 
      if (!$status) {
1179 
        last;
1180 
      }
1181 
    }
1182 
    elsif ($line =~ /^}$/) {
1183 
      if (defined $current) {
1184 
        if (!defined $$comps{$current}->[0] && !defined $exclude[0]) {
1185 
          ## The default components name was never used
1186 
          ## so we remove it from the components
1187 
          delete $$comps{$current};
1188 
        }
1189 
        else {
1190 
          ## It was used, so we need to add that name to
1191 
          ## the set of group names unless it's already been added.
1192 
          my($groups)   = $self->get_assignment($grtag);
1193 
          my($addgroup) = 1;
1194 
          if (defined $groups) {
1195 
            foreach my $group (@{$self->create_array($groups)}) {
1196 
              if ($current eq $group) {
1197 
                $addgroup = 0;
1198 
                last;
1199 
              }
1200 
            }
1201 
          }
1202 
          if ($addgroup) {
1203 
            $self->process_assignment_add($grtag, $current);
1204 
          }
1205 
        }
1206 
      }
1207 
      if (defined $current && $set) {
1208 
        $current = $defgroup;
1209 
        $set = undef;
1210 
      }
1211 
      else {
1212 
        ## We are at the end of a component.  If the only group
1213 
        ## we added was the default group, then we need to remove
1214 
        ## the group setting altogether.
1215 
        my($groups) = $self->get_assignment($grtag);
1216 
        if (defined $groups) {
1217 
          my(@grarray) = @{$self->create_array($groups)};
1218 
          if ($#grarray == 0 && $grarray[0] eq $defgroup) {
1219 
            $self->process_assignment($grtag, undef);
1220 
          }
1221 
        }
1222 
 
1223 
        ## This is not an error,
1224 
        ## this is the end of the components
1225 
        last;
1226 
      }
1227 
    }
1228 
    elsif (defined $current) {
1229 
      ($status, $error) = $self->process_component_line($tag, $line, \%flags,
1230 
                                                        \$grname, $current,
1231 
                                                        \@exclude, $comps,
1232 
                                                        \$count);
1233 
      if (!$status) {
1234 
        last;
1235 
      }
1236 
    }
1237 
    else {
1238 
      $status = 0;
1239 
      $error  = 'Syntax error';
1240 
      last;
1241 
    }
1242 
  }
1243 
 
1244 
  ## If we didn't encounter an error, didn't have any files explicitly
1245 
  ## listed and we attempted to exclude files, then we need to find the
1246 
  ## set of files that don't match the excluded files and add them.
1247 
  if ($status && $#exclude != -1 && defined $grname) {
1248 
    my($alldir)  = $self->get_assignment('recurse') || $flags{'recurse'};
1249 
    my(%checked) = ();
1250 
    my(@files)   = ();
1251 
    foreach my $exc (@exclude) {
198 bj 1252 
      my($dname) = $self->mpc_dirname($exc);
107 bj 1253 
      if (!defined $checked{$dname}) {
1254 
        $checked{$dname} = 1;
1255 
        push(@files, $self->generate_default_file_list($dname,
1256 
                                                       \@exclude, $alldir));
1257 
      }
1258 
    }
1259 
 
1260 
    $self->sift_files(\@files,
1261 
                      $self->{'valid_components'}->{$tag},
1262 
                      $self->get_assignment('pch_header'),
1263 
                      $self->get_assignment('pch_source'),
1264 
                      $tag,
1265 
                      $$comps{$grname});
1266 
  }
1267 
 
1268 
  return $status, $error;
1269 
}
1270 
 
1271 
 
1272 
sub parse_verbatim {
1273 
  my($self) = shift;
1274 
  my($fh)   = shift;
1275 
  my($type) = shift;
1276 
  my($loc)  = shift;
1277 
 
1278 
  if (!defined $loc) {
1279 
    return 0, 'You must provide a location parameter to verbatim';
1280 
  }
1281 
 
1282 
  ## All types are lower case
1283 
  $type = lc($type);
1284 
 
1285 
  if (!defined $self->{'verbatim'}->{$type}) {
1286 
    $self->{'verbatim'}->{$type} = {};
1287 
  }
1288 
  $self->{'verbatim'}->{$type}->{$loc} = [];
1289 
  my($array) = $self->{'verbatim'}->{$type}->{$loc};
1290 
 
1291 
  while(<$fh>) {
1292 
    my($line) = $self->preprocess_line($fh, $_);
1293 
 
1294 
    if ($line =~ /^}$/) {
1295 
      ## This is not an error,
1296 
      ## this is the end of the verbatim
1297 
      last;
1298 
    }
1299 
    else {
1300 
      push(@$array, $line);
1301 
    }
1302 
  }
1303 
 
1304 
  return 1, undef;
1305 
}
1306 
 
1307 
 
1308 
sub process_feature {
1309 
  my($self)    = shift;
1310 
  my($fh)      = shift;
1311 
  my($names)   = shift;
1312 
  my($parents) = shift;
1313 
  my($status)  = 1;
1314 
  my($error)   = undef;
1315 
 
1316 
  my($requires) = '';
1317 
  my($avoids)   = '';
1318 
  foreach my $name (@$names) {
1319 
    if ($name =~ /^!\s*(.*)$/) {
1320 
      if ($avoids ne '') {
1321 
        $avoids .= ' ';
1322 
      }
1323 
      $avoids .= $1;
1324 
    }
1325 
    else {
1326 
      if ($requires ne '') {
1327 
        $requires .= ' ';
1328 
      }
1329 
      $requires .= $name;
1330 
    }
1331 
  }
1332 
 
1333 
  if ($self->check_features($requires, $avoids)) {
1334 
    ## The required features are enabled, so we say that
1335 
    ## a project has been defined and we allow the parser to
1336 
    ## find the data held within the feature.
1337 
    ($status, $error) = $self->begin_project($parents);
1338 
    if ($status) {
1339 
      $self->{'feature_defined'} = 0;
1340 
      $self->{$self->{'type_check'}} = 1;
1341 
    }
1342 
  }
1343 
  else {
1344 
    ## Otherwise, we read in all the lines until we find the
1345 
    ## closing brace for the feature and it appears to the parser
1346 
    ## that nothing was defined.
1347 
    my($curly) = 1;
1348 
    while(<$fh>) {
1349 
      my($line) = $self->preprocess_line($fh, $_);
1350 
 
1351 
      ## This is a very simplistic way of finding the end of
1352 
      ## the feature definition.  It will work as long as no spurious
1353 
      ## open curly braces are counted.
1354 
      if ($line =~ /{$/) {
1355 
        ++$curly;
1356 
      }
1357 
      if ($line =~ /^}/) {
1358 
        --$curly;
1359 
      }
1360 
      if ($curly == 0) {
1361 
        $self->{'feature_defined'} = 0;
1362 
        last;
1363 
      }
1364 
    }
1365 
  }
1366 
 
1367 
  return $status, $error;
1368 
}
1369 
 
1370 
 
1371 
sub process_array_assignment {
1372 
  my($self)  = shift;
1373 
  my($aref)  = shift;
1374 
  my($type)  = shift;
1375 
  my($array) = shift;
1376 
 
1377 
  if (!defined $$aref || $type eq 'assignment') {
1378 
    if ($type ne 'assign_sub') {
1379 
      $$aref = $array;
1380 
    }
1381 
  }
1382 
  else {
1383 
    if ($type eq 'assign_add') {
1384 
      push(@{$$aref}, @$array);
1385 
    }
1386 
    elsif ($type eq 'assign_sub') {
1387 
      my($count) = scalar(@{$$aref});
1388 
      for(my $i = 0; $i < $count; ++$i) {
1389 
        foreach my $val (@$array) {
1390 
          if ($$aref->[$i] eq $val) {
1391 
            splice(@{$$aref}, $i, 1);
1392 
            --$i;
1393 
            --$count;
1394 
            last;
1395 
          }
1396 
        }
1397 
      }
1398 
    }
1399 
  }
1400 
}
1401 
 
1402 
 
1403 
sub parse_define_custom {
1404 
  my($self)        = shift;
1405 
  my($fh)          = shift;
1406 
  my($tag)         = shift;
1407 
  my($status)      = 0;
1408 
  my($errorString) = "Unable to process $tag";
1409 
 
1410 
  ## Make the tag something _files
1411 
  $tag = lc($tag) . '_files';
1412 
 
1413 
  if ($tag eq $generic_key) {
1414 
    $errorString = "$tag is reserved";
1415 
  }
1416 
  elsif (defined $self->{'valid_components'}->{$tag}) {
1417 
    $errorString = "$tag has already been defined";
1418 
  }
1419 
  else {
1420 
    ## Update the custom_types assignment
1421 
    $self->process_assignment_add('custom_types', $tag);
1422 
 
1423 
    if (!defined $self->{'matching_assignments'}->{$tag}) {
1424 
      my(@keys) = keys %custom;
1425 
      push(@keys, @default_matching_assignments);
1426 
      $self->{'matching_assignments'}->{$tag} = \@keys;
1427 
    }
1428 
 
1429 
    ## Set up the 'optional' hash table
1430 
    $self->{'generated_exts'}->{$tag}->{'optional'} = {};
1431 
 
1432 
    my($optname) = undef;
1433 
    my($inscope) = 0;
1434 
    while(<$fh>) {
1435 
      my($line) = $self->preprocess_line($fh, $_);
1436 
 
1437 
      if ($line eq '') {
1438 
      }
1439 
      elsif ($line =~ /optional\s*\(([^\)]+)\)\s*{/) {
1440 
        $optname = $1;
1441 
        $optname =~ s/^\s+//;
1442 
        $optname =~ s/\s+$//;
1443 
        if (defined $customDefined{$optname} &&
1444 
            ($customDefined{$optname} & 0x08) != 0) {
1445 
          ++$inscope;
1446 
          if ($inscope != 1) {
1447 
            $status = 0;
1448 
            $errorString = 'Can not nest \'optional\' sections';
1449 
            last;
1450 
          }
1451 
        }
1452 
        else {
1453 
          $status = 0;
1454 
          $errorString = "Invalid optional name: $optname";
1455 
          last;
1456 
        }
1457 
      }
1458 
      elsif ($inscope) {
1459 
        if ($line =~ /^}$/) {
1460 
          $optname = undef;
1461 
          --$inscope;
1462 
        }
1463 
        else {
1464 
          if ($line =~ /(\w+)\s*\(([^\)]+)\)\s*\+=\s*(.*)/) {
1465 
            my($name) = lc($1);
1466 
            my($opt)  = $2;
1467 
            my(@val)  = split(/\s*,\s*/, $3);
1468 
 
1469 
            ## Fix $opt spacing
1470 
            $opt =~ s/(\&\&|\|\|)/ $1 /g;
1471 
            $opt =~ s/!\s+/!/g;
1472 
 
1473 
            if (!defined $self->{'generated_exts'}->{$tag}->
1474 
                                {'optional'}->{$optname}) {
1475 
              $self->{'generated_exts'}->{$tag}->
1476 
                     {'optional'}->{$optname} = {};
1477 
            }
1478 
            if (!defined $self->{'generated_exts'}->{$tag}->
1479 
                                {'optional'}->{$optname}->{$name}) {
1480 
              $self->{'generated_exts'}->{$tag}->
1481 
                     {'optional'}->{$optname}->{$name} = {};
1482 
            }
1483 
            if (!defined $self->{'generated_exts'}->{$tag}->
1484 
                                {'optional'}->{$optname}->{$name}->{$opt}) {
1485 
              $self->{'generated_exts'}->{$tag}->
1486 
                     {'optional'}->{$optname}->{$name}->{$opt} = [];
1487 
            }
1488 
            push(@{$self->{'generated_exts'}->{$tag}->{'optional'}->
1489 
                    {$optname}->{$name}->{$opt}}, @val);
1490 
          }
1491 
        }
1492 
      }
1493 
      elsif ($line =~ /^}$/) {
1494 
        $status = 1;
1495 
        $errorString = undef;
1496 
 
1497 
        ## Propagate the custom defined values into the mapped values
1498 
        foreach my $key (keys %{$self->{'valid_names'}}) {
1499 
          if (UNIVERSAL::isa($self->{'valid_names'}->{$key}, 'ARRAY')) {
1500 
            my($value) = $self->{'generated_exts'}->{$tag}->{
1501 
                                   $self->{'valid_names'}->{$key}->[1]};
1502 
            if (defined $value) {
1503 
              ## Bypass the process_assignment() defined in this class
1504 
              ## to avoid unwanted keyword mapping.
1505 
              $self->SUPER::process_assignment($key, $value);
1506 
            }
1507 
          }
1508 
        }
1509 
 
1510 
        ## Set some defaults (if they haven't already been set)
1511 
        if (!defined $self->{'generated_exts'}->{$tag}->{'pre_filename'}) {
1512 
          $self->{'generated_exts'}->{$tag}->{'pre_filename'} = [ '' ];
1513 
        }
1514 
        if (!defined $self->{'generated_exts'}->{$tag}->{'pre_extension'}) {
1515 
          $self->{'generated_exts'}->{$tag}->{'pre_extension'} = [ '' ];
1516 
        }
1517 
        if (!defined $self->{'generated_exts'}->{$tag}->{'automatic'}) {
1518 
          $self->{'generated_exts'}->{$tag}->{'automatic'} = 1;
1519 
        }
1520 
        if (!defined $self->{'valid_components'}->{$tag}) {
1521 
          $self->{'valid_components'}->{$tag} = [];
1522 
        }
1523 
        last;
1524 
      }
1525 
      else {
1526 
        my(@values) = ();
1527 
        ## If this returns true, then we've found an assignment
1528 
        if ($self->parse_assignment($line, \@values)) {
1529 
          my($type)  = $values[0];
1530 
          my($name)  = $values[1];
1531 
          my($value) = $values[2];
1532 
          if (defined $customDefined{$name}) {
1533 
            if (($customDefined{$name} & 0x01) != 0) {
1534 
              $value = $self->escape_regex_special($value);
1535 
              my(@array) = split(/\s*,\s*/, $value);
1536 
              $self->process_array_assignment(
1537 
                        \$self->{'valid_components'}->{$tag}, $type, \@array);
1538 
            }
1539 
            else {
1540 
              if (!defined $self->{'generated_exts'}->{$tag}) {
1541 
                $self->{'generated_exts'}->{$tag} = {};
1542 
              }
1543 
              ## Try to convert the value into a relative path
1544 
              $value = $self->relative($value);
1545 
 
1546 
              if (($customDefined{$name} & 0x04) != 0) {
1547 
                if ($type eq 'assignment') {
1548 
                  $self->process_assignment(
1549 
                                     $name, $value,
1550 
                                     $self->{'generated_exts'}->{$tag});
1551 
                }
1552 
                elsif ($type eq 'assign_add') {
1553 
                  $self->process_assignment_add(
1554 
                                     $name, $value,
1555 
                                     $self->{'generated_exts'}->{$tag});
1556 
                }
1557 
                elsif ($type eq 'assign_sub') {
1558 
                  $self->process_assignment_sub(
1559 
                                     $name, $value,
1560 
                                     $self->{'generated_exts'}->{$tag});
1561 
                }
1562 
              }
1563 
              else {
1564 
                if (($customDefined{$name} & 0x02) != 0) {
1565 
                  ## Transform the name from something outputext to
1566 
                  ## something files.  We expect this to match the
1567 
                  ## names of valid_assignments.
1568 
                  $name =~ s/outputext/files/g;
1569 
                }
1570 
 
1571 
                ## Get it ready for regular expressions
1572 
                $value = $self->escape_regex_special($value);
1573 
 
1574 
                ## Process the array assignment
1575 
                my(@array) = split(/\s*,\s*/, $value);
1576 
                $self->process_array_assignment(
1577 
                            \$self->{'generated_exts'}->{$tag}->{$name},
1578 
                            $type, \@array);
1579 
              }
1580 
            }
1581 
          }
1582 
          else {
1583 
            $status = 0;
1584 
            $errorString = "Invalid assignment name: $name";
1585 
            last;
1586 
          }
1587 
        }
1588 
        elsif ($line =~ /^(\w+)\s+(\w+)(\s*=\s*(\w+)?)?/) {
1589 
          ## Check for keyword mapping here
1590 
          my($keyword) = $1;
1591 
          my($newkey)  = $2;
1592 
          my($mapkey)  = $4;
1593 
          if ($keyword eq 'keyword') {
1594 
            if (defined $self->{'valid_names'}->{$newkey}) {
1595 
              $status = 0;
1596 
              $errorString = "Cannot map $newkey onto an " .
1597 
                             "existing keyword";
1598 
              last;
1599 
            }
1600 
            elsif (!defined $mapkey) {
1601 
              $self->{'valid_names'}->{$newkey} = 1;
1602 
            }
1603 
            elsif ($newkey ne $mapkey) {
1604 
              if (defined $customDefined{$mapkey}) {
1605 
                $self->{'valid_names'}->{$newkey} = [ $tag, $mapkey ];
1606 
              }
1607 
              else {
1608 
                $status = 0;
1609 
                $errorString = "Cannot map $newkey to an " .
1610 
                               "undefined custom keyword: $mapkey";
1611 
                last;
1612 
              }
1613 
            }
1614 
            else {
1615 
              $status = 0;
1616 
              $errorString = "Cannot map $newkey to $mapkey";
1617 
              last;
1618 
            }
1619 
          }
1620 
          else {
1621 
            $status = 0;
1622 
            $errorString = "Unrecognized line: $line";
1623 
            last;
1624 
          }
1625 
        }
1626 
        else {
1627 
          $status = 0;
1628 
          $errorString = "Unrecognized line: $line";
1629 
          last;
1630 
        }
1631 
      }
1632 
    }
1633 
  }
1634 
 
1635 
  return $status, $errorString;
1636 
}
1637 
 
1638 
 
1639 
sub remove_duplicate_addition {
1640 
  my($self)    = shift;
1641 
  my($name)    = shift;
1642 
  my($value)   = shift;
1643 
  my($nval)    = shift;
1644 
 
1645 
  ## If we are modifying the libs, libpaths, macros or includes
1646 
  ## assignment with either addition or subtraction, we are going to
1647 
  ## perform a little fix on the value to avoid multiple
1648 
  ## libraries and to try to insure the correct linking order
1649 
  if ($name eq 'macros'   ||
1650 
      $name eq 'libpaths' || $name eq 'includes' || $name =~ /libs$/) {
1651 
    if (defined $nval) {
1652 
      my($allowed) = '';
1653 
      my(%parts)   = ();
1654 
 
1655 
      ## Convert the array into keys for a hash table
1656 
      @parts{@{$self->create_array($nval)}} = ();
1657 
 
1658 
      ## In order to ensure that duplicates are correctly removed, we
1659 
      ## need to get the modified assignment value before we attempt to
1660 
      ## do so.
1661 
      $value = $self->modify_assignment_value($name, $value);
1662 
      foreach my $val (@{$self->create_array($value)}) {
1663 
        if (!exists $parts{$val}) {
198 bj 1664 
          my($qt) = ($val =~ /\s/ ? '"' : '');
1665 
          $allowed .= $qt . $val . $qt . ' ';
107 bj 1666 
        }
1667 
      }
1668 
      $allowed =~ s/\s+$//;
1669 
      return $allowed;
1670 
    }
1671 
  }
1672 
 
1673 
  return $value;
1674 
}
1675 
 
1676 
 
1677 
sub read_template_input {
1678 
  my($self)        = shift;
1679 
  my($status)      = 1;
1680 
  my($errorString) = undef;
1681 
  my($file)        = undef;
1682 
  my($tag)         = undef;
1683 
  my($ti)          = $self->get_ti_override();
1684 
  my($override)    = undef;
1685 
 
1686 
  if ($self->exe_target()) {
1687 
    if ($self->get_static() == 1) {
1688 
      $tag = 'lexe_template_input';
1689 
      if (!defined $self->{$tag}) {
1690 
        if (defined $$ti{'lib_exe'}) {
1691 
          $file = $$ti{'lib_exe'};
1692 
          $override = 1;
1693 
        }
1694 
        else {
1695 
          $file = $self->get_lib_exe_template_input_file();
1696 
        }
1697 
      }
1698 
    }
1699 
    else {
1700 
      $tag = 'dexe_template_input';
1701 
      if (!defined $self->{$tag}) {
1702 
        if (defined $$ti{'dll_exe'}) {
1703 
          $file = $$ti{'dll_exe'};
1704 
          $override = 1;
1705 
        }
1706 
        else {
1707 
          $file = $self->get_dll_exe_template_input_file();
1708 
        }
1709 
      }
1710 
    }
1711 
  }
1712 
  else {
1713 
    if ($self->get_static() == 1) {
1714 
      $tag = 'lib_template_input';
1715 
      if (!defined $self->{$tag}) {
1716 
        if (defined $$ti{'lib'}) {
1717 
          $file = $$ti{'lib'};
1718 
          $override = 1;
1719 
        }
1720 
        else {
1721 
          $file = $self->get_lib_template_input_file();
1722 
        }
1723 
      }
1724 
    }
1725 
    else {
1726 
      $tag = 'dll_template_input';
1727 
      if (!defined $self->{$tag}) {
1728 
        if (defined $$ti{'dll'}) {
1729 
          $file = $$ti{'dll'};
1730 
          $override = 1;
1731 
        }
1732 
        else {
1733 
          $file = $self->get_dll_template_input_file();
1734 
        }
1735 
      }
1736 
    }
1737 
  }
1738 
 
1739 
  if (defined $file) {
1740 
    my($file) = $self->search_include_path("$file.$TemplateInputExtension");
1741 
    if (defined $file) {
1742 
      $self->{$tag} = new TemplateInputReader($self->get_include_path());
1743 
      ($status, $errorString) = $self->{$tag}->cached_file_read($file);
1744 
    }
1745 
    else {
1746 
      if ($override) {
1747 
        $status = 0;
1748 
        $errorString = 'Unable to locate template input file.';
1749 
      }
1750 
    }
1751 
  }
1752 
 
1753 
  return $status, $errorString;
1754 
}
1755 
 
1756 
 
1757 
sub already_added {
1758 
  my($self)  = shift;
1759 
  my($array) = shift;
1760 
  my($name)  = shift;
1761 
 
1762 
  ## This method expects that the file
1763 
  ## name will be unix style
1764 
  $name =~ s/\\/\//g;
1765 
 
1766 
  foreach my $file (@$array) {
1767 
    if ($file eq $name) {
1768 
      return 1;
1769 
    }
1770 
  }
1771 
 
1772 
  ## If we haven't matched the name yet and the name
1773 
  ## begins with ./, we will remove it and try again.
1774 
  if ($name =~ s/^\.\///) {
1775 
    return $self->already_added($array, $name);
1776 
  }
1777 
 
1778 
  return 0;
1779 
}
1780 
 
1781 
 
1782 
sub get_applied_custom_keyword {
1783 
  my($self)  = shift;
1784 
  my($name)  = shift;
1785 
  my($type)  = shift;
1786 
  my($file)  = shift;
1787 
  my($value) = undef;
1788 
 
1789 
  if (defined $self->{'flag_overrides'}->{$type}->{$file}->{$name}) {
1790 
    $value = $self->{'flag_overrides'}->{$type}->{$file}->{$name};
1791 
  }
1792 
  else {
1793 
    $value = $self->get_assignment($name,
1794 
                                   $self->{'generated_exts'}->{$type});
1795 
  }
1796 
  return $self->relative($value, 1);
1797 
}
1798 
 
1799 
 
1800 
sub evaluate_optional_option {
1801 
  my($self)  = shift;
1802 
  my($opt)   = shift;
1803 
  my($value) = shift;
1804 
 
1805 
  if ($opt =~ /^!\s*(.*)/) {
1806 
    return (!exists $$value{$1} ? 1 : 0);
1807 
  }
1808 
  else {
1809 
    return (exists $$value{$opt} ? 1 : 0);
1810 
  }
1811 
 
1812 
  return 0;
1813 
}
1814 
 
1815 
 
1816 
sub process_optional_option {
1817 
  my($self)   = shift;
1818 
  my($opt)    = shift;
1819 
  my($value)  = shift;
1820 
  my($status) = undef;
1821 
  my(@parts)  = grep(!/^$/, split(/\s+/, $opt));
1822 
 
1823 
  for(my $i = 0; $i <= $#parts; $i++) {
1824 
    if ($parts[$i] eq '&&' || $parts[$i] eq '||') {
1825 
      if (defined $status) {
1826 
        if (defined $parts[$i + 1]) {
1827 
          if ($parts[$i] eq '&&') {
1828 
            $status &&= $self->evaluate_optional_option($parts[$i + 1],
1829 
                                                        $value);
1830 
          }
1831 
          else {
1832 
            $status ||= $self->evaluate_optional_option($parts[$i + 1],
1833 
                                                        $value);
1834 
          }
1835 
        }
1836 
        else {
1837 
          $self->warning("Expected token in optional after $parts[$i]");
1838 
        }
1839 
      }
1840 
      else {
1841 
        $self->warning("Unexpected token in optional: $parts[$i]");
1842 
      }
1843 
      ++$i;
1844 
    }
1845 
    else {
1846 
      if (!defined $status) {
1847 
        $status = $self->evaluate_optional_option($parts[$i], $value);
1848 
      }
1849 
      else {
1850 
        $self->warning("Unexpected token in optional: $parts[$i]");
1851 
      }
1852 
    }
1853 
  }
1854 
 
1855 
  return $status;
1856 
}
1857 
 
1858 
 
1859 
sub add_optional_filename_portion {
1860 
  my($self)    = shift;
1861 
  my($gentype) = shift;
1862 
  my($tag)     = shift;
1863 
  my($file)    = shift;
1864 
  my($array)   = shift;
1865 
 
1866 
  foreach my $name (keys %{$self->{'generated_exts'}->{$gentype}->{'optional'}->{$tag}}) {
1867 
    foreach my $opt (keys %{$self->{'generated_exts'}->{$gentype}->{'optional'}->{$tag}->{$name}}) {
1868 
      ## Get the name value
1869 
      my($value) = $self->get_applied_custom_keyword($name,
1870 
                                                     $gentype, $file);
1871 
 
1872 
      ## Convert the value into a hash map for easy lookup
1873 
      my(%values) = ();
1874 
      if (defined $value) {
1875 
        @values{split(/\s+/, $value)} = ();
1876 
      }
1877 
 
1878 
      ## See if the option or options are contained in the value
1879 
      if ($self->process_optional_option($opt, \%values)) {
1880 
        ## Add the optional portion
1881 
        push(@$array, @{$self->{'generated_exts'}->{$gentype}->{'optional'}->{$tag}->{$name}->{$opt}});
1882 
      }
1883 
    }
1884 
  }
1885 
}
1886 
 
1887 
 
1888 
sub get_pre_keyword_array {
1889 
  my($self)    = shift;
1890 
  my($keyword) = shift;
1891 
  my($gentype) = shift;
1892 
  my($tag)     = shift;
1893 
  my($file)    = shift;
1894 
 
1895 
  ## Get the general pre extension array
1896 
  my(@array) = @{$self->{'generated_exts'}->{$gentype}->{$keyword}};
1897 
 
1898 
  ## Add the component specific pre extension array
1899 
  my(@additional) = ();
1900 
  $tag =~ s/files$/$keyword/;
1901 
  if (defined $self->{'generated_exts'}->{$gentype}->{$tag}) {
1902 
    push(@additional, @{$self->{'generated_exts'}->{$gentype}->{$tag}});
1903 
  }
1904 
 
1905 
  ## Add in any optional portion to the array
1906 
  foreach my $itag ($keyword, $tag) {
1907 
    $self->add_optional_filename_portion($gentype, $itag,
1908 
                                         $file, \@additional);
1909 
  }
1910 
 
1911 
  ## If the current array only has the default,
1912 
  ## then we need to remove it
1913 
  if ($#additional >= 0) {
1914 
    if ($#array == 0 && $array[0] eq '') {
1915 
      pop(@array);
1916 
    }
1917 
    push(@array, @additional);
1918 
  }
1919 
 
1920 
  return @array;
1921 
}
1922 
 
1923 
 
1924 
sub generated_filename_arrays {
1925 
  my($self)  = shift;
1926 
  my($part)  = shift;
1927 
  my($type)  = shift;
1928 
  my($tag)   = shift;
1929 
  my($file)  = shift;
1930 
  my($rmesc) = shift;
1931 
  my($noext) = shift;
1932 
  my(@array) = ();
1933 
  my(@pearr) = $self->get_pre_keyword_array('pre_extension',
1934 
                                            $type, $tag, $file);
1935 
  my(@pfarr) = $self->get_pre_keyword_array('pre_filename',
1936 
                                            $type, $tag, $file);
1937 
  my(@exts)  = (defined $self->{'generated_exts'}->{$type}->{$tag} ?
1938 
                  @{$self->{'generated_exts'}->{$type}->{$tag}} : ());
1939 
 
1940 
  if ($#exts == -1) {
1941 
    my($backtag) = $tag;
1942 
    if ($backtag =~ s/files$/outputext/) {
1943 
      $self->add_optional_filename_portion($type, $backtag,
1944 
                                           $file, \@exts);
1945 
    }
1946 
  }
1947 
 
1948 
  if ($#pearr == 0 && $#pfarr == 0 && $#exts == -1 &&
1949 
      $pearr[0] eq '' && $pfarr[0] eq '') {
1950 
    ## If both arrays are defined to be the defaults, then there
1951 
    ## is nothing for us to do.
1952 
  }
1953 
  else {
1954 
    my($dir)  = '';
1955 
    my($base) = undef;
1956 
 
1957 
    ## Correctly deal with pre filename and directories
1958 
    if ($part =~ /(.*[\/\\])([^\/\\]+)$/) {
1959 
      $dir = $1;
1960 
      $base = $2;
1961 
    }
1962 
    else {
1963 
      $base = $part;
1964 
    }
1965 
 
1966 
    ## If gendir was specified, then we need to account for that
1967 
    if (defined $self->{'flag_overrides'}->{$type} &&
1968 
        defined $self->{'flag_overrides'}->{$type}->{$file} &&
1969 
        defined $self->{'flag_overrides'}->{$type}->{$file}->{'gendir'}) {
1970 
      if ($self->{'flag_overrides'}->{$type}->{$file}->{'gendir'} eq '.') {
1971 
        $dir = '';
1972 
      }
1973 
      else {
1974 
        $dir = $self->{'flag_overrides'}->{$type}->{$file}->{'gendir'} . '/';
1975 
      }
1976 
    }
1977 
 
1978 
    ## Loop through creating all of the possible file names
1979 
    foreach my $pe (@pearr) {
1980 
      push(@array, []);
1981 
      if ($rmesc) {
1982 
        $pe =~ s/\\\././g;
1983 
      }
1984 
      foreach my $pf (@pfarr) {
1985 
        if ($rmesc) {
1986 
          $pf =~ s/\\\././g;
1987 
        }
1988 
        if ($noext) {
1989 
          push(@{$array[$#array]}, "$dir$pf$base$pe");
1990 
        }
1991 
        else {
1992 
          foreach my $ext (@exts) {
1993 
            if ($rmesc) {
1994 
              $ext =~ s/\\\././g;
1995 
            }
1996 
            push(@{$array[$#array]}, "$dir$pf$base$pe$ext");
1997 
          }
1998 
        }
1999 
      }
2000 
    }
2001 
  }
2002 
 
2003 
  return @array;
2004 
}
2005 
 
2006 
 
2007 
sub generated_filenames {
2008 
  my($self)  = shift;
2009 
  my($part)  = shift;
2010 
  my($type)  = shift;
2011 
  my($tag)   = shift;
2012 
  my($file)  = shift;
2013 
  my($rmesc) = shift;
2014 
  my($noext) = shift;
2015 
  my(@files) = ();
2016 
  my(@array) = $self->generated_filename_arrays($part, $type, $tag,
2017 
                                                $file, $rmesc, $noext);
2018 
 
2019 
  foreach my $array (@array) {
2020 
    push(@files, @$array);
2021 
  }
2022 
 
2023 
  return @files;
2024 
}
2025 
 
2026 
 
2027 
sub add_generated_files {
2028 
  my($self)    = shift;
2029 
  my($gentype) = shift;
2030 
  my($tag)     = shift;
2031 
  my($group)   = shift;
2032 
  my($arr)     = shift;
2033 
 
2034 
  ## This method is called by list_default_generated.  It performs the
2035 
  ## actual file insertion and grouping.
2036 
 
2037 
  my($wanted) = $self->{'valid_components'}->{$gentype}->[0];
2038 
  if (defined $wanted) {
2039 
    ## Remove the escape sequences for the wanted extension.  It doesn't
2040 
    ## matter if the first valid extension is not the same as the actual
2041 
    ## input file (ex. input = car.y and first ext is .yy).  The extension
2042 
    ## is immediately removed in generated_filename_arrays.
2043 
    $wanted =~ s/\\//g;
2044 
  }
2045 
  else {
2046 
    $wanted = '';
2047 
  }
2048 
 
2049 
  ## Get the generated filenames
2050 
  my(@added) = ();
2051 
  foreach my $file (@$arr) {
2052 
    foreach my $gen ($self->generated_filenames($file, $gentype, $tag,
2053 
                                                "$file$wanted", 1, 1)) {
2054 
      $self->list_generated_file($gentype, $tag, \@added, $gen, $file);
2055 
    }
2056 
  }
2057 
 
2058 
  if ($#added >= 0) {
2059 
    my($names) = $self->{$tag};
2060 
 
2061 
    ## Get all files in one list and save the directory
2062 
    ## and component group in a hashed array.
2063 
    my(@all) = ();
2064 
    my(%dircomp) = ();
2065 
    foreach my $name (keys %$names) {
2066 
      foreach my $key (keys %{$$names{$name}}) {
2067 
        push(@all, @{$$names{$name}->{$key}});
2068 
        foreach my $file (@{$$names{$name}->{$key}}) {
2069 
          $dircomp{$self->mpc_dirname($file)} = $key;
2070 
        }
2071 
      }
2072 
    }
2073 
 
2074 
    ## Create a small array of only the files we want to add.
2075 
    ## We put them all together so we can keep them in order when
2076 
    ## we put them at the front of the main file list.
2077 
    my(@oktoadd) = ();
2078 
    foreach my $file (@added) {
2079 
      if (!$self->already_added(\@all, $file)) {
2080 
        push(@oktoadd, $file);
2081 
      }
2082 
    }
2083 
 
2084 
    ## If we have files to add, make sure we add them to a group
2085 
    ## that has the same directory location as the files we're adding.
2086 
    if ($#oktoadd >= 0) {
2087 
      my($key) = (defined $group ? $group :
2088 
                          $dircomp{$self->mpc_dirname($oktoadd[0])});
2089 
      if (!defined $key) {
2090 
        my($check) = $oktoadd[0];
2091 
        foreach my $regext (@{$self->{'valid_components'}->{$tag}}) {
2092 
          if ($check =~ s/$regext$//) {
2093 
            last;
2094 
          }
2095 
        }
2096 
        foreach my $vc (keys %{$self->{'valid_components'}}) {
2097 
          if ($vc ne $tag) {
2098 
            foreach my $name (keys %{$self->{$vc}}) {
2099 
              foreach my $ckey (keys %{$self->{$vc}->{$name}}) {
2100 
                if ($ckey ne $defgroup) {
2101 
                  foreach my $ofile (@{$self->{$vc}->{$name}->{$ckey}}) {
2102 
                    my($file) = $ofile;
2103 
                    foreach my $regext (@{$self->{'valid_components'}->{$vc}}) {
2104 
                      if ($file =~ s/$regext//) {
2105 
                        last;
2106 
                      }
2107 
                    }
2108 
                    if ($file eq $check) {
2109 
                      $key = $ckey;
2110 
                      last;
2111 
                    }
2112 
                  }
2113 
                }
2114 
                last if (defined $key);
2115 
              }
2116 
            }
2117 
            last if (defined $key);
2118 
          }
2119 
        }
2120 
        if (!defined $key) {
2121 
          $key = $defgroup;
2122 
        }
2123 
      }
2124 
      foreach my $name (keys %$names) {
2125 
        if (!defined $$names{$name}->{$key}) {
2126 
          if ($key ne $defgroup &&
2127 
              defined $$names{$name}->{$defgroup} &&
2128 
              defined $$names{$name}->{$defgroup}->[0]) {
2129 
            $self->process_assignment_add($grouped_key . $tag, $defgroup);
2130 
          }
2131 
          $$names{$name}->{$key} = [];
2132 
          $self->process_assignment_add($grouped_key . $tag, $key);
2133 
        }
2134 
        unshift(@{$$names{$name}->{$key}}, @oktoadd);
2135 
      }
2136 
    }
2137 
  }
2138 
}
2139 
 
2140 
 
2141 
sub search_for_entry {
2142 
  my($self)    = shift;
2143 
  my($file)    = shift;
2144 
  my($main)    = shift;
2145 
  my($preproc) = shift;
2146 
  my($name)    = undef;
2147 
  my($fh)      = new FileHandle();
2148 
 
2149 
  if (open($fh, $file)) {
2150 
    my($poundifed) = 0;
2151 
    my($commented) = 0;
2152 
 
2153 
    while(<$fh>) {
2154 
      if (!$preproc || !$commented) {
2155 
        ## Remove c++ style comments
2156 
        $_ =~ s/\/\/.*//;
2157 
      }
2158 
 
2159 
      ## If the current language supports a c preprocessor, we
2160 
      ## will perform a minimal check for #if 0 and c style comments.
2161 
      if ($preproc) {
2162 
        ## Remove one line c style comments
2163 
        $_ =~ s/\/\*.*\*\///g;
2164 
 
2165 
        if ($commented) {
2166 
          if (/\*\//) {
2167 
            ## Found the end of a multi-line c style comment
2168 
            --$commented;
2169 
          }
2170 
        }
2171 
        else {
2172 
          if (/\/\*/) {
2173 
            ## Found the beginning of a multi-line c style comment
2174 
            ++$commented;
2175 
          }
2176 
          elsif (/#\s*if\s+0/) {
2177 
            ## Found the beginning of a #if 0
2178 
            ++$poundifed;
2179 
          }
2180 
          elsif ($poundifed) {
2181 
            if (/#\s*if/) {
2182 
              ## We need to keep track of any other #if directives
2183 
              ## to be sure that when we see an #endif we don't
2184 
              ## count the wrong one.
2185 
              ++$poundifed;
2186 
            }
2187 
            elsif (/#\s*endif/) {
2188 
              ## Found a #endif, so decrement our count
2189 
              --$poundifed;
2190 
            }
2191 
          }
2192 
        }
2193 
      }
2194 
 
2195 
      ## Check for main; Make sure it's not #if 0'ed and not commented out
2196 
      if (!$poundifed && !$commented &&
2197 
          (/\s+$main\s*\(/ || /^\s*$main\s*\(/)) {
2198 
        ## If we've found a main, set the exename to the basename
2199 
        ## of the cpp file with the extension removed
2200 
        $name = basename($file);
2201 
        $name =~ s/\.[^\.]+$//;
2202 
        last;
2203 
      }
2204 
    }
2205 
    close($fh);
2206 
  }
2207 
  return $name;
2208 
}
2209 
 
2210 
 
2211 
sub generate_default_target_names {
2212 
  my($self) = shift;
2213 
 
2214 
  if (!$self->exe_target()) {
2215 
    my($sharedname) = $self->get_assignment('sharedname');
2216 
    my($staticname) = $self->get_assignment('staticname');
2217 
    my($shared_empty) = undef;
2218 
 
2219 
    if (defined $sharedname) {
2220 
      if ($sharedname eq '') {
2221 
        $shared_empty = 1;
2222 
        $sharedname = undef;
2223 
        $self->process_assignment('sharedname', $sharedname);
2224 
      }
2225 
      elsif (!defined $staticname) {
2226 
        $staticname = $sharedname;
2227 
        $self->process_assignment('staticname', $staticname);
2228 
      }
2229 
    }
2230 
    if (defined $staticname && !$shared_empty && !defined $sharedname) {
2231 
      $sharedname = $staticname;
2232 
      $self->process_assignment('sharedname', $sharedname);
2233 
    }
2234 
 
2235 
    ## If it's neither an exe or library target, we will search
2236 
    ## through the source files for a main()
2237 
    if (!$self->lib_target()) {
2238 
      my($exename) = undef;
2239 
      my(@sources) = $self->get_component_list('source_files', 1);
2240 
      my($main)    = $language{$self->get_language()}->[3];
2241 
      my($preproc) = $language{$self->get_language()}->[4];
2242 
 
2243 
      foreach my $file (@sources) {
2244 
        $exename = $self->search_for_entry($file, $main, $preproc);
2245 
 
2246 
        ## Set the exename assignment
2247 
        if (defined $exename) {
2248 
          $self->process_assignment('exename', $exename);
2249 
          last;
2250 
        }
2251 
      }
2252 
 
2253 
      ## If we still don't have a project type, then we will
2254 
      ## default to a library if there are source or resource files
2255 
      if (!defined $exename) {
2256 
        if ($#sources < 0) {
2257 
          @sources = $self->get_component_list('resource_files', 1);
2258 
        }
2259 
        if ($#sources >= 0) {
2260 
          if (!$shared_empty) {
2261 
            $self->process_assignment('sharedname',
2262 
                                      $self->{'unmodified_project_name'});
2263 
          }
2264 
          $self->process_assignment('staticname',
2265 
                                    $self->{'unmodified_project_name'});
2266 
        }
2267 
      }
2268 
    }
2269 
  }
2270 
 
2271 
  ## If we are generating only static projects, then we need to
2272 
  ## unset the sharedname, so that we can insure that projects of
2273 
  ## various types only generate static targets.
2274 
  if ($self->get_static() == 1) {
2275 
    my($sharedname) = $self->get_assignment('sharedname');
2276 
    if (defined $sharedname) {
2277 
      $self->process_assignment('sharedname', undef);
2278 
    }
2279 
  }
2280 
 
2281 
  ## Check for the use of an asterisk in the name
2282 
  foreach my $key ('exename', 'sharedname', 'staticname') {
2283 
    my($value) = $self->get_assignment($key);
2284 
    if (defined $value && $value =~ /\*/) {
2285 
      $value = $self->fill_type_name($value,
2286 
                                     $self->{'unmodified_project_name'});
2287 
      $self->process_assignment($key, $value);
2288 
    }
2289 
  }
2290 
}
2291 
 
2292 
 
2293 
sub generate_default_pch_filenames {
2294 
  my($self)    = shift;
2295 
  my($files)   = shift;
2296 
  my($pchhdef) = (defined $self->get_assignment('pch_header'));
2297 
  my($pchcdef) = (defined $self->get_assignment('pch_source'));
2298 
 
2299 
  if (!$pchhdef || !$pchcdef) {
2300 
    my($pname)     = $self->escape_regex_special(
2301 
                             $self->get_assignment('project_name'));
2302 
    my($hcount)    = 0;
2303 
    my($ccount)    = 0;
2304 
    my($hmatching) = undef;
2305 
    my($cmatching) = undef;
2306 
    foreach my $file (@$files) {
2307 
      ## If the file doesn't even contain _pch, then there's no point
2308 
      ## in looping through all of the extensions
2309 
      if ($file =~ /_pch/) {
2310 
        if (!$pchhdef) {
2311 
          foreach my $ext (@{$self->{'valid_components'}->{'header_files'}}) {
2312 
            if ($file =~ /(.*_pch$ext)$/) {
2313 
              $self->process_assignment('pch_header', $1);
2314 
              ++$hcount;
2315 
              if ($file =~ /$pname/) {
2316 
                $hmatching = $file;
2317 
              }
2318 
              last;
2319 
            }
2320 
          }
2321 
        }
2322 
        if (!$pchcdef) {
2323 
          foreach my $ext (@{$self->{'valid_components'}->{'source_files'}}) {
2324 
            if ($file =~ /(.*_pch$ext)$/) {
2325 
              $self->process_assignment('pch_source', $1);
2326 
              ++$ccount;
2327 
              if ($file =~ /$pname/) {
2328 
                $cmatching = $file;
2329 
              }
2330 
              last;
2331 
            }
2332 
          }
2333 
        }
2334 
      }
2335 
    }
2336 
    if (!$pchhdef && $hcount > 1 && defined $hmatching) {
2337 
      $self->process_assignment('pch_header', $hmatching);
2338 
    }
2339 
    if (!$pchcdef && $ccount > 1 && defined $cmatching) {
2340 
      $self->process_assignment('pch_source', $cmatching);
2341 
    }
2342 
  }
2343 
}
2344 
 
2345 
 
2346 
sub fix_pch_filenames {
2347 
  my($self) = shift;
2348 
  foreach my $type ('pch_header', 'pch_source') {
2349 
    my($pch) = $self->get_assignment($type);
2350 
    if (defined $pch && $pch eq '') {
2351 
      $self->process_assignment($type, undef);
2352 
    }
2353 
  }
2354 
}
2355 
 
2356 
 
2357 
sub remove_extra_pch_listings {
2358 
  my($self) = shift;
2359 
  my(@pchs) = ('pch_header', 'pch_source');
2360 
  my(@tags) = ('header_files', 'source_files');
2361 
 
2362 
  for(my $j = 0; $j <= $#pchs; ++$j) {
2363 
    my($pch) = $self->get_assignment($pchs[$j]);
2364 
 
2365 
    if (defined $pch) {
2366 
      ## If we are converting slashes, then we need to
2367 
      ## convert the pch file back to forward slashes
2368 
      if ($self->{'convert_slashes'}) {
2369 
        $pch =~ s/\\/\//g;
2370 
      }
2371 
 
2372 
      ## Find out which files are duplicated
2373 
      my($names) = $self->{$tags[$j]};
2374 
      foreach my $name (keys %$names) {
2375 
        my($comps) = $$names{$name};
2376 
        foreach my $key (keys %$comps) {
2377 
          my($array) = $$comps{$key};
2378 
          my($count) = scalar(@$array);
2379 
          for(my $i = 0; $i < $count; ++$i) {
2380 
            if ($pch eq $$array[$i]) {
2381 
              splice(@$array, $i, 1);
2382 
              --$count;
2383 
            }
2384 
          }
2385 
        }
2386 
      }
2387 
    }
2388 
  }
2389 
}
2390 
 
2391 
 
2392 
sub sift_files {
2393 
  my($self)   = shift;
2394 
  my($files)  = shift;
2395 
  my($exts)   = shift;
2396 
  my($pchh)   = shift;
2397 
  my($pchc)   = shift;
2398 
  my($tag)    = shift;
2399 
  my($array)  = shift;
2400 
  my($alldir) = shift;
2401 
  my(@saved)  = ();
2402 
  my($ec)     = $self->{'exclude_components'};
2403 
 
2404 
  foreach my $file (@$files) {
2405 
    foreach my $ext (@$exts) {
2406 
      ## Always exclude the precompiled header and cpp
2407 
      if ($file =~ /$ext$/ && (!defined $pchh || $file ne $pchh) &&
2408 
                              (!defined $pchc || $file ne $pchc)) {
2409 
        my($exclude) = 0;
2410 
        if (defined $$ec{$tag}) {
2411 
          foreach my $exc (@{$$ec{$tag}}) {
2412 
            if ($file =~ /$exc$/) {
2413 
              $exclude = 1;
2414 
              last;
2415 
            }
2416 
          }
2417 
        }
2418 
        elsif (!$alldir && $tag eq 'resource_files') {
2419 
          ## Save these files for later.  There may
2420 
          ## be more than one and we want to try and
2421 
          ## find the one that corresponds to this project
2422 
          $exclude = 1;
2423 
          push(@saved, $file);
2424 
        }
2425 
 
2426 
        if (!$exclude && !$self->already_added($array, $file)) {
2427 
          push(@$array, $file);
2428 
        }
2429 
        last;
2430 
      }
2431 
    }
2432 
  }
2433 
 
2434 
  ## Now deal with the saved files
2435 
  if (defined $saved[0]) {
2436 
    if ($#saved == 0) {
2437 
      ## Theres only one rc file, take it
2438 
      push(@$array, $saved[0]);
2439 
    }
2440 
    else {
2441 
      my($pjname) = $self->escape_regex_special(
2442 
                              $self->transform_file_name(
2443 
                                  $self->get_assignment('project_name')));
2444 
      ## Use a case insensitive search.
2445 
      ## After all, this is a Windows specific file type.
2446 
      foreach my $save (@saved) {
2447 
        if ($save =~ /$pjname/i) {
2448 
          if (!$self->already_added($array, $save)) {
2449 
            push(@$array, $save);
2450 
          }
2451 
        }
2452 
      }
2453 
    }
2454 
  }
2455 
}
2456 
 
2457 
 
2458 
sub sift_default_file_list {
2459 
  my($self)    = shift;
2460 
  my($tag)     = shift;
2461 
  my($file)    = shift;
2462 
  my($built)   = shift;
2463 
  my($exts)    = shift;
2464 
  my($recurse) = shift;
2465 
  my($pchh)    = shift;
2466 
  my($pchc)    = shift;
2467 
  my($alldir)  = $recurse ||
2468 
                 $self->{'flag_overrides'}->{$tag}->{$file}->{'recurse'};
2469 
  my(@gen)     = $self->generate_default_file_list($file, [], $alldir);
2470 
 
2471 
  $self->sift_files(\@gen, $exts, $pchh, $pchc, $tag, $built, $alldir);
2472 
 
2473 
}
2474 
 
2475 
 
2476 
sub generate_default_components {
2477 
  my($self)    = shift;
2478 
  my($files)   = shift;
2479 
  my($passed)  = shift;
2480 
  my($vc)      = $self->{'valid_components'};
2481 
  my(@tags)    = (defined $passed ? $passed : keys %$vc);
2482 
  my($pchh)    = $self->get_assignment('pch_header');
2483 
  my($pchc)    = $self->get_assignment('pch_source');
2484 
  my($recurse) = $self->get_assignment('recurse');
2485 
 
2486 
  ## The order of @tags does make a difference in the way that generated
2487 
  ## files get added.  And since the tags are user definable, there may be
2488 
  ## a problem with that.
2489 
  foreach my $tag (@tags) {
2490 
    if (!defined $self->{'generated_exts'}->{$tag} ||
2491 
        $self->{'generated_exts'}->{$tag}->{'automatic'}) {
2492 
      my($exts) = $$vc{$tag};
2493 
      if (defined $$exts[0]) {
2494 
        if (defined $self->{$tag}) {
2495 
          ## If the tag is defined, then process directories
2496 
          my($names) = $self->{$tag};
2497 
          foreach my $name (keys %$names) {
2498 
            my($comps) = $$names{$name};
2499 
            foreach my $comp (keys %$comps) {
2500 
              my($array) = $$comps{$comp};
2501 
              if (defined $passed) {
2502 
                $self->sift_files($files, $exts, $pchh, $pchc, $tag, $array);
2503 
              }
2504 
              else {
2505 
                my(@built) = ();
2506 
                foreach my $file (@$array) {
2507 
                  if (-d $file) {
2508 
                    $self->sift_default_file_list($tag, $file, \@built,
2509 
                                                  $exts, $recurse, $pchh, $pchc);
2510 
                  }
2511 
                  else {
2512 
                    if (!$self->already_added(\@built, $file)) {
2513 
                      push(@built, $file);
2514 
                    }
2515 
                  }
2516 
                }
2517 
                $$comps{$comp} = \@built;
2518 
              }
2519 
            }
2520 
          }
2521 
        }
2522 
        else {
2523 
          ## Generate default values for undefined tags
2524 
          my($defcomp) = $self->get_default_component_name();
2525 
          $self->{$tag} = {};
2526 
          my($comps) = {};
2527 
          $self->{$tag}->{$defcomp} = $comps;
2528 
          $$comps{$defgroup} = [];
2529 
          my($array) = $$comps{$defgroup};
2530 
 
2531 
          $self->{'defaulted'}->{$tag} = 1;
2532 
 
2533 
          if (!defined $specialComponents{$tag}) {
2534 
            $self->sift_files($files, $exts, $pchh, $pchc, $tag, $array);
2535 
            if (defined $sourceComponents{$tag}) {
2536 
              my($grtag) = $grouped_key . $tag;
2537 
              foreach my $gentype (keys %{$self->{'generated_exts'}}) {
2538 
                ## If we are auto-generating the source_files, then
2539 
                ## we need to make sure that any generated source
2540 
                ## files that are added are put at the front of the list.
2541 
                my($newgroup) = undef;
2542 
                my(@input) = ();
2543 
 
2544 
                ## If I call keys %{$self->{$gentype}} using perl 5.6.1
2545 
                ## it returns nothing.  I have to put it in an
2546 
                ## intermediate variable to ensure that I get the keys.
2547 
                my($names) = $self->{$gentype};
2548 
                foreach my $name (keys %$names) {
2549 
                  foreach my $key (keys %{$$names{$name}}) {
2550 
                    push(@input, @{$$names{$name}->{$key}});
2551 
                    if ($key ne $defgroup) {
2552 
                      $newgroup = $key;
2553 
                    }
2554 
                  }
2555 
                }
2556 
 
2557 
                if ($#input != -1) {
2558 
                  my(@front) = ();
2559 
                  my(@copy)  = @$array;
2560 
 
2561 
                  @$array = ();
2562 
                  foreach my $input (@input) {
198 bj 2563 
                    my($part) = $self->remove_wanted_extension(
2564 
                                   $input,
2565 
                                   $self->{'valid_components'}->{$gentype});
2566 
 
107 bj 2567 
                    $part = $self->escape_regex_special($part);
2568 
                    my(@files) = $self->generated_filenames($part, $gentype,
2569 
                                                            $tag, $input, 1);
2570 
                    if ($#copy != -1) {
2571 
                      my($found) = 0;
2572 
                      foreach my $file (@files) {
2573 
                        for(my $i = 0; $i <= $#copy; $i++) {
2574 
                          my($re) = $self->escape_regex_special($copy[$i]);
2575 
                          if ($file eq $copy[$i] || $file =~ /[\/\\]$re$/) {
2576 
                            ## No need to check for previously added files
2577 
                            ## here since there are none.
2578 
                            $found = 1;
2579 
                            push(@front, $file);
2580 
                            splice(@copy, $i, 1);
2581 
                            last;
2582 
                          }
2583 
                        }
2584 
                        if ($found) {
2585 
                          last;
2586 
                        }
2587 
                      }
2588 
                      if (!$found) {
2589 
                        my($ext) = $$exts[0];
2590 
                        foreach my $file (@files) {
2591 
                          if ($file =~ /$ext$/) {
2592 
                            push(@front, $file);
2593 
                          }
2594 
                        }
2595 
                      }
2596 
                    }
2597 
                    else {
2598 
                      my($ext) = $$exts[0];
2599 
                      foreach my $file (@files) {
2600 
                        if ($file =~ /$ext$/) {
2601 
                          push(@front, $file);
2602 
                        }
2603 
                      }
2604 
                    }
2605 
                  }
2606 
                  if ($#copy != -1) {
2607 
                    ## No need to check for previously added files
2608 
                    ## here since there are none.
2609 
                    push(@$array, @copy);
2610 
                    if (defined $self->get_assignment($grtag)) {
2611 
                      $self->process_assignment_add($grtag, $defgroup);
2612 
                    }
2613 
                  }
2614 
                  if (defined $front[0]) {
2615 
                    if (defined $newgroup) {
2616 
                      if ($#copy != -1) {
2617 
                        $self->process_assignment_add($grtag, $defgroup);
2618 
                      }
2619 
                      $self->{$tag}->{$defcomp}->{$newgroup} = \@front;
2620 
                      $self->process_assignment_add($grtag, $newgroup);
2621 
                    }
2622 
                    else {
2623 
                      unshift(@$array, @front);
2624 
                    }
2625 
                  }
2626 
                }
2627 
              }
2628 
            }
2629 
          }
2630 
        }
2631 
      }
2632 
    }
2633 
  }
2634 
}
2635 
 
2636 
 
2637 
sub remove_duplicated_files {
2638 
  my($self)   = shift;
2639 
  my($dest)   = shift;
2640 
  my($source) = shift;
2641 
  my($names)  = $self->{$dest};
2642 
  my(@slist)  = $self->get_component_list($source, 1);
2643 
  my(%shash)  = ();
2644 
 
2645 
  ## Convert the array into keys for a hash table
2646 
  @shash{@slist} = ();
2647 
 
2648 
  ## Find out which source files are listed
2649 
  foreach my $name (keys %$names) {
2650 
    foreach my $key (keys %{$$names{$name}}) {
2651 
      my($array) = $$names{$name}->{$key};
2652 
      my($count) = scalar(@$array);
2653 
      for(my $i = 0; $i < $count; ++$i) {
2654 
        ## Is the source file in the component array?
2655 
        if (exists $shash{$$array[$i]}) {
2656 
          ## Remove the element and fix the index and count
2657 
          splice(@$array, $i, 1);
2658 
          --$count;
2659 
          --$i;
2660 
        }
2661 
      }
2662 
    }
2663 
  }
2664 
}
2665 
 
2666 
 
2667 
sub generated_source_listed {
2668 
  my($self)  = shift;
2669 
  my($gent)  = shift;
2670 
  my($tag)   = shift;
2671 
  my($arr)   = shift;
2672 
  my($sext)  = shift;
2673 
  my($names) = $self->{$tag};
2674 
 
2675 
  ## Find out which generated source files are listed
2676 
  foreach my $name (keys %$names) {
2677 
    my($comps) = $$names{$name};
2678 
    foreach my $key (keys %$comps) {
2679 
      foreach my $val (@{$$comps{$key}}) {
2680 
        foreach my $i (@$arr) {
2681 
          my($ifile) = $self->escape_regex_special($i);
2682 
          foreach my $wanted (@$sext) {
2683 
            ## Remove any escape characters from the extension
2684 
            my($oext) = $wanted;
2685 
            $oext =~ s/\\//g;
2686 
            foreach my $re ($self->generated_filenames($ifile, $gent,
2687 
                                                       $tag, "$i$oext", 0)) {
2688 
              if ($val =~ /$re$/) {
2689 
                return 1;
2690 
              }
2691 
            }
2692 
          }
2693 
        }
2694 
      }
2695 
    }
2696 
  }
2697 
 
2698 
  return 0;
2699 
}
2700 
 
2701 
 
2702 
sub list_default_generated {
2703 
  my($self)    = shift;
2704 
  my($gentype) = shift;
2705 
  my($tags)    = shift;
2706 
 
2707 
  ## This method is called when the user has custom input files and has
2708 
  ## provided source files.  If the user defaults the component (i.e.
2709 
  ## source_files, resource_files, etc.) they are filled in by the
2710 
  ## generate_default_components method.
2711 
 
2712 
  if ($self->{'generated_exts'}->{$gentype}->{'automatic'}) {
2713 
    ## After all source and headers have been defaulted, see if we
2714 
    ## need to add the generated files
2715 
    if (defined $self->{$gentype}) {
2716 
      ## Build up the list of files
2717 
      my(@arr)   = ();
2718 
      my($names) = $self->{$gentype};
2719 
      my($group) = undef;
2720 
      foreach my $name (keys %$names) {
2721 
        foreach my $key (keys %{$$names{$name}}) {
2722 
          my($array) = $$names{$name}->{$key};
2723 
 
2724 
          if ($key ne $defgroup) {
2725 
            $group = $key;
2726 
          }
2727 
 
2728 
          foreach my $val (@$array) {
198 bj 2729 
            my($f) = $self->remove_wanted_extension(
2730 
                              $val,
2731 
                              $self->{'valid_components'}->{$gentype});
107 bj 2732 
            push(@arr, $f);
2733 
          }
2734 
        }
2735 
      }
2736 
 
2737 
      foreach my $type (@$tags) {
2738 
        ## Do not add generated files if they are "special"
2739 
        ## unless they haven't been explicitly supplied.
2740 
        if (!$specialComponents{$type} ||
2741 
            !$self->{'special_supplied'}->{$type}) {
2742 
          if (!$self->generated_source_listed(
2743 
                                $gentype, $type, \@arr,
2744 
                                $self->{'valid_components'}->{$gentype})) {
2745 
            $self->add_generated_files($gentype, $type, $group, \@arr);
2746 
          }
2747 
        }
2748 
      }
2749 
    }
2750 
  }
2751 
}
2752 
 
2753 
 
2754 
sub prepend_gendir {
2755 
  my($self)    = shift;
2756 
  my($created) = shift;
2757 
  my($ofile)   = shift;
2758 
  my($gentype) = shift;
2759 
  my($key)     = undef;
2760 
 
2761 
  foreach my $ext (@{$self->{'valid_components'}->{$gentype}}) {
2762 
    my($e) = $ext;
2763 
    $e =~ s/\\//g;
2764 
    $key = "$ofile$e";
2765 
    if (defined $self->{'flag_overrides'}->{$gentype}->{$key}) {
2766 
      last;
2767 
    }
2768 
    else {
2769 
      $key = undef;
2770 
    }
2771 
  }
2772 
 
2773 
  if (defined $key) {
2774 
    foreach my $ma (@{$self->{'matching_assignments'}->{$gentype}}) {
2775 
      if ($ma eq 'gendir') {
2776 
        if (defined $self->{'flag_overrides'}->{$gentype}->{$key}->{$ma}) {
2777 
          ## Convert the file to unix style for basename
2778 
          $created =~ s/\\/\//g;
2779 
          return "$self->{'flag_overrides'}->{$gentype}->{$key}->{$ma}/" .
2780 
                 basename($created);
2781 
        }
2782 
      }
2783 
    }
2784 
  }
2785 
 
2786 
  return $created;
2787 
}
2788 
 
2789 
 
2790 
sub list_generated_file {
2791 
  my($self)    = shift;
2792 
  my($gentype) = shift;
2793 
  my($tag)     = shift;
2794 
  my($array)   = shift;
2795 
  my($file)    = shift;
2796 
  my($ofile)   = shift;
2797 
 
2798 
  $file = $self->escape_regex_special($file);
2799 
 
2800 
  foreach my $gen ($self->get_component_list($gentype, 1)) {
2801 
    my($input) = $gen;
2802 
    foreach my $ext (@{$self->{'valid_components'}->{$gentype}}) {
2803 
      ## Remove the extension.
2804 
      ## If it works, then we can exit this loop.
2805 
      if ($gen =~ s/$ext$//) {
2806 
        last;
2807 
      }
2808 
    }
2809 
 
2810 
    ## If the user provided file does not match any of the
2811 
    ## extensions specified by the custom definition, we need
2812 
    ## to remove the extension or else this file will not be
2813 
    ## added to the project.
2814 
    if ($gen eq $input) {
2815 
      $gen =~ s/\.[^\.]+$//;
2816 
    }
2817 
 
2818 
    ## See if we need to add the file.  We only need to bother
2819 
    ## if the length of $gen is less than or equal to the length of
2820 
    ## $file because they couldn't possibly match if they weren't.
2821 
    if (length(basename($gen)) <= length(basename($file))) {
2822 
      foreach my $re ($self->generated_filenames($gen, $gentype,
2823 
                                                 $tag, $input, 1)) {
2824 
        if ($re =~ /$file(.*)?$/) {
2825 
          my($created) = $re;
2826 
          if (defined $ofile) {
2827 
            $created = $self->prepend_gendir($created, $ofile, $gentype);
2828 
          }
2829 
          if (!$self->already_added($array, $created)) {
2830 
            push(@$array, $created);
2831 
          }
2832 
          last;
2833 
        }
2834 
      }
2835 
    }
2836 
  }
2837 
}
2838 
 
2839 
 
2840 
sub add_corresponding_component_files {
2841 
  my($self)   = shift;
2842 
  my($ftags)  = shift;
2843 
  my($tag)    = shift;
2844 
  my($names)  = undef;
2845 
  my($grname) = $grouped_key . $tag;
2846 
 
2847 
  ## Collect up all of the files that have already been listed
2848 
  ## with the extension removed.
2849 
  my(%filecomp) = ();
2850 
  foreach my $filetag (@$ftags) {
2851 
    $names = $self->{$filetag};
2852 
    foreach my $name (keys %$names) {
2853 
      foreach my $comp (keys %{$$names{$name}}) {
2854 
        foreach my $sfile (@{$$names{$name}->{$comp}}) {
2855 
          my($mod) = $sfile;
2856 
          $mod =~ s/\.[^\.]+$//;
2857 
          $filecomp{$mod} = $comp;
2858 
        }
2859 
      }
2860 
    }
2861 
  }
2862 
 
2863 
  ## Create a hash array keyed off of the existing files of the type
2864 
  ## that we plan on adding.
2865 
  my($fexist)  = 0;
2866 
  my(%scfiles) = ();
2867 
  $names = $self->{$tag};
2868 
  foreach my $name (keys %$names) {
2869 
    ## Check to see if files exist in the default group
2870 
    if (defined $$names{$name}->{$defgroup} &&
2871 
        defined $$names{$name}->{$defgroup}->[0]) {
2872 
      $fexist = 1;
2873 
    }
2874 
    foreach my $comp (keys %{$$names{$name}}) {
2875 
      @scfiles{@{$$names{$name}->{$comp}}} = ();
2876 
    }
2877 
  }
2878 
 
2879 
  ## Create an array of extensions for the files we want to add
2880 
  my(@exts) = ();
2881 
  foreach my $ext (@{$self->{'valid_components'}->{$tag}}) {
2882 
    push(@exts, $ext);
2883 
    $exts[$#exts] =~ s/\\//g;
2884 
  }
2885 
 
2886 
  ## Check each file against a possible new file addition
2887 
  my($adddefaultgroup) = 0;
2888 
  my($oktoadddefault)  = 0;
2889 
  foreach my $sfile (keys %filecomp) {
2890 
    my($found) = 0;
2891 
    foreach my $ext (@exts) {
2892 
      if (exists $scfiles{"$sfile$ext"}) {
2893 
        $found = 1;
2894 
        last;
2895 
      }
2896 
    }
2897 
 
2898 
    if (!$found) {
2899 
      ## Get the array of files for the selected component name
2900 
      my($array) = [];
2901 
      my($comp)  = $filecomp{$sfile};
2902 
      foreach my $name (keys %$names) {
2903 
        if (defined $$names{$name}->{$comp}) {
2904 
          $array = $$names{$name}->{$comp};
2905 
        }
2906 
      }
2907 
 
2908 
      ## First check to see if the file exists
2909 
      foreach my $ext (@exts) {
2910 
        if (-r "$sfile$ext") {
2911 
          push(@$array, "$sfile$ext");
2912 
          $found = 1;
2913 
          last;
2914 
        }
2915 
      }
2916 
 
2917 
      ## If it doesn't exist, see if it will be generated
2918 
      if (!$found) {
2919 
        foreach my $gentype (keys %{$self->{'generated_exts'}}) {
2920 
          $self->list_generated_file($gentype, $tag, $array, $sfile);
2921 
        }
2922 
      }
2923 
 
2924 
      ## If we have any files at all in the component array, check
2925 
      ## to see if we need to add a new group name
2926 
      if (defined $$array[0]) {
2927 
        my($compexists) = undef;
2928 
        my($grval)      = $self->get_assignment($grname);
2929 
        if (defined $grval) {
2930 
          foreach my $grkey (@{$self->create_array($grval)}) {
2931 
            if ($grkey eq $comp) {
2932 
              $compexists = 1;
2933 
              last;
2934 
            }
2935 
          }
2936 
        }
2937 
 
2938 
        if (!$compexists) {
2939 
          if ($comp eq $defgroup) {
2940 
            $adddefaultgroup = 1;
2941 
          }
2942 
          else {
2943 
            $self->process_assignment_add($grname, $comp);
2944 
            $oktoadddefault = 1;
2945 
            $adddefaultgroup |= $fexist;
2946 
          }
2947 
        }
2948 
 
2949 
        ## Put the array back into the component list
2950 
        foreach my $name (keys %$names) {
2951 
          $$names{$name}->{$comp} = $array;
2952 
        }
2953 
      }
2954 
    }
2955 
  }
2956 
 
2957 
  ## We only need to add the default group name if we wanted to
2958 
  ## add the default group when adding new files and we added a group
2959 
  ## by some other name.  Otherwise, defaulted files would always be
2960 
  ## in a group, which is not what we want.
2961 
  if ($adddefaultgroup && $oktoadddefault) {
2962 
    $self->process_assignment_add($grname, $defgroup);
2963 
  }
2964 
}
2965 
 
2966 
 
2967 
sub get_default_project_name {
2968 
  my($self) = shift;
2969 
  my($name) = $self->{'current_input'};
2970 
 
2971 
  if ($name eq '') {
2972 
    $name = $self->transform_file_name($self->base_directory());
2973 
  }
2974 
  else {
2975 
    ## Since files on UNIX can have back slashes, we transform them
2976 
    ## into underscores.
2977 
    $name =~ s/\\/_/g;
2978 
 
2979 
    ## Convert the name to a usable name
2980 
    $name = $self->transform_file_name($name);
2981 
 
2982 
    ## Take off the extension
2983 
    $name =~ s/\.[^\.]+$//;
2984 
  }
2985 
 
2986 
  return $name;
2987 
}
2988 
 
2989 
 
2990 
sub remove_excluded {
2991 
  my($self) = shift;
2992 
  my(@tags) = @_;
2993 
 
2994 
  ## Process each file type and remove the excluded files
2995 
  foreach my $tag (@tags) {
2996 
    my($names) = $self->{$tag};
2997 
    foreach my $name (keys %$names) {
2998 
      foreach my $comp (keys %{$$names{$name}}) {
2999 
        my($count) = scalar(@{$$names{$name}->{$comp}});
3000 
        for(my $i = 0; $i < $count; ++$i) {
3001 
          my($file) = $$names{$name}->{$comp}->[$i];
3002 
          if (defined $self->{'remove_files'}->{$tag}->{$file}) {
3003 
            splice(@{$$names{$name}->{$comp}}, $i, 1);
3004 
            --$i;
3005 
            --$count;
3006 
          }
3007 
        }
3008 
      }
3009 
    }
3010 
    delete $self->{'remove_files'}->{$tag};
3011 
  }
3012 
}
3013 
 
3014 
 
3015 
sub generate_defaults {
3016 
  my($self) = shift;
3017 
 
3018 
  ## Generate default project name
3019 
  if (!defined $self->get_assignment('project_name')) {
3020 
    $self->set_project_name($self->get_default_project_name());
3021 
  }
3022 
 
3023 
  ## Generate the default pch file names (if needed)
3024 
  my(@files) = $self->generate_default_file_list(
3025 
                                 '.', [], $self->get_assignment('recurse'));
3026 
  $self->generate_default_pch_filenames(\@files);
3027 
 
3028 
  ## If the pch file names are empty strings then we need to fix that
3029 
  $self->fix_pch_filenames();
3030 
 
3031 
  ## Generate default components, but %specialComponents
3032 
  ## are skipped in the initial default components generation
3033 
  $self->generate_default_components(\@files);
3034 
 
3035 
  ## Remove source files that are also listed in the template files
3036 
  ## If we do not do this, then generated projects can be invalid.
3037 
  $self->remove_duplicated_files('source_files', 'template_files');
3038 
 
3039 
  ## If pch files are listed in header_files or source_files more than
3040 
  ## once, we need to remove the extras
3041 
  $self->remove_extra_pch_listings();
3042 
 
3043 
  ## Generate the default generated list of files only if we defaulted
3044 
  ## the generated file list.  I want to ensure that source_files comes
3045 
  ## first in the list to pick up group information (since source_files
3046 
  ## are most likely going to be grouped than anything else).
3047 
  my(@vc) = reverse sort { return 1 if $a eq 'source_files';
3048 
                           return $a cmp $b; } keys %{$self->{'valid_components'}};
3049 
  foreach my $gentype (keys %{$self->{'generated_exts'}}) {
3050 
    $self->list_default_generated($gentype, \@vc);
3051 
  }
3052 
 
3053 
  ## Now that all of the source files have been added
3054 
  ## we need to remove those that have need to be removed
3055 
  $self->remove_excluded('source_files');
3056 
 
3057 
  ## Add %specialComponents files based on the
3058 
  ## source_components (i.e. .h and .i or .inl based on .cpp)
3059 
  my(@scomp) = keys %sourceComponents;
3060 
  foreach my $tag (keys %specialComponents) {
3061 
    $self->add_corresponding_component_files(\@scomp, $tag);
3062 
  }
3063 
 
3064 
  ## Now, if the %specialComponents are still empty
3065 
  ## then take any file that matches the components extension
3066 
  foreach my $tag (keys %specialComponents) {
3067 
    if (!$self->{'special_supplied'}->{$tag}) {
3068 
      my($names) = $self->{$tag};
3069 
      if (defined $names) {
3070 
        ## We only want to generate default components if we have
3071 
        ## defaulted the source files or we have no files listed
3072 
        ## in the current special component.
3073 
        my($ok) = $self->{'defaulted'}->{'source_files'};
3074 
        if (!$ok) {
3075 
          my(@all) = ();
3076 
          foreach my $name (keys %$names) {
3077 
            foreach my $key (keys %{$$names{$name}}) {
3078 
              push(@all, @{$$names{$name}->{$key}});
3079 
            }
3080 
          }
3081 
          $ok = ($#all == -1);
3082 
        }
3083 
        if ($ok) {
3084 
          $self->generate_default_components(\@files, $tag);
3085 
        }
3086 
      }
3087 
    }
3088 
  }
3089 
 
3090 
  ## Now that all of the other files have been added
3091 
  ## we need to remove those that have need to be removed
3092 
  my(@rmkeys) = keys %{$self->{'remove_files'}};
3093 
  if ($#rmkeys != -1) {
3094 
    $self->remove_excluded(@rmkeys);
3095 
  }
3096 
 
3097 
  ## Generate default target names after all source files are added
3098 
  $self->generate_default_target_names();
3099 
}
3100 
 
3101 
 
3102 
sub set_project_name {
3103 
  my($self) = shift;
3104 
  my($name) = shift;
3105 
 
3106 
  ## Save the unmodified project name so that when we
3107 
  ## need to determine the default target name, we can use
3108 
  ## what is expected by the user.
3109 
  $self->{'unmodified_project_name'} = $name;
3110 
 
3111 
  ## If we are applying the name modifier to the project
3112 
  ## then we will modify the project name
3113 
  if ($self->get_apply_project()) {
3114 
    my($nmod) = $self->get_name_modifier();
3115 
 
3116 
    if (defined $nmod) {
3117 
      $nmod =~ s/\*/$name/g;
3118 
      $name = $nmod;
3119 
    }
3120 
  }
3121 
 
3122 
  ## Set the project_name assignment so that the TemplateParser
3123 
  ## can get the project name.
3124 
  $self->process_assignment('project_name', $name);
3125 
}
3126 
 
3127 
 
3128 
sub project_name {
3129 
  my($self) = shift;
3130 
  return $self->get_assignment('project_name');
3131 
}
3132 
 
3133 
 
3134 
sub lib_target {
3135 
  my($self) = shift;
3136 
  return (defined $self->get_assignment('sharedname') ||
3137 
          defined $self->get_assignment('staticname'));
3138 
}
3139 
 
3140 
 
3141 
sub exe_target {
3142 
  my($self) = shift;
3143 
  return (defined $self->get_assignment('exename'));
3144 
}
3145 
 
3146 
 
3147 
sub get_component_list {
3148 
  my($self)      = shift;
3149 
  my($tag)       = shift;
3150 
  my($noconvert) = shift;
3151 
  my($names)     = $self->{$tag};
3152 
  my(@list)      = ();
3153 
 
3154 
  foreach my $name (keys %$names) {
3155 
    foreach my $key (keys %{$$names{$name}}) {
3156 
      push(@list, @{$$names{$name}->{$key}});
3157 
    }
3158 
  }
3159 
 
3160 
  ## By default, if 'convert_slashes' is true, then we convert slashes
3161 
  ## to backslashes.  There are cases where we do not want to convert
3162 
  ## the slashes, in that case get_component_list() was called with
3163 
  ## an additional parameter indicating this.
3164 
  if (!$noconvert && $self->{'convert_slashes'}) {
3165 
    for(my $i = 0; $i <= $#list; $i++) {
3166 
      $list[$i] = $self->slash_to_backslash($list[$i]);
3167 
    }
3168 
  }
3169 
 
3170 
  if ($self->{'sort_files'}) {
3171 
    @list = sort { $self->file_sorter($a, $b) } @list;
3172 
  }
3173 
 
3174 
  return @list;
3175 
}
3176 
 
3177 
 
3178 
sub check_custom_output {
3179 
  my($self)    = shift;
3180 
  my($based)   = shift;
3181 
  my($cinput)  = shift;
3182 
  my($ainput)  = shift;
3183 
  my($type)    = shift;
3184 
  my($comps)   = shift;
3185 
  my(@outputs) = ();
3186 
 
3187 
  foreach my $array ($self->generated_filename_arrays($cinput, $based,
3188 
                                                      $type, $ainput, 1)) {
3189 
    foreach my $built (@$array) {
3190 
      if (@$comps == 0) {
3191 
        push(@outputs, $built);
3192 
        last;
3193 
      }
3194 
      elsif (defined $specialComponents{$type} &&
3195 
             !$self->{'special_supplied'}->{$type}) {
3196 
        push(@outputs, $built);
3197 
        last;
3198 
      }
3199 
      else {
3200 
        my($base) = $built;
3201 
        if ($self->{'convert_slashes'}) {
3202 
          $base =~ s/\\/\//g;
3203 
        }
3204 
        my($re) = $self->escape_regex_special(basename($base));
3205 
        foreach my $c (@$comps) {
3206 
          ## We only match if the built file name matches from
3207 
          ## beginning to end or from a slash to the end.
3208 
          if ($c =~ /^$re$/ || $c =~ /[\/\\]$re$/) {
3209 
            push(@outputs, $built);
3210 
            last;
3211 
          }
3212 
        }
3213 
      }
3214 
    }
3215 
  }
3216 
 
3217 
  return @outputs;
3218 
}
3219 
 
3220 
 
3221 
sub get_special_value {
3222 
  my($self)   = shift;
3223 
  my($type)   = shift;
3224 
  my($cmd)    = shift;
3225 
  my($based)  = shift;
3226 
  my(@params) = @_;
3227 
 
3228 
  if ($type =~ /^custom_type/) {
3229 
    return $self->get_custom_value($cmd, $based, @params);
3230 
  }
3231 
  elsif ($type =~ /^$grouped_key/) {
3232 
    return $self->get_grouped_value($type, $cmd, $based);
3233 
  }
3234 
 
3235 
  return undef;
3236 
}
3237 
 
3238 
 
3239 
sub get_grouped_value {
3240 
  my($self)  = shift;
3241 
  my($type)  = shift;
3242 
  my($cmd)   = shift;
3243 
  my($based) = shift;
3244 
  my($value) = undef;
3245 
 
3246 
  ## Make it all lower case
3247 
  $type = lc($type);
3248 
 
3249 
  ## Remove the grouped_ part
3250 
  $type =~ s/^$grouped_key//;
3251 
 
3252 
  ## Add the s if it isn't there
3253 
  if ($type !~ /s$/) {
3254 
    $type .= 's';
3255 
  }
3256 
 
3257 
  my($names) = $self->{$type};
3258 
  if ($cmd eq 'files') {
3259 
    foreach my $name (keys %$names) {
3260 
      my($comps) = $$names{$name};
3261 
      foreach my $comp (keys %$comps) {
3262 
        if ($comp eq $based) {
3263 
          if ($self->{'convert_slashes'}) {
3264 
            my(@converted) = ();
3265 
            foreach my $file (@{$$comps{$comp}}) {
3266 
              push(@converted, $self->slash_to_backslash($file));
3267 
            }
3268 
            $value = \@converted;
3269 
          }
3270 
          else {
3271 
            $value = $$comps{$comp};
3272 
          }
3273 
          if ($self->{'sort_files'}) {
3274 
            my(@sorted) = sort { $self->file_sorter($a, $b) } @$value;
3275 
            $value = \@sorted;
3276 
          }
3277 
          last;
3278 
        }
3279 
      }
3280 
    }
3281 
  }
3282 
  elsif ($cmd eq 'component_name') {
3283 
    ## If there is more than one name, then we will need
3284 
    ## to deal with that at a later time.
3285 
    foreach my $name (keys %$names) {
3286 
      $value = $name;
3287 
    }
3288 
  }
3289 
 
3290 
  return $value;
3291 
}
3292 
 
3293 
 
3294 
sub get_command_subs {
3295 
  my($self)  = shift;
3296 
  my(%valid) = ();
3297 
 
3298 
  ## Add the built-in OS compatibility commands
3299 
  if ($self->{'convert_slashes'}) {
3300 
    $valid{'cat'}   = 'type';
3301 
    $valid{'cp'}    = 'copy /y';
3302 
    $valid{'mkdir'} = 'mkdir';
3303 
    $valid{'mv'}    = 'move /y';
3304 
    $valid{'rm'}    = 'del /f/s/q';
3305 
    $valid{'nul'}   = 'nul';
3306 
  }
3307 
  else {
3308 
    $valid{'cat'}   = 'cat';
3309 
    $valid{'cp'}    = 'cp -f';
3310 
    $valid{'mkdir'} = 'mkdir -p';
3311 
    $valid{'mv'}    = 'mv -f';
3312 
    $valid{'rm'}    = 'rm -rf';
3313 
    $valid{'nul'}   = '/dev/null';
3314 
  }
3315 
 
3316 
  ## Add the project specific compatibility commands
3317 
  $valid{'gt'}    = $self->get_gt_symbol();
3318 
  $valid{'lt'}    = $self->get_lt_symbol();
3319 
  $valid{'and'}   = $self->get_and_symbol();
3320 
  $valid{'or'}    = $self->get_or_symbol();
3321 
  $valid{'quote'} = $self->get_quote_symbol();
3322 
 
3323 
  return \%valid;
3324 
}
3325 
 
3326 
 
3327 
sub convert_command_parameters {
3328 
  my($self)   = shift;
3329 
  my($str)    = shift;
3330 
  my($input)  = shift;
3331 
  my($output) = shift;
3332 
  my(%nowarn) = ();
3333 
  my(%valid)  = %{$self->{'command_subs'}};
3334 
 
3335 
  ## Add in the values that change for every call to this function
3336 
  $valid{'temporary'} = 'temp.$$$$.' . int(rand(0xffffffff));
3337 
 
3338 
  if (defined $input) {
3339 
    $valid{'input'}          = $input;
3340 
    $valid{'input_basename'} = basename($input);
3341 
    $valid{'input_noext'}    = $input;
3342 
    $valid{'input_noext'}    =~ s/(\.[^\.]+)$//;
3343 
    $valid{'input_ext'}      = $1;
3344 
  }
3345 
 
3346 
  if (defined $output) {
3347 
    my($first) = 1;
3348 
    $valid{'output'} = "@$output";
3349 
    foreach my $out (@$output) {
3350 
      my($noext) = $out;
3351 
      $noext =~ s/(\.[^\.]+)$//;
3352 
 
3353 
      $valid{'output_ext'}       = $1;
3354 
      $valid{'output_noext'}    .= (!$first ? ' ' : '') . $noext;
3355 
      $valid{'output_basename'} .= (!$first ? ' ' : '') . basename($out);
3356 
      $first = 0;
3357 
    }
3358 
  }
3359 
 
3360 
  ## Add in the specific types of output files
3361 
  if (defined $output) {
3362 
    foreach my $type (keys %{$self->{'valid_components'}}) {
3363 
      my($key) = $type;
3364 
      $key =~ s/s$//gi;
3365 
      $nowarn{$key} = 1;
3366 
      $nowarn{$key . '_noext'} = 1;
3367 
      foreach my $ext (@{$self->{'valid_components'}->{$type}}) {
3368 
        foreach my $out (@$output) {
3369 
          if ($out =~ /$ext$/) {
3370 
            $valid{$key} = $out;
3371 
            $valid{$key . '_noext'} = $out;
3372 
            $valid{$key . '_noext'} =~ s/\.[^\.]+$//;
3373 
            last;
3374 
          }
3375 
        }
3376 
      }
3377 
    }
3378 
  }
3379 
 
3380 
  while ($str =~ /<%(\w+)(\(\w+\))?%>/) {
3381 
    my($name)     = $1;
3382 
    my($modifier) = $2;
3383 
    if (defined $modifier) {
3384 
      my($tmp) = $name;
3385 
      $name = $modifier;
3386 
      $name =~ s/[\(\)]//g;
3387 
      $modifier = $tmp;
3388 
    }
3389 
 
3390 
    if (exists $valid{$name}) {
3391 
      if (defined $valid{$name}) {
3392 
        my($replace) = $valid{$name};
3393 
        if (defined $modifier) {
3394 
          if ($modifier eq 'noextension') {
3395 
            $replace =~ s/\.[^\.]+$//;
3396 
          }
3397 
          else {
3398 
            $self->warning("Uknown parameter modifier $modifier.");
3399 
          }
3400 
        }
3401 
        $str =~ s/<%\w+(\(\w+\))?%>/$replace/;
3402 
      }
3403 
      else {
3404 
        $str =~ s/<%\w+(\(\w+\))?%>//;
3405 
      }
3406 
    }
3407 
    else {
3408 
      $str =~ s/<%\w+(\(\w+\))?%>//;
3409 
 
3410 
      ## We only want to warn the user that we did not recognize the
3411 
      ## pseudo template parameter if there was an input and an output
3412 
      ## file passed to this function.  If this variable was used
3413 
      ## without the parenthesis (as in an if statement), then we don't
3414 
      ## want to warn the user.
3415 
      if (defined $input && defined $output) {
3416 
        if (!defined $nowarn{$name}) {
3417 
          $self->warning("<%$name%> was not recognized.");
3418 
        }
3419 
 
3420 
        ## If we didn't recognize the pseudo template parameter then
3421 
        ## we don't want to return anything back.
3422 
        return undef;
3423 
      }
3424 
    }
3425 
  }
3426 
 
3427 
  return $str;
3428 
}
3429 
 
3430 
 
3431 
sub get_custom_value {
3432 
  my($self)   = shift;
3433 
  my($cmd)    = shift;
3434 
  my($based)  = shift;
3435 
  my(@params) = @_;
3436 
  my($value)  = undef;
3437 
 
3438 
  if ($cmd eq 'input_files') {
3439 
    ## Get the component list for the component type
3440 
    my(@array) = $self->get_component_list($based);
3441 
 
3442 
    ## Check for directories in the component list.  If the component
3443 
    ## type is not automatic, we may have directories here and will need
3444 
    ## to get the file list for that type.
3445 
    my($once) = undef;
3446 
    for(my $i = 0; $i <= $#array; ++$i) {
3447 
      if (-d $array[$i]) {
3448 
        if (!defined $once) {
3449 
          $once = {'recurse' => $self->get_assignment('recurse'),
3450 
                   'pchh'    => $self->get_assignment('pch_header'),
3451 
                   'pchc'    => $self->get_assignment('pch_source'),
3452 
                  };
3453 
        }
3454 
        my(@built) = ();
3455 
        $self->sift_default_file_list($based, $array[$i], \@built,
3456 
                                      $self->{'valid_components'}->{$based},
3457 
                                      $$once{'recurse'},
3458 
                                      $$once{'pchh'}, $$once{'pchc'});
3459 
        splice(@array, $i, 1, @built);
3460 
        $i += $#built;
3461 
      }
3462 
    }
3463 
 
3464 
    $value = \@array;
3465 
 
3466 
    $self->{'custom_output_files'} = {};
3467 
    my(%vcomps) = ();
3468 
    foreach my $vc (keys %{$self->{'valid_components'}}) {
3469 
      my(@comps) = $self->get_component_list($vc);
3470 
      $vcomps{$vc} = \@comps;
3471 
    }
3472 
    $vcomps{$generic_key} = [];
3473 
 
3474 
    foreach my $input (@array) {
3475 
      my(@outputs) = ();
3476 
      my($ainput)  = $input;
3477 
      my($cinput)  = $input;
3478 
 
3479 
      ## Remove the extension
3480 
      $cinput =~ s/\.[^\.]+$//;
3481 
 
3482 
      ## If we are converting slashes,
3483 
      ## change them back for this parameter
3484 
      if ($self->{'convert_slashes'}) {
3485 
        $ainput =~ s/\\/\//g;
3486 
      }
3487 
 
3488 
      ## Add all of the output files
3489 
      foreach my $vc (keys %{$self->{'valid_components'}}, $generic_key) {
3490 
        push(@outputs,
3491 
             $self->check_custom_output($based, $cinput,
3492 
                                        $ainput, $vc, $vcomps{$vc}));
3493 
      }
3494 
 
3495 
      ## Add specially listed files avoiding duplicates
3496 
      if (defined $self->{'custom_special_output'}->{$based} &&
3497 
          defined $self->{'custom_special_output'}->{$based}->{$ainput}) {
3498 
        foreach my $file (@{$self->{'custom_special_output'}->{$based}->{$ainput}}) {
3499 
          my($found) = 0;
3500 
          foreach my $output (@outputs) {
3501 
            if ($output eq $file) {
3502 
              $found = 1;
3503 
              last;
3504 
            }
3505 
          }
3506 
          if (!$found) {
3507 
            push(@outputs, $file);
3508 
          }
3509 
        }
3510 
      }
3511 
 
3512 
      if ($self->{'sort_files'}) {
3513 
        @outputs = sort { $self->file_sorter($a, $b) } @outputs;
3514 
      }
3515 
      $self->{'custom_output_files'}->{$input} = \@outputs;
3516 
    }
3517 
  }
3518 
  elsif ($cmd eq 'output_files') {
3519 
    # Generate output files based on $based
3520 
    if (defined $self->{'custom_output_files'}) {
3521 
      $value = $self->{'custom_output_files'}->{$based};
3522 
    }
3523 
  }
3524 
  elsif ($cmd eq 'source_output_files') {
3525 
    # Generate source output files based on $based
3526 
    if (defined $self->{'custom_output_files'}) {
3527 
      $value = [];
3528 
      foreach my $file (@{$self->{'custom_output_files'}->{$based}}) {
3529 
        foreach my $ext (@{$self->{'valid_components'}->{'source_files'}}) {
3530 
          if ($file =~ /$ext$/) {
3531 
            ## We've found a file that matches one of the source file
3532 
            ## extensions.  Now we have to make sure that it doesn't
3533 
            ## match a template file extension.
3534 
            my($matched) = 0;
3535 
            foreach my $text (@{$self->{'valid_components'}->{'template_files'}}) {
3536 
              if ($file =~ /$text$/) {
3537 
                $matched = 1;
3538 
                last;
3539 
              }
3540 
            }
3541 
            if (!$matched) {
3542 
              push(@$value, $file);
3543 
            }
3544 
            last;
3545 
          }
3546 
        }
3547 
      }
3548 
    }
3549 
  }
3550 
  elsif ($cmd eq 'non_source_output_files') {
3551 
    # Generate non source output files based on $based
3552 
    if (defined $self->{'custom_output_files'}) {
3553 
      $value = [];
3554 
      foreach my $file (@{$self->{'custom_output_files'}->{$based}}) {
3555 
        my($source) = 0;
3556 
        foreach my $ext (@{$self->{'valid_components'}->{'source_files'}}) {
3557 
          if ($file =~ /$ext$/) {
3558 
            $source = 1;
3559 
            last;
3560 
          }
3561 
        }
3562 
        if (!$source) {
3563 
          push(@$value, $file);
3564 
        }
3565 
      }
3566 
    }
3567 
  }
3568 
  elsif ($cmd eq 'inputexts') {
3569 
    my(@array) = @{$self->{'valid_components'}->{$based}};
3570 
    foreach my $val (@array) {
3571 
      $val =~ s/\\\.//g;
3572 
    }
3573 
    $value = \@array;
3574 
  }
3575 
  elsif ($cmd eq 'dependencies') {
3576 
    $value = $self->{'custom_special_depend'}->{$based};
3577 
  }
3578 
  elsif (defined $customDefined{$cmd} &&
3579 
         ($customDefined{$cmd} & 0x04) != 0) {
3580 
    $value = $self->get_assignment($cmd,
3581 
                                   $self->{'generated_exts'}->{$based});
3582 
    if (defined $value && ($customDefined{$cmd} & 0x10) != 0) {
3583 
      $value = $self->convert_command_parameters($value, @params);
3584 
    }
3585 
  }
3586 
  elsif (defined $custom{$cmd}) {
3587 
    $value = $self->get_assignment($cmd,
3588 
                                   $self->{'generated_exts'}->{$based});
3589 
  }
3590 
 
3591 
  return $value;
3592 
}
3593 
 
3594 
 
3595 
sub check_features {
3596 
  my($self)     = shift;
3597 
  my($requires) = shift;
3598 
  my($avoids)   = shift;
3599 
  my($info)     = shift;
3600 
  my($status)   = 1;
3601 
  my($why)      = undef;
3602 
 
3603 
  if (defined $requires) {
3604 
    foreach my $require (split(/\s+/, $requires)) {
3605 
      my($fval) = $self->{'feature_parser'}->get_value($require);
3606 
 
3607 
      ## By default, if the feature is not listed, then it is enabled.
3608 
      if (defined $fval && !$fval) {
3609 
        $why = "requires $require";
3610 
        $status = 0;
3611 
        last;
3612 
      }
3613 
    }
3614 
  }
3615 
 
3616 
  ## If it passes the requires, then check the avoids
3617 
  if ($status) {
3618 
    if (defined $avoids) {
3619 
      foreach my $avoid (split(/\s+/, $avoids)) {
3620 
        my($fval) = $self->{'feature_parser'}->get_value($avoid);
3621 
 
3622 
        ## By default, if the feature is not listed, then it is enabled.
3623 
        if (!defined $fval || $fval) {
3624 
          $why = "avoids $avoid";
3625 
          $status = 0;
3626 
          last;
3627 
        }
3628 
      }
3629 
    }
3630 
  }
3631 
 
3632 
  if ($info && !$status) {
3633 
    $self->details("Skipping " . $self->get_assignment('project_name') .
3634 
                   " ($self->{'current_input'}), it $why.");
3635 
  }
3636 
 
3637 
  return $status;
3638 
}
3639 
 
3640 
 
3641 
sub need_to_write_project {
3642 
  my($self) = shift;
3643 
 
3644 
  foreach my $key ('source_files', 'resource_files',
3645 
                   keys %{$self->{'generated_exts'}}) {
3646 
    my($names) = $self->{$key};
3647 
    foreach my $name (keys %$names) {
3648 
      foreach my $key (keys %{$names->{$name}}) {
3649 
        if (defined $names->{$name}->{$key}->[0]) {
3650 
          return 1;
3651 
        }
3652 
      }
3653 
    }
3654 
  }
3655 
 
3656 
  return 0;
3657 
}
3658 
 
3659 
 
3660 
sub write_output_file {
3661 
  my($self)     = shift;
3662 
  my($name)     = shift;
3663 
  my($status)   = 0;
3664 
  my($error)    = undef;
3665 
  my($tover)    = $self->get_template_override();
3666 
  my($template) = (defined $tover ? $tover : $self->get_template());
3667 
 
3668 
  ## If the template files does not end in the template extension
3669 
  ## then we will add it on.
3670 
  if ($template !~ /$TemplateExtension$/) {
3671 
    $template = $template . ".$TemplateExtension";
3672 
  }
3673 
 
3674 
  ## If the template file does not contain a full path, then we
3675 
  ## will search through the include paths for it.
3676 
  my($tfile) = undef;
3677 
  if ($template =~ /^([a-z]:)?[\/\\]/i) {
3678 
    $tfile = $template;
3679 
  }
3680 
  else {
3681 
    $tfile = $self->search_include_path($template);
3682 
  }
3683 
 
3684 
  if (defined $tfile) {
3685 
    ## Read in the template values for the
3686 
    ## specific target and project type
3687 
    ($status, $error) = $self->read_template_input();
3688 
 
3689 
    if ($status) {
3690 
      my($tp) = new TemplateParser($self);
3691 
 
3692 
      ## Set the project_file assignment for the template parser
3693 
      $self->process_assignment('project_file', $name);
3694 
 
3695 
      ($status, $error) = $tp->parse_file($tfile);
3696 
 
3697 
      if ($status) {
3698 
        if (defined $self->{'source_callback'}) {
3699 
          my($cb)     = $self->{'source_callback'};
3700 
          my($pjname) = $self->get_assignment('project_name');
3701 
          my(@list)   = $self->get_component_list('source_files');
3702 
          if (UNIVERSAL::isa($cb, 'ARRAY')) {
3703 
            my(@copy) = @$cb;
3704 
            my($s) = shift(@copy);
3705 
            &$s(@copy, $name, $pjname, @list);
3706 
          }
3707 
          elsif (UNIVERSAL::isa($cb, 'CODE')) {
3708 
            &$cb($name, $pjname, @list);
3709 
          }
3710 
          else {
3711 
            $self->warning("Ignoring callback: $cb.");
3712 
          }
3713 
        }
3714 
 
3715 
        if ($self->get_toplevel()) {
3716 
          my($outdir) = $self->get_outdir();
3717 
          my($oname)  = $name;
3718 
 
3719 
          $name = "$outdir/$name";
3720 
 
3721 
          my($fh)  = new FileHandle();
3722 
          my($dir) = $self->mpc_dirname($name);
3723 
 
3724 
          if ($dir ne '.') {
3725 
            mkpath($dir, 0, 0777);
3726 
          }
3727 
 
3728 
          if ($self->compare_output()) {
3729 
            ## First write the output to a temporary file
3730 
            my($tmp) = "$outdir/MPC$>.$$";
3731 
            my($different) = 1;
3732 
            if (open($fh, ">$tmp")) {
3733 
              my($lines) = $tp->get_lines();
3734 
              foreach my $line (@$lines) {
3735 
                print $fh $line;
3736 
              }
3737 
              close($fh);
3738 
 
3739 
              if (-r $name &&
3740 
                  -s $tmp == -s $name && compare($tmp, $name) == 0) {
3741 
                $different = 0;
3742 
              }
3743 
            }
3744 
            else {
3745 
              $error = "Unable to open $tmp for output.";
3746 
              $status = 0;
3747 
            }
3748 
 
3749 
            if ($status) {
3750 
              ## If they are different, then rename the temporary file
3751 
              if ($different) {
3752 
                unlink($name);
3753 
                if (rename($tmp, $name)) {
3754 
                  $self->add_file_written($oname);
3755 
                }
3756 
                else {
3757 
                  $error = "Unable to open $name for output.";
3758 
                  $status = 0;
3759 
                }
3760 
              }
3761 
              else {
3762 
                ## We will pretend that we wrote the file
3763 
                unlink($tmp);
3764 
                $self->add_file_written($oname);
3765 
              }
3766 
            }
3767 
          }
3768 
          else {
3769 
            if (open($fh, ">$name")) {
3770 
              my($lines) = $tp->get_lines();
3771 
              foreach my $line (@$lines) {
3772 
                print $fh $line;
3773 
              }
3774 
              close($fh);
3775 
              $self->add_file_written($oname);
3776 
            }
3777 
            else {
3778 
              $error = "Unable to open $name for output.";
3779 
              $status = 0;
3780 
            }
3781 
          }
3782 
        }
3783 
      }
3784 
    }
3785 
  }
3786 
  else {
3787 
    $error = "Unable to locate the template file: $template.";
3788 
    $status = 0;
3789 
  }
3790 
 
3791 
  return $status, $error;
3792 
}
3793 
 
3794 
 
3795 
sub write_install_file {
3796 
  my($self)    = shift;
3797 
  my($fh)      = new FileHandle();
3798 
  my($insfile) = $self->transform_file_name(
3799 
                           $self->get_assignment('project_name')) .
3800 
                 '.ins';
3801 
  my($outdir)  = $self->get_outdir();
3802 
 
3803 
  $insfile = "$outdir/$insfile";
3804 
 
3805 
  unlink($insfile);
3806 
  if (open($fh, ">$insfile")) {
3807 
    foreach my $vc (keys %{$self->{'valid_components'}}) {
3808 
      my($names) = $self->{$vc};
3809 
      foreach my $name (keys %$names) {
3810 
        foreach my $key (keys %{$$names{$name}}) {
3811 
          my($array) = $$names{$name}->{$key};
3812 
          if (defined $$array[0]) {
3813 
            print $fh "$vc:\n";
3814 
            foreach my $file (@$array) {
3815 
              print $fh "$file\n";
3816 
            }
3817 
            print $fh "\n";
3818 
          }
3819 
        }
3820 
      }
3821 
    }
3822 
    if ($self->exe_target()) {
3823 
      my($install) = $self->get_assignment('install');
3824 
      print $fh "exe_output:\n",
3825 
                (defined $install ? $self->relative($install) : ''),
3826 
                ' ', $self->get_assignment('exename'), "\n";
3827 
    }
3828 
    elsif ($self->lib_target()) {
3829 
      my($shared) = $self->get_assignment('sharedname');
3830 
      my($static) = $self->get_assignment('staticname');
3831 
      my($dllout) = $self->relative($self->get_assignment('dllout'));
3832 
      my($libout) = $self->relative($self->get_assignment('libout'));
3833 
 
3834 
      print $fh "lib_output:\n";
3835 
 
3836 
      if (defined $shared && $shared ne '') {
3837 
        print $fh (defined $dllout ? $dllout : $libout), " $shared\n";
3838 
      }
3839 
      if ((defined $static && $static ne '') &&
3840 
          (defined $dllout || !defined $shared ||
3841 
               (defined $shared && $shared ne $static))) {
3842 
        print $fh "$libout $static\n";
3843 
      }
3844 
    }
3845 
 
3846 
    close($fh);
3847 
    return 1, undef;
3848 
  }
3849 
 
3850 
  return 0, 'Unable write to ' . $insfile;
3851 
}
3852 
 
3853 
 
3854 
sub write_project {
3855 
  my($self)      = shift;
3856 
  my($status)    = 1;
3857 
  my($error)     = undef;
3858 
  my($progress)  = $self->get_progress_callback();
3859 
 
3860 
  if (defined $progress) {
3861 
    &$progress();
3862 
  }
3863 
 
3864 
  if ($self->check_features($self->get_assignment('requires'),
3865 
                            $self->get_assignment('avoids'),
3866 
                            1)) {
3867 
    if ($self->need_to_write_project()) {
3868 
      if ($self->get_assignment('custom_only')) {
3869 
        $self->remove_non_custom_settings();
3870 
      }
3871 
 
3872 
      if ($self->{'escape_spaces'}) {
3873 
        foreach my $name ('exename', 'sharedname', 'staticname') {
3874 
          my($value) = $self->get_assignment($name);
3875 
          if (defined $value && $value =~ s/(\s)/\\$1/g) {
3876 
            $self->process_assignment($name, $value);
3877 
          }
3878 
        }
3879 
        foreach my $key (keys %{$self->{'valid_components'}}) {
3880 
          my($names) = $self->{$key};
3881 
          foreach my $name (keys %$names) {
3882 
            foreach my $key (keys %{$$names{$name}}) {
3883 
              foreach my $file (@{$$names{$name}->{$key}}) {
3884 
                $file =~ s/(\s)/\\$1/g;
3885 
              }
3886 
            }
3887 
          }
3888 
        }
3889 
      }
3890 
 
3891 
      ($status, $error) = $self->write_output_file(
3892 
                                   $self->transform_file_name(
3893 
                                            $self->project_file_name()));
3894 
      if ($self->{'generate_ins'} && $status) {
3895 
        ($status, $error) = $self->write_install_file();
3896 
      }
3897 
    }
3898 
    else {
3899 
      my($msg) = $self->transform_file_name($self->project_file_name()) .
3900 
                 " has no useful targets.";
3901 
 
3902 
      if ($self->{'current_input'} eq '') {
3903 
        $self->information($msg);
3904 
      }
3905 
      else {
3906 
        $self->warning($msg);
3907 
      }
3908 
    }
3909 
  }
3910 
  else {
3911 
    $status = 2;
3912 
  }
3913 
 
3914 
  return $status, $error;
3915 
}
3916 
 
3917 
 
3918 
sub get_project_info {
3919 
  my($self) = shift;
3920 
  return $self->{'project_info'};
3921 
}
3922 
 
3923 
 
3924 
sub get_lib_locations {
3925 
  my($self) = shift;
3926 
  return $self->{'lib_locations'};
3927 
}
3928 
 
3929 
 
3930 
sub get_inheritance_tree {
3931 
  my($self) = shift;
3932 
  return $self->{'inheritance_tree'};
3933 
}
3934 
 
3935 
 
3936 
sub set_component_extensions {
3937 
  my($self) = shift;
3938 
  my($vc)   = $self->{'valid_components'};
3939 
  my($ec)   = $self->{'exclude_components'};
3940 
 
3941 
  foreach my $key (keys %$vc) {
3942 
    my($ov) = $self->override_valid_component_extensions($key);
3943 
    if (defined $ov) {
3944 
      $$vc{$key} = $ov;
3945 
    }
3946 
  }
3947 
 
3948 
  foreach my $key (keys %$ec) {
3949 
    my($ov) = $self->override_exclude_component_extensions($key);
3950 
    if (defined $ov) {
3951 
      $$ec{$key} = $ov;
3952 
    }
3953 
  }
3954 
}
3955 
 
3956 
 
3957 
sub set_source_listing_callback {
3958 
  my($self) = shift;
3959 
  my($cb)   = shift;
3960 
  $self->{'source_callback'} = $cb;
3961 
}
3962 
 
3963 
 
3964 
sub reset_values {
3965 
  my($self) = shift;
3966 
 
3967 
  ## Only put data structures that need to be cleared
3968 
  ## out when the mpc file is done being read, not at the
3969 
  ## end of each project within the mpc file.
3970 
  $self->{'project_info'}  = [];
3971 
  $self->{'lib_locations'} = {};
3972 
}
3973 
 
3974 
 
3975 
sub add_default_matching_assignments {
3976 
  my($self) = shift;
3977 
  my($lang) = $self->get_language();
3978 
 
3979 
  if (defined $lang) {
3980 
    foreach my $key (keys %{$language{$lang}->[0]}) {
3981 
      if (!defined $language{$lang}->[2]->{$key}) {
3982 
         $language{$lang}->[2]->{$key} = [];
3983 
        foreach my $keyword (@default_matching_assignments) {
3984 
          push(@{$language{$lang}->[2]->{$key}}, $keyword);
3985 
        }
3986 
      }
3987 
    }
3988 
  }
3989 
}
3990 
 
3991 
 
3992 
sub reset_generating_types {
3993 
  my($self)  = shift;
3994 
  my($lang)  = $self->get_language();
3995 
 
3996 
  if (defined $lang) {
3997 
    my(%reset) = ('valid_components'     => $language{$lang}->[0],
3998 
                  'custom_only_removed'  => $language{$lang}->[0],
3999 
                  'exclude_components'   => $language{$lang}->[1],
4000 
                  'matching_assignments' => $language{$lang}->[2],
4001 
                  'generated_exts'       => {},
4002 
                  'valid_names'          => \%validNames,
4003 
                 );
4004 
 
4005 
    foreach my $r (keys %reset) {
4006 
      $self->{$r} = {};
4007 
      foreach my $key (keys %{$reset{$r}}) {
4008 
        $self->{$r}->{$key} = $reset{$r}->{$key};
4009 
      }
4010 
    }
4011 
  }
4012 
 
4013 
  $self->{'custom_types'} = {};
4014 
 
4015 
  ## Allow subclasses to override the default extensions
4016 
  $self->set_component_extensions();
4017 
}
4018 
 
4019 
 
4020 
sub get_template_input {
4021 
  my($self) = shift;
4022 
 
4023 
  ## This follows along the same logic as read_template_input() by
4024 
  ## checking for exe target and then defaulting to a lib target
4025 
  if ($self->exe_target()) {
4026 
    if ($self->get_static() == 1) {
4027 
      return $self->{'lexe_template_input'};
4028 
    }
4029 
    else {
4030 
      return $self->{'dexe_template_input'};
4031 
    }
4032 
  }
4033 
 
4034 
  if ($self->get_static() == 1) {
4035 
    return $self->{'lib_template_input'};
4036 
  }
4037 
  else {
4038 
    return $self->{'dll_template_input'};
4039 
  }
4040 
}
4041 
 
4042 
 
4043 
sub update_project_info {
4044 
  my($self)    = shift;
4045 
  my($tparser) = shift;
4046 
  my($append)  = shift;
4047 
  my($names)   = shift;
4048 
  my($sep)     = shift;
4049 
  my($pi)      = $self->get_project_info();
4050 
  my($value)   = '';
4051 
  my($arr)     = ($append && defined $$pi[0] ? pop(@$pi) : []);
4052 
 
4053 
  ## Set up the hash table when we are starting a new project_info
4054 
  if ($append == 0) {
4055 
    $self->{'project_info_hash_table'} = {};
4056 
  }
4057 
 
4058 
  ## Append the values of all names into one string
4059 
  my(@narr) = @$names;
4060 
  for(my $i = 0; $i <= $#narr; $i++) {
4061 
    my($key) = $narr[$i];
4062 
    $value .= $self->translate_value($key,
4063 
                                     $tparser->get_value_with_default($key)) .
4064 
              (defined $sep && $i != $#narr ? $sep : '');
4065 
  }
4066 
 
4067 
  ## If we haven't seen this value yet, put it on the array
4068 
  if (!defined $self->{'project_info_hash_table'}->{"@narr $value"}) {
4069 
    $self->{'project_info_hash_table'}->{"@narr $value"} = 1;
4070 
    #$self->save_project_value("@narr", $value);
4071 
    push(@$arr, $value);
4072 
  }
4073 
 
4074 
  ## Always push the array back onto the project_info
4075 
  push(@$pi, $arr);
4076 
 
4077 
  return $value;
4078 
}
4079 
 
4080 
 
4081 
sub adjust_value {
4082 
  my($self)  = shift;
4083 
  my($names) = shift;
4084 
  my($value) = shift;
4085 
  my($atemp) = $self->get_addtemp();
4086 
 
4087 
  ## Perform any additions, subtractions
4088 
  ## or overrides for the template values.
4089 
  foreach my $name (@$names) {
4090 
    if (defined $name && defined $atemp->{lc($name)}) {
4091 
      foreach my $val (@{$atemp->{lc($name)}}) {
4092 
        my($arr) = $self->create_array($$val[1]);
4093 
        if ($$val[0] > 0) {
4094 
          if (!defined $value) {
4095 
            $value = '';
4096 
          }
4097 
          if (UNIVERSAL::isa($value, 'ARRAY')) {
4098 
            ## We need to make $value a new array reference ($arr)
4099 
            ## to avoid modifying the array reference pointed to by $value
4100 
            unshift(@$arr, @$value);
4101 
            $value = $arr;
4102 
          }
4103 
          else {
4104 
            $value .= " $$val[1]";
4105 
          }
4106 
        }
4107 
        elsif ($$val[0] < 0) {
4108 
          my($parts) = undef;
4109 
          if (defined $value) {
4110 
            if (UNIVERSAL::isa($value, 'ARRAY')) {
4111 
              $parts = $value;
4112 
            }
4113 
            else {
4114 
              $parts = $self->create_array($value);
4115 
            }
4116 
 
4117 
            $value = [];
4118 
            foreach my $part (@$parts) {
4119 
              if ($part ne '') {
4120 
                my($found) = 0;
4121 
                foreach my $ae (@$arr) {
4122 
                  if ($part eq $ae) {
4123 
                    $found = 1;
4124 
                    last;
4125 
                  }
4126 
                }
4127 
                if (!$found) {
4128 
                  push(@$value, $part);
4129 
                }
4130 
              }
4131 
            }
4132 
          }
4133 
        }
4134 
        else {
4135 
          ## If the user set the variable to empty, then we need to
4136 
          ## set the value to undef
4137 
          $value = (defined $$arr[0] ? $arr : undef);
4138 
        }
4139 
      }
4140 
      last;
4141 
    }
4142 
  }
4143 
 
4144 
  return $value;
4145 
}
4146 
 
4147 
 
198 bj 4148 
sub expand_variables {
107 bj 4149 
  my($self)            = shift;
4150 
  my($value)           = shift;
198 bj 4151 
  my($keys)            = shift;
4152 
  my($rel)             = shift;
107 bj 4153 
  my($expand_template) = shift;
4154 
  my($scope)           = shift;
198 bj 4155 
  my($expand)          = shift;
4156 
  my($warn)            = shift;
4157 
  my($cwd)             = $self->getcwd();
4158 
  my($start)           = 0;
107 bj 4159 
 
198 bj 4160 
  ## Fix up the value for Windows switch the \\'s to /
4161 
  if ($self->{'convert_slashes'}) {
4162 
    $cwd =~ s/\\/\//g;
4163 
  }
107 bj 4164 
 
198 bj 4165 
  while(substr($value, $start) =~ /(\$\(([^)]+)\))/) {
4166 
    my($whole)  = $1;
4167 
    my($name)   = $2;
4168 
    my($val)    = $$rel{$name};
107 bj 4169 
 
198 bj 4170 
    if (defined $val) {
4171 
      if ($expand) {
4172 
        if ($self->{'convert_slashes'}) {
4173 
          $val = $self->slash_to_backslash($val);
4174 
        }
4175 
        substr($value, $start) =~ s/\$\([^)]+\)/$val/;
4176 
        $whole = $val;
4177 
      }
4178 
      else {
107 bj 4179 
        ## Fix up the value for Windows switch the \\'s to /
4180 
        if ($self->{'convert_slashes'}) {
198 bj 4181 
          $val =~ s/\\/\//g;
107 bj 4182 
        }
4183 
 
198 bj 4184 
        ## Here we make an assumption that if we convert slashes to
4185 
        ## back-slashes, we also have a case-insensitive file system.
4186 
        my($icwd) = ($self->{'convert_slashes'} ? lc($cwd) : $cwd);
4187 
        my($ival) = ($self->{'convert_slashes'} ? lc($val) : $val);
4188 
        my($iclen) = length($icwd);
4189 
        my($ivlen) = length($ival);
107 bj 4190 
 
198 bj 4191 
        ## If the relative value contains the current working
4192 
        ## directory plus additional subdirectories, we must pull
4193 
        ## off the additional directories into a temporary where
4194 
        ## it can be put back after the relative replacement is done.
4195 
        my($append) = undef;
4196 
        if (index($ival, $icwd) == 0 && $iclen != $ivlen &&
4197 
            substr($ival, $iclen, 1) eq '/') {
4198 
          my($diff) = $ivlen - $iclen;
4199 
          $append = substr($ival, $iclen);
4200 
          substr($ival, $iclen, $diff) = '';
4201 
          $ivlen -= $diff;
4202 
        }
107 bj 4203 
 
198 bj 4204 
        if (index($icwd, $ival) == 0 &&
4205 
            ($iclen == $ivlen || substr($icwd, $ivlen, 1) eq '/')) {
4206 
          my($current) = $icwd;
4207 
          substr($current, 0, $ivlen) = '';
107 bj 4208 
 
198 bj 4209 
          my($dircount) = ($current =~ tr/\///);
4210 
          if ($dircount == 0) {
4211 
            $ival = '.';
4212 
          }
4213 
          else {
4214 
            $ival = '../' x $dircount;
4215 
            $ival =~ s/\/$//;
4216 
          }
4217 
          if (defined $append) {
4218 
            $ival .= $append;
4219 
          }
4220 
          if ($self->{'convert_slashes'}) {
4221 
            $ival = $self->slash_to_backslash($ival);
4222 
          }
4223 
          substr($value, $start) =~ s/\$\([^)]+\)/$ival/;
4224 
          $whole = $ival;
4225 
        }
4226 
      }
4227 
    }
4228 
    elsif ($expand_template ||
4229 
           $self->expand_variables_from_template_values()) {
4230 
      my($ti) = $self->get_template_input();
4231 
      if (defined $ti) {
4232 
        $val = $ti->get_value($name);
4233 
      }
4234 
      my($sname) = (defined $scope ? $scope . "::$name" : undef);
4235 
      my($arr) = $self->adjust_value([$sname, $name],
4236 
                                     (defined $val ? $val : []));
4237 
      if (defined $$arr[0]) {
4238 
        $val = "@$arr";
4239 
        if ($self->{'convert_slashes'}) {
4240 
          $val = $self->slash_to_backslash($val);
4241 
        }
4242 
        substr($value, $start) =~ s/\$\([^)]+\)/$val/;
107 bj 4243 
 
198 bj 4244 
        ## We have replaced the template value, but that template
4245 
        ## value may contain a $() construct that may need to get
4246 
        ## replaced too.
4247 
        $whole = '';
4248 
      }
4249 
      else {
4250 
        if ($expand && $warn) {
4251 
          $self->warning("Unable to expand $name.");
4252 
        }
4253 
      }
4254 
    }
4255 
    $start += length($whole);
4256 
  }
107 bj 4257 
 
198 bj 4258 
  return $value;
4259 
}
107 bj 4260 
 
198 bj 4261 
 
4262 
sub relative {
4263 
  my($self)            = shift;
4264 
  my($value)           = shift;
4265 
  my($expand_template) = shift;
4266 
  my($scope)           = shift;
4267 
 
4268 
  if (defined $value) {
4269 
    if (UNIVERSAL::isa($value, 'ARRAY')) {
4270 
      my(@built) = ();
4271 
      foreach my $val (@$value) {
4272 
        my($rel) = $self->relative($val, $expand_template, $scope);
4273 
        if (UNIVERSAL::isa($rel, 'ARRAY')) {
4274 
          push(@built, @$rel);
107 bj 4275 
        }
198 bj 4276 
        else {
4277 
          push(@built, $rel);
4278 
        }
107 bj 4279 
      }
198 bj 4280 
      $value = \@built;
107 bj 4281 
    }
198 bj 4282 
    elsif ($value =~ /\$/) {
4283 
      my($ovalue) = $value;
4284 
      my(@keys) = keys %{$self->{'expanded'}};
4285 
      if (defined $keys[0]) {
4286 
        $value = $self->expand_variables($value, \@keys,
4287 
                                         $self->{'expanded'},
4288 
                                         $expand_template, $scope, 1);
4289 
      }
4290 
 
4291 
      if ($ovalue eq $value) {
4292 
        my($rel) = ($self->get_use_env() ? \%ENV : $self->get_relative());
4293 
        @keys = keys %$rel;
4294 
        if (defined $keys[0]) {
4295 
          $value = $self->expand_variables($value, \@keys, $rel,
4296 
                                           $expand_template, $scope,
4297 
                                           $self->get_expand_vars(), 1);
4298 
        }
4299 
      }
4300 
    }
107 bj 4301 
  }
4302 
 
198 bj 4303 
  ## Values that have strings enclosed in double quotes are to
4304 
  ## be interpreted as elements of an array
4305 
  if (defined $value && $value =~ /^"[^"]+"(\s+"[^"]+")+$/) {
4306 
    $value = $self->create_array($value);
4307 
  }
4308 
 
107 bj 4309 
  return $value;
4310 
}
4311 
 
4312 
 
4313 
sub get_verbatim {
4314 
  my($self)   = shift;
4315 
  my($marker) = shift;
4316 
  my($str)    = undef;
4317 
  my($thash)  = $self->{'verbatim'}->{$self->{'pctype'}};
4318 
 
4319 
  if (defined $thash) {
4320 
    if (defined $thash->{$marker}) {
4321 
      my($crlf) = $self->crlf();
4322 
      foreach my $line (@{$thash->{$marker}}) {
4323 
        if (!defined $str) {
4324 
          $str = '';
4325 
        }
4326 
        $str .= $self->process_special($line) . $crlf;
4327 
      }
4328 
      if (defined $str) {
4329 
        $str .= $crlf;
4330 
        $self->{'verbatim_accessed'}->{$self->{'pctype'}}->{$marker} = 1;
4331 
      }
4332 
    }
4333 
  }
4334 
 
4335 
  return $str;
4336 
}
4337 
 
4338 
 
4339 
sub generate_recursive_input_list {
4340 
  my($self)    = shift;
4341 
  my($dir)     = shift;
4342 
  my($exclude) = shift;
4343 
  return $self->extension_recursive_input_list($dir,
4344 
                                               $exclude,
4345 
                                               $ProjectCreatorExtension);
4346 
}
4347 
 
4348 
 
4349 
sub get_modified_project_file_name {
4350 
  my($self) = shift;
4351 
  my($name) = shift;
4352 
  my($ext)  = shift;
4353 
  my($nmod) = $self->get_name_modifier();
4354 
 
4355 
  ## We don't apply the name modifier to the project file
4356 
  ## name if we have already applied it to the project name
4357 
  ## since the project file name comes from the project name.
4358 
  if (defined $nmod && !$self->get_apply_project()) {
4359 
    $nmod =~ s/\*/$name/g;
4360 
    $name = $nmod;
4361 
  }
4362 
  return "$name$ext";
4363 
}
4364 
 
4365 
 
4366 
sub get_valid_names {
4367 
  my($self) = shift;
4368 
  return $self->{'valid_names'};
4369 
}
4370 
 
4371 
 
4372 
sub preserve_assignment_order {
4373 
  my($self) = shift;
4374 
  my($name) = shift;
4375 
  my($mapped) = $self->{'valid_names'}->{$name};
4376 
 
4377 
  ## Only return the value stored in the valid_names hash map if it's
4378 
  ## defined and it's not an array reference.  The array reference is
4379 
  ## a keyword mapping and all mapped keywords should have preserved
4380 
  ## assignment order.
4381 
  if (defined $mapped && !UNIVERSAL::isa($mapped, 'ARRAY')) {
4382 
    return ($mapped & 1);
4383 
  }
4384 
 
4385 
  return 1;
4386 
}
4387 
 
4388 
 
4389 
sub add_to_template_input_value {
4390 
  my($self) = shift;
4391 
  my($name) = shift;
4392 
  my($mapped) = $self->{'valid_names'}->{$name};
4393 
 
4394 
  ## Only return the value stored in the valid_names hash map if it's
4395 
  ## defined and it's not an array reference.  The array reference is
4396 
  ## a keyword mapping and no mapped keywords should be added to
4397 
  ## template input variables.
4398 
  if (defined $mapped && !UNIVERSAL::isa($mapped, 'ARRAY')) {
4399 
    return ($mapped & 2);
4400 
  }
4401 
 
4402 
  return 0;
4403 
}
4404 
 
4405 
 
4406 
sub dependency_combined_static_library {
4407 
  #my($self) = shift;
4408 
  return defined $ENV{MPC_DEPENDENCY_COMBINED_STATIC_LIBRARY};
4409 
}
4410 
 
4411 
 
4412 
sub translate_value {
4413 
  my($self) = shift;
4414 
  my($key)  = shift;
4415 
  my($val)  = shift;
4416 
 
4417 
  if ($key eq 'after' && $val ne '') {
4418 
    my($arr) = $self->create_array($val);
4419 
    $val = '';
4420 
 
4421 
    if ($self->require_dependencies()) {
4422 
      foreach my $entry (@$arr) {
4423 
        if ($self->get_apply_project()) {
4424 
          my($nmod) = $self->get_name_modifier();
4425 
          if (defined $nmod) {
4426 
            $nmod =~ s/\*/$entry/g;
4427 
            $entry = $nmod;
4428 
          }
4429 
        }
4430 
        $val .= '"' . ($self->dependency_is_filename() ?
4431 
                          $self->project_file_name($entry) : $entry) . '" ';
4432 
      }
4433 
      $val =~ s/\s+$//;
4434 
    }
4435 
  }
4436 
  return $val;
4437 
}
4438 
 
4439 
 
4440 
sub requires_parameters {
4441 
  #my($self) = shift;
4442 
  #my($name) = shift;
4443 
  return $custom{$_[1]};
4444 
}
4445 
 
4446 
 
4447 
sub project_file_name {
4448 
  my($self) = shift;
4449 
  my($name) = shift;
4450 
 
4451 
  if (!defined $name) {
4452 
    $name = $self->project_name();
4453 
  }
4454 
 
4455 
  return $self->get_modified_project_file_name(
4456 
                                     $self->project_file_prefix() . $name,
4457 
                                     $self->project_file_extension());
4458 
}
4459 
 
4460 
 
4461 
sub remove_non_custom_settings {
4462 
  my($self) = shift;
4463 
 
4464 
  ## Remove any files that may have automatically been added
4465 
  ## to this project
4466 
  foreach my $key (keys %{$self->{'custom_only_removed'}}) {
4467 
    $self->{$key} = {};
4468 
  }
4469 
 
4470 
  ## Unset the exename, sharedname and staticname
4471 
  $self->process_assignment('exename',    undef);
4472 
  $self->process_assignment('sharedname', undef);
4473 
  $self->process_assignment('staticname', undef);
4474 
}
4475 
 
198 bj 4476 
 
4477 
sub remove_wanted_extension {
4478 
  my($self)  = shift;
4479 
  my($name)  = shift;
4480 
  my($array) = shift;
4481 
  my($orig)  = $name;
4482 
 
4483 
  foreach my $wanted (@$array) {
4484 
    if ($name =~ s/$wanted$//) {
4485 
      last;
4486 
    }
4487 
  }
4488 
 
4489 
  ## If the user provided file does not match any of the
4490 
  ## extensions specified by the custom definition, we need
4491 
  ## to remove the extension or else this file will not be
4492 
  ## added to the project.
4493 
  if ($name eq $orig) {
4494 
    $name =~ s/\.[^\.]+$//;
4495 
  }
4496 
 
4497 
  return $name;
4498 
}
4499 
 
107 bj 4500 
# ************************************************************
4501 
# Virtual Methods To Be Overridden
4502 
# ************************************************************
4503 
 
4504 
sub escape_spaces {
4505 
  #my($self) = shift;
4506 
  return 0;
4507 
}
4508 
 
4509 
 
4510 
sub validated_directory {
4511 
  my($self) = shift;
4512 
  my($dir)  = shift;
4513 
  return $dir;
4514 
}
4515 
 
4516 
sub get_quote_symbol {
4517 
  #my($self) = shift;
4518 
  return '"';
4519 
}
4520 
 
4521 
sub get_gt_symbol {
4522 
  #my($self) = shift;
4523 
  return '>';
4524 
}
4525 
 
4526 
 
4527 
sub get_lt_symbol {
4528 
  #my($self) = shift;
4529 
  return '<';
4530 
}
4531 
 
4532 
 
4533 
sub get_and_symbol {
4534 
  #my($self) = shift;
4535 
  return '&&';
4536 
}
4537 
 
4538 
 
4539 
sub get_or_symbol {
4540 
  #my($self) = shift;
4541 
  return '||';
4542 
}
4543 
 
4544 
 
4545 
sub dollar_special {
4546 
  #my($self) = shift;
4547 
  return 0;
4548 
}
4549 
 
4550 
 
4551 
sub expand_variables_from_template_values {
4552 
  #my($self) = shift;
4553 
  return 1;
4554 
}
4555 
 
4556 
 
4557 
sub require_dependencies {
4558 
  #my($self) = shift;
4559 
  return 1;
4560 
}
4561 
 
4562 
 
4563 
sub dependency_is_filename {
4564 
  #my($self) = shift;
4565 
  return 1;
4566 
}
4567 
 
4568 
 
4569 
sub fill_value {
4570 
  #my($self) = shift;
4571 
  #my($name) = shift;
4572 
  return undef;
4573 
}
4574 
 
4575 
 
4576 
sub project_file_prefix {
4577 
  #my($self) = shift;
4578 
  return '';
4579 
}
4580 
 
4581 
 
4582 
sub project_file_extension {
4583 
  #my($self) = shift;
4584 
  return '';
4585 
}
4586 
 
4587 
 
4588 
sub override_valid_component_extensions {
4589 
  #my($self) = shift;
4590 
  #my($comp) = shift;
4591 
  return undef;
4592 
}
4593 
 
4594 
 
4595 
sub override_exclude_component_extensions {
4596 
  #my($self) = shift;
4597 
  #my($comp) = shift;
4598 
  return undef;
4599 
}
4600 
 
4601 
 
4602 
sub get_dll_exe_template_input_file {
4603 
  #my($self) = shift;
4604 
  return undef;
4605 
}
4606 
 
4607 
 
4608 
sub get_lib_exe_template_input_file {
4609 
  my($self) = shift;
4610 
  return $self->get_dll_exe_template_input_file();
4611 
}
4612 
 
4613 
 
4614 
sub get_lib_template_input_file {
4615 
  my($self) = shift;
4616 
  return $self->get_dll_template_input_file();
4617 
}
4618 
 
4619 
 
4620 
sub get_dll_template_input_file {
4621 
  #my($self) = shift;
4622 
  return undef;
4623 
}
4624 
 
4625 
 
4626 
sub get_template {
4627 
  my($self) = shift;
4628 
  return $self->{'pctype'};
4629 
}
4630 
 
4631 
 
4632 
1;