Subversion Repositories gelsvn

Rev

Go to most recent revision | Details | Last modification | View Log | RSS feed

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