Mon Apr 22 13:57:40 UTC 2019 Chad Elliott <elliott_c@ociweb.com>
[MPC.git] / modules / ProjectCreator.pm
blob3a33609fe33fdde7f57f1f976472b92292937027
1 package ProjectCreator;
3 # ************************************************************
4 # Description : Base class for all project creators
5 # Author : Chad Elliott
6 # Create Date : 3/13/2002
7 # ************************************************************
9 # ************************************************************
10 # Pragmas
11 # ************************************************************
13 use strict;
14 use FileHandle;
15 use File::Path;
17 use mpc_debug;
18 use Creator;
19 use TemplateInputReader;
20 use TemplateParser;
21 use FeatureParser;
22 use CommandHelper;
24 use Data::Dumper;
25 #use Tie::IxHash;
27 use vars qw(@ISA);
28 @ISA = qw(Creator);
30 # ************************************************************
31 # Data Section
32 # ************************************************************
34 ## The basic extensions known to a project creator
35 my $BaseClassExtension = 'mpb';
36 my $ProjectCreatorExtension = 'mpc';
37 my $TemplateExtension = 'mpd';
38 my $TemplateInputExtension = 'mpt';
40 ## This feature is enabled or disabled depending on whether
41 ## or not the -static option is used.
42 my $static_libs_feature = 'static_libs_only';
44 ## Valid names for assignments within a project
45 ## Bit Meaning
46 ## 0 Preserve the order for additions (1) or invert it (0)
47 ## 1 Add this value to template input value (if there is one)
48 ## 2 Preserve <% %> settings for evaluation within the template
49 my %validNames = ('after' => 1,
50 'avoids' => 3,
51 'custom_only' => 1,
52 'dllout' => 1,
53 'dynamicflags' => 3,
54 'exename' => 1,
55 'exeout' => 1,
56 'includes' => 3,
57 'libout' => 1,
58 'libpaths' => 3,
59 'libs' => 2,
60 'lit_libs' => 2,
61 'macros' => 3,
62 'managed' => 1,
63 'pch_header' => 1,
64 'pch_source' => 1,
65 'postbuild' => 5,
66 'postclean' => 5,
67 'prebuild' => 5,
68 'pure_libs' => 2,
69 'recurse' => 1,
70 'recursive_includes' => 3,
71 'recursive_libpaths' => 3,
72 'requires' => 3,
73 'sharedname' => 1,
74 'staticflags' => 3,
75 'staticname' => 1,
76 'tagchecks' => 1,
77 'tagname' => 1,
78 'version' => 1,
79 'webapp' => 1,
82 ## Custom definitions only
83 ## Bit Meaning
84 ## 0 Value is always an array
85 ## 1 Value is an array and name gets 'outputext' converted to 'files'
86 ## 2 Value is always scalar
87 ## 3 Name can also be used in an 'optional' clause
88 ## 4 Needs <%...%> conversion
89 my %customDefined = ('automatic_in' => 0x04,
90 'automatic_out' => 0x04,
91 'command' => 0x14,
92 'commandflags' => 0x14,
93 'dependent' => 0x14,
94 'dependent_libs' => 0x14,
95 'precommand' => 0x14,
96 'postcommand' => 0x14,
97 'inputext' => 0x01,
98 'libpath' => 0x04,
99 'output_follows_input' => 0x04,
100 'output_option' => 0x14,
101 'pch_postrule' => 0x04,
102 'pre_extension' => 0x08,
103 'source_pre_extension' => 0x08,
104 'template_pre_extension' => 0x08,
105 'header_pre_extension' => 0x08,
106 'inline_pre_extension' => 0x08,
107 'documentation_pre_extension' => 0x08,
108 'resource_pre_extension' => 0x08,
109 'generic_pre_extension' => 0x08,
110 'pre_filename' => 0x08,
111 'source_pre_filename' => 0x08,
112 'template_pre_filename' => 0x08,
113 'header_pre_filename' => 0x08,
114 'inline_pre_filename' => 0x08,
115 'documentation_pre_filename' => 0x08,
116 'resource_pre_filename' => 0x08,
117 'generic_pre_filename' => 0x08,
118 'pre_dirname' => 0x08,
119 'source_pre_dirname' => 0x08,
120 'template_pre_dirname' => 0x08,
121 'header_pre_dirname' => 0x08,
122 'inline_pre_dirname' => 0x08,
123 'documentation_pre_dirname' => 0x08,
124 'resource_pre_dirname' => 0x08,
125 'generic_pre_dirname' => 0x08,
126 'source_outputext' => 0x0a,
127 'template_outputext' => 0x0a,
128 'header_outputext' => 0x0a,
129 'inline_outputext' => 0x0a,
130 'documentation_outputext' => 0x0a,
131 'resource_outputext' => 0x0a,
132 'generic_outputext' => 0x0a,
135 ## Custom sections as well as definitions
136 ## Value Meaning
137 ## 0 No modifications
138 ## 1 Needs <%...%> conversion
139 my %custom = ('command' => 1,
140 'commandflags' => 1,
141 'dependent' => 1,
142 'dependent_libs'=> 1,
143 'gendir' => 0,
144 'precommand' => 1,
145 'postcommand' => 1,
148 ## All matching assignment arrays will get these keywords
149 my @default_matching_assignments = ('recurse',
152 ## Deal with these components in a special way
153 my %specialComponents = ('header_files' => 1,
154 'inline_files' => 1,
155 'template_files' => 1,
157 my %sourceComponents = ('source_files' => 1,
158 'template_files' => 1,
161 my $defgroup = 'default_group';
162 my $grouped_key = 'grouped_';
163 my $tikey = '/ti/';
165 ## Matches with generic_outputext
166 my $generic_key = 'generic_files';
168 ## These constants are used with the "project info" and
169 ## must match the order that is defined by the call order
170 ## of ProjectCreator::update_project_info(). This called
171 ## order is determined by the TemplateParser.
173 ## NOTE: If you are going to add a new constant, you must make it the
174 ## numeric value of the CONFIGURATIONS constant and increment
175 ## the existing CONFIGURATIONS value.
176 use constant PROJECT_NAME => 0;
177 use constant DEPENDENCIES => 1;
178 use constant PROJECT_GUID => 2;
179 use constant LANGUAGE => 3;
180 use constant CUSTOM_ONLY => 4;
181 use constant NO_CROSS_COMPILE => 5;
182 use constant MANAGED_PROJECT => 6;
183 use constant MAKE_GROUP => 7;
184 use constant CONFIGURATIONS => 8;
186 # ************************************************************
187 # C++ Specific Component Settings
188 # ************************************************************
190 ## Resource files tag for C++
191 my $cppresource = 'resource_files';
193 ## Valid component names within a project along with the valid file extensions
194 my %cppvc = ('source_files' => [ "\\.cpp", "\\.cxx", "\\.cc", "\\.c", "\\.C", ],
195 'template_files' => [ "_T\\.cpp", "_T\\.cxx", "_T\\.cc", "_T\\.c", "_T\\.C", "_t\\.cpp", "_t\\.cxx", "_t\\.cc", "_t\\.c", "_t\\.C", "\\.tpp" ],
196 'header_files' => [ "\\.h", "\\.hpp", "\\.hxx", "\\.hh", ],
197 'inline_files' => [ "\\.i", "\\.ipp", "\\.inl", ],
198 'documentation_files' => [ "README", "readme", "\\.doc", "\\.txt", "\\.html" ],
199 $cppresource => [ "\\.rc", ],
202 ## Exclude these extensions when auto generating the component values
203 my %cppec = ('source_files' => $cppvc{'template_files'},
206 ## These matching assignment arrays will get added, but only to the
207 ## specific project component types.
208 my %cppma = ('source_files' => ['buildflags',
209 'managed',
210 'no_pch',
212 'header_files' => [ 'dependent_upon',
216 # ************************************************************
217 # C# Specific Component Settings
218 # ************************************************************
220 ## Resource files tag for C#
221 my $csresource = 'resx_files';
223 ## Valid component names within a project along with the valid file extensions
224 my %csvc = ('source_files' => [ "\\.cs" ],
225 'config_files' => [ "\\.config" ],
226 $csresource => [ "\\.resx", "\\.resources" ],
227 'aspx_files' => [ "\\.aspx" ],
228 'ico_files' => [ "\\.ico" ],
229 'documentation_files' => [ "README", "readme", "\\.doc", "\\.txt", "\\.html" ],
230 'embedded_resource_files' => [],
231 'resource_files' => [],
232 'page_files' => [],
233 'appdef_files' => [],
234 'splash_files' => [],
237 my %csma = ('source_files' => [ 'dependent_upon',
238 'subtype',
240 $csresource => [ 'dependent_upon',
241 'generates_source',
242 'subtype',
246 # ************************************************************
247 # Java Specific Component Settings
248 # ************************************************************
250 ## Valid component names within a project along with the valid file extensions
251 my %jvc = ('source_files' => [ "\\.java" ],
252 'documentation_files' => [ "README", "readme", "\\.doc", "\\.txt", "\\.html" ],
255 # ************************************************************
256 # Visual Basic Specific Component Settings
257 # ************************************************************
259 ## Resource files tag for VB
260 my $vbresource = 'resx_files';
262 ## Valid component names within a project along with the valid file extensions
263 my %vbvc = ('source_files' => [ "\\.vb" ],
264 'config_files' => [ "\\.config" ],
265 $vbresource => [ "\\.resx" ],
266 'aspx_files' => [ "\\.aspx" ],
267 'ico_files' => [ "\\.ico" ],
268 'documentation_files' => [ "README", "readme", "\\.doc", "\\.txt", "\\.html" ],
271 my %vbma = ('source_files' => [ 'subtype' ],
274 # ************************************************************
275 # Language Specific Component Settings
276 # ************************************************************
278 # Index Description
279 # ----- -----------
280 # 0 File types
281 # 1 Files automatically excluded from source_files
282 # 2 Assignments available in standard file types
283 # 3 The entry point for executables
284 # 4 The language uses a C preprocessor
285 # 5 Name of the tag for 'resource_files' for this language
286 # * This is special because it gets treated like source_files in that
287 # a project with only these files is a library/exe not "custom only".
289 ## NOTE: We call the constant as a function to support Perl 5.6.
290 my %language = (Creator::cplusplus() => [ \%cppvc, \%cppec, \%cppma, 'main',
291 1, $cppresource ],
293 Creator::csharp() => [ \%csvc, {}, \%csma, 'Main', 0,
294 $csresource ],
296 Creator::java() => [ \%jvc, {}, {}, 'main', 0 ],
298 Creator::vb() => [ \%vbvc, {}, \%vbma, 'Main', 0,
299 $vbresource ],
301 my %mains;
303 # ************************************************************
304 # Subroutine Section
305 # ************************************************************
307 sub new {
308 my($class, $global, $inc, $template, $ti, $dynamic, $static, $relative, $addtemp, $addproj, $progress, $toplevel, $baseprojs, $gfeature, $relative_f, $feature, $features, $hierarchy, $exclude, $makeco, $nmod, $applypj, $genins, $into, $language, $use_env, $expandvars, $gendot, $comments, $foreclipse, $pid) = @_;
309 my $self = $class->SUPER::new($global, $inc,
310 $template, $ti, $dynamic, $static,
311 $relative, $addtemp, $addproj,
312 $progress, $toplevel, $baseprojs,
313 $feature, $features,
314 $hierarchy, $nmod, $applypj,
315 $into, $language, $use_env,
316 $expandvars,
317 'project');
319 $self->{$self->{'type_check'}} = 0;
320 $self->{'feature_defined'} = 0;
321 $self->{'features_changed'} = undef;
322 $self->{'project_info'} = [];
323 $self->{'lib_locations'} = {};
324 $self->{'reading_parent'} = [];
325 $self->{'dll_exe_template_input'}= {};
326 $self->{'lib_exe_template_input'}= {};
327 $self->{'lib_template_input'} = {};
328 $self->{'dll_template_input'} = {};
329 $self->{'flag_overrides'} = {};
330 $self->{'custom_special_output'} = {};
331 $self->{'custom_special_depend'} = {};
332 $self->{'special_supplied'} = {};
333 $self->{'pctype'} = $self->extractType("$self");
334 $self->{'verbatim'} = {};
335 $self->{'verbatim_accessed'} = {$self->{'pctype'} => {}};
336 $self->{'defaulted'} = {};
337 $self->{'custom_types'} = {};
338 $self->{'parents_read'} = {};
339 $self->{'inheritance_tree'} = {};
340 $self->{'remove_files'} = {};
341 $self->{'expanded'} = {};
342 $self->{'dependency_attributes'} = {};
343 $self->{'gfeature_file'} = $gfeature;
344 $self->{'relative_file'} = $relative_f;
345 $self->{'feature_parser'} = $self->create_feature_parser($features,
346 $feature);
347 $self->{'sort_files'} = $self->sort_files();
348 $self->{'source_callback'} = undef;
349 $self->{'dollar_special'} = $self->dollar_special();
350 $self->{'generate_ins'} = $genins;
351 $self->{'addtemp_state'} = undef;
352 $self->{'command_subs'} = $self->get_command_subs();
353 $self->{'escape_spaces'} = $self->escape_spaces();
354 $self->{'current_template'} = undef;
355 $self->{'make_coexistence'} = $makeco;
357 $self->add_default_matching_assignments();
358 $self->reset_generating_types();
360 $self->{'pid'} = $pid;
361 $self->{'llctr'} = 0; # counts the hash insertion order for mp-mpc
363 return $self;
367 sub is_keyword {
368 ## Is the name passed in a known keyword for a project. This includes
369 ## keywords mapped by Define_Custom or Modify_Custom.
370 my($self, $name) = @_;
371 return $self->{'valid_names'}->{$name};
375 sub read_global_configuration {
376 my $self = shift;
377 my $input = $self->get_global_cfg();
378 my $status = 1;
380 if (defined $input) {
381 ## If it doesn't contain a path, search the include path
382 if ($input !~ /[\/\\]/) {
383 $input = $self->search_include_path($input);
384 $input = $self->get_global_cfg() if (!defined $input);
387 ## Read and parse the global project file
388 $self->{'reading_global'} = 1;
389 $status = $self->parse_file($input);
390 $self->{'reading_global'} = 0;
393 return $status;
397 sub convert_to_template_assignment {
398 my($self, $name, $value, $calledfrom) = @_;
400 ## If the value we are going to set for $name has been used as a
401 ## scoped template variable, we need to hijack the whole assignment
402 ## and turn it into a template variable assignment.
403 my $atemp = $self->get_addtemp();
404 foreach my $key (grep(/::$name$/, keys %$atemp)) {
405 $self->update_template_variable(0, $calledfrom, $key, $value);
410 sub create_recursive_settings {
411 my($self, $name, $value, $assign) = @_;
413 ## Handle both recursive_includes and recursive_libpaths in one
414 ## search and replace.
415 if ($name =~ s/^recursive_//) {
416 ## This portion of code was lifted directly from Creator::relative()
417 ## but modified to always expand the variables. We will turn the
418 ## expanded values back into variables below and once they're passed
419 ## off to the assignment processing code, they will be turned into
420 ## relative values (if possible).
421 if (index($value, '$') >= 0) {
422 my $ovalue = $value;
423 my($rel, $how) = $self->get_initial_relative_values();
424 $value = $self->expand_variables($value, $rel, 0, undef, 1);
426 if ($ovalue eq $value || index($value, '$') >= 0) {
427 ($rel, $how) = $self->get_secondary_relative_values();
428 $value = $self->expand_variables($value, $rel, 0, undef, 1, 1);
432 ## Create an array out of the recursive directory list. Convert all
433 ## of the relative or full path values back into $() values.
434 my @dirs = ();
435 my $elems = $self->create_array($value);
436 foreach my $elem (@$elems) {
437 my $dlist = $self->recursive_directory_list($elem, []);
438 if ($dlist eq '') {
439 ## This directory doesn't exist, just add the original value
440 push(@dirs, $elem);
442 else {
443 ## Create an array out of the directory list and add it to our
444 ## array.
445 my $array = $self->create_array($dlist);
446 push(@dirs, @$array);
450 ## We need to return a string, so we join it all together space
451 ## separated.
452 $value = join(' ', $self->back_to_variable(\@dirs));
455 return $name, $value;
458 sub process_assignment {
459 my($self, $name, $value, $assign, $calledfrom) = @_;
460 $calledfrom = 0 if (!defined $calledfrom);
462 ## See if the name is one of the special "recursive" settings. If so,
463 ## fix up the value and change the name.
464 ($name, $value) = $self->create_recursive_settings($name, $value, $assign);
466 if (defined $value) {
467 if ($name eq 'after') {
468 mpc_debug::chkpnt_pre_after_keyword_assignment($name, $value, $assign, $calledfrom);
469 ## Support dependency attributes. They may or may not be used by
470 ## the project or workspace creator implementation. They are
471 ## stored separately from the dependencies themselves. Also, note
472 ## that a value to be added may contain more than one element to be
473 ## added. This function will be called for each one, so we only
474 ## need to handle one at a time.
475 if ($value =~ s/(\s*([^:]+)):([^\s]+)/$1/) {
476 ## The value may contain multiple projects. But, only one
477 ## dependency attribute will be present at any time. So, once we
478 ## get here, we need to remove any of the other projects from the
479 ## front of the key string.
480 my $key = $2;
481 my $value = $3;
482 $key =~ s/.*\s+//;
483 $self->{'dependency_attributes'}->{$key} = $value;
486 ## Check the after value and warn the user in the event that it
487 ## contains a value that can not be used within a project name.
488 if (!$self->valid_project_name($value)) {
489 $self->warning("after '$value' contains an invalid project name in " .
490 $self->{'current_input'} . ' at line ' .
491 $self->get_line_number() . '.');
494 ## Support the '*' mechanism as in the project name, to allow
495 ## the user to correctly depend on another project within the same
496 ## directory.
497 if (index($value, '*') >= 0) {
498 $value = $self->fill_type_name($value,
499 $self->get_default_project_name());
501 mpc_debug::chkpnt_post_after_keyword_assignment($name, $value, $assign, $calledfrom);
503 ## Support the '*' mechanism for libs assignment as well.
504 elsif ($name eq 'libs' && index($value, '*') >= 0) {
505 $value = $self->fill_type_name($value, $self->get_default_project_name());
508 ## If this particular project type does not consider the dollar sign
509 ## special and the user has provided two dollarsigns as an escape, we
510 ## will turn it into a single dollar sign.
511 if (!$self->{'dollar_special'} && index($value, '$$') >= 0) {
512 $value =~ s/\$\$/\$/g;
515 ## If the assignment name is valid and requires parameter (<%...%>)
516 ## replacement, then do so. But, only do so on actual keywords.
517 ## User defined keywords must not have the parameters replaced in
518 ## order for them to get the correct replacement values later on.
519 if (defined $validNames{$name} &&
520 ($validNames{$name} & 0x04) == 0 && index($value, '<%') >= 0) {
521 $value = $self->replace_parameters($value, $self->{'command_subs'});
525 if ($calledfrom == 0) {
526 $self->convert_to_template_assignment($name, $value, $calledfrom);
529 ## Call the base process_assigment() after we have modified the name and
530 ## value.
531 $self->SUPER::process_assignment($name, $value, $assign);
533 ## Support keyword mapping here only at the project level scope. The
534 ## scoped keyword mapping is done through the parse_scoped_assignment()
535 ## method.
536 if (!defined $assign || $assign == $self->get_assignment_hash()) {
537 my $mapped = $self->{'valid_names'}->{$name};
538 if (defined $mapped && UNIVERSAL::isa($mapped, 'ARRAY')) {
539 $self->parse_scoped_assignment($$mapped[0], 0,
540 $$mapped[1], $value,
541 $self->{'generated_exts'}->{$$mapped[0]});
547 sub process_assignment_add {
548 my($self, $name, $value, $assign) = @_;
550 ## See if the name is one of the special "recursive" settings. If so,
551 ## fix up the value and change the name.
552 ($name, $value) = $self->create_recursive_settings($name, $value, $assign);
554 return $self->SUPER::process_assignment_add($name, $value, $assign);
558 sub process_assignment_sub {
559 my($self, $name, $value, $assign) = @_;
561 ## See if the name is one of the special "recursive" settings. If so,
562 ## fix up the value and change the name.
563 ($name, $value) = $self->create_recursive_settings($name, $value, $assign);
565 ## If the assignment name is valid and requires parameter (<%...%>)
566 ## replacement, then do so. But, only do so on actual keywords.
567 ## User defined keywords must not have the parameters replaced in
568 ## order for them to get the correct replacement values later on.
569 if (defined $validNames{$name} &&
570 ($validNames{$name} & 0x04) == 0 && index($value, '<%') >= 0) {
571 $value = $self->replace_parameters($value, $self->{'command_subs'});
574 return $self->SUPER::process_assignment_sub($name, $value, $assign);
578 sub addition_core {
579 my($self, $name, $value, $nval, $assign) = @_;
581 ## If there is a previous value ($nval) and the keyword is going to be
582 ## evaled, we need to separate the values with a command separator.
583 ## This has to be done at the MPC level because it isn't always
584 ## possible for the user to know if a value has already been added to
585 ## the keyword (prebuild, postbuild and postclean).
586 if (defined $nval &&
587 defined $validNames{$name} && ($validNames{$name} & 4)) {
588 if ($self->preserve_assignment_order($name)) {
589 $value = '<%cmdsep%> ' . $value;
591 else {
592 $value .= '<%cmdsep%>';
596 ## For an addition, we need to see if it is a project keyword being
597 ## used within a 'specific' section. If it is, we may need to update
598 ## scoped settings for that variable (which are in essence template
599 ## variables).
600 $self->convert_to_template_assignment($name, $value, 1);
602 ## Next, we just give everything to the base class method.
603 $self->SUPER::addition_core($name, $value, $nval, $assign);
607 sub subtraction_core {
608 my($self, $name, $value, $nval, $assign) = @_;
610 ## For a subtraction, we need to see if it is a project keyword being
611 ## used within a 'specific' section. If it is, we may need to update
612 ## scoped settings for that variable (which are in essence template
613 ## variables).
614 $self->convert_to_template_assignment($name, $value, -1);
616 ## Next, we just give everything to the base class method.
617 $self->SUPER::subtraction_core($name, $value, $nval, $assign);
621 sub get_assignment_for_modification {
622 my($self, $name, $assign, $subtraction) = @_;
624 ## If we weren't passed an assignment hash, then we need to
625 ## look one up that may possibly correctly deal with keyword mappings
626 if (!defined $assign) {
627 my $mapped = $self->{'valid_names'}->{$name};
629 if (defined $mapped && UNIVERSAL::isa($mapped, 'ARRAY')) {
630 $name = $$mapped[1];
631 $assign = $self->{'generated_exts'}->{$$mapped[0]};
635 ## Get the assignment value
636 my $value = $self->get_assignment($name, $assign);
638 ## If we are involved in a subtraction, we get back a value and
639 ## it's a scoped or mapped assignment, then we need to possibly
640 ## expand any template variables. Otherwise, the subtractions
641 ## may not work correctly.
642 if ($subtraction && defined $value && defined $assign) {
643 $value = $self->relative($value, 1);
646 return $value;
650 sub begin_project {
651 my($self, $parents) = @_;
652 my $status = 1;
653 my $error;
655 ## Deal with the inheritance hierarchy first
656 ## Add in the base projects from the command line
657 if (!$self->{'reading_global'} &&
658 !defined $self->{'reading_parent'}->[0]) {
659 my $baseprojs = $self->get_baseprojs();
661 if (defined $parents) {
662 StringProcessor::merge($parents, $baseprojs);
664 else {
665 $parents = $baseprojs;
669 if (defined $parents) {
670 foreach my $parent (@$parents) {
671 ## Read in the parent onto ourself
672 my $file = $self->search_include_path(
673 "$parent.$BaseClassExtension");
674 if (!defined $file) {
675 $file = $self->search_include_path(
676 "$parent.$ProjectCreatorExtension");
679 if (defined $file) {
680 if (defined $self->{'reading_parent'}->[0]) {
681 if (StringProcessor::fgrep($file, $self->{'reading_parent'})) {
682 $status = 0;
683 $error = 'Cyclic inheritance detected: ' . $parent;
687 if ($status) {
688 if (!defined $self->{'parents_read'}->{$file}) {
689 $self->{'parents_read'}->{$file} = 1;
691 ## Push the base project file onto the parent stack
692 push(@{$self->{'reading_parent'}}, $file);
694 ## Collect up some information about the inheritance tree
695 my $tree = $self->{'current_input'};
696 if (!defined $self->{'inheritance_tree'}->{$tree}) {
697 $self->{'inheritance_tree'}->{$tree} = {};
699 my $hash = $self->{'inheritance_tree'}->{$tree};
700 foreach my $p (@{$self->{'reading_parent'}}) {
701 $$hash{$p} = {} if (!defined $$hash{$p});
702 $hash = $$hash{$p};
705 ## Begin reading the parent
706 mpc_debug::chkpnt_pre_parse_base_project($file);
707 $status = $self->parse_file($file);
708 mpc_debug::chkpnt_post_parse_base_project($file, $status);
710 ## Take the base project file off of the parent stack
711 pop(@{$self->{'reading_parent'}});
713 $error = "Invalid parent: $parent" if (!$status);
715 else {
716 ## The base project has already been read. So, if
717 ## we are reading the original project (not a parent base
718 ## project), then the current base project is redundant.
719 if (!defined $self->{'reading_parent'}->[0]) {
720 $file =~ s/\.[^\.]+$//;
721 $self->information('Inheriting from \'' .
722 $self->mpc_basename($file) .
723 '\' in ' . $self->{'current_input'} .
724 ' is redundant at line ' .
725 $self->get_line_number() . '.');
730 else {
731 $status = 0;
732 $error = "Unable to locate parent: $parent";
737 ## Copy each value from global_assign into assign
738 if (!$self->{'reading_global'}) {
739 foreach my $key (keys %{$self->{'global_assign'}}) {
740 if (!defined $self->{'assign'}->{$key}) {
741 $self->{'assign'}->{$key} = $self->{'global_assign'}->{$key};
746 return $status, $error;
750 sub get_process_project_type {
751 my($self, $types) = @_;
752 my $type = '';
753 my $defcomp = $self->get_default_component_name();
755 foreach my $t (split(/\s*,\s*/, $types)) {
756 my $not = ($t =~ s/^!\s*//);
757 if ($not) {
758 if ($t eq $self->{'pctype'}) {
759 $type = '';
760 last;
762 else {
763 $type = $self->{'pctype'};
766 elsif ($t eq $self->{'pctype'} || $t eq $defcomp) {
767 $type = $t;
768 last;
772 return $type;
776 sub matches_specific_scope {
777 my($self, $elements) = @_;
779 ## First check for properties that correspond to the current project
780 ## type. Elements that begin with "prop:" indicate a property.
781 my $list = '';
782 my $props = $self->get_properties();
783 foreach my $prop (split(/\s*,\s*/, $elements)) {
784 my $not = ($prop =~ s/^!\s*//);
785 if ($prop =~/(.+):(.+)/) {
786 if ($1 eq 'prop') {
787 $prop = $2;
788 if ($not) {
789 return $self->{'pctype'} if (!$$props{$prop});
791 else {
792 return $self->{'pctype'} if ($$props{$prop});
795 else {
796 $self->warning("$prop is not recognized.");
799 else {
800 $list .= ($not ? '!' : '') . $prop . ',';
804 ## If none of the elements match a property, then check the type
805 ## against the current project type or the default component name
806 ## (which is what it would be set to if a specific clause is used with
807 ## out parenthesis).
808 my $type = $self->get_process_project_type($list);
809 return $self->{'pctype'} if ($type eq $self->{'pctype'} ||
810 $type eq $self->get_default_component_name());
812 ## Nothing matched
813 return undef;
817 sub parse_line {
818 my($self, $ih, $line) = @_;
819 my($status,
820 $errorString,
821 @values) = $self->parse_known($line, $ih);
823 ## parse_known() passes back an array of values
824 ## that make up the contents of the line parsed.
825 ## The array can have 0 to 4 items. The first,
826 ## if defined, is always an identifier of some
827 ## sort.
829 if ($status && defined $values[0]) {
830 if ($values[0] eq $self->{'grammar_type'}) {
831 my $name = $values[1];
832 my $typecheck = $self->{'type_check'};
833 if (defined $name && $name eq '}') {
834 ## Project Ending
835 if (!defined $self->{'reading_parent'}->[0] &&
836 !$self->{'reading_global'}) {
837 ## Fill in all the default values
838 $self->generate_defaults();
840 ## Perform any additions, subtractions
841 ## or overrides for the project values.
842 my $addproj = $self->get_addproj();
843 foreach my $ap (keys %$addproj) {
844 if (defined $self->{'valid_names'}->{$ap}) {
845 foreach my $val (@{$$addproj{$ap}}) {
846 if ($$val[0] > 0) {
847 $self->process_assignment_add($ap, $$val[1]);
849 elsif ($$val[0] < 0) {
850 $self->process_assignment_sub($ap, $$val[1]);
852 else {
853 $self->process_assignment($ap, $$val[1]);
857 else {
858 $errorString = 'Invalid ' .
859 "assignment modification name: $ap";
860 $status = 0;
864 if ($status) {
865 ## Generate default target names after all source files are added
866 ## and after we've added in all of the options from the
867 ## command line. If the user set exename on the command line
868 ## and no "main" is found, sharedname will be set too and
869 ## most templates do not handle that well.
870 $self->generate_default_target_names();
872 ## End of project; Write out the file.
873 ($status, $errorString) = $self->write_project();
875 ## write_project() can return 0 for error, 1 for project
876 ## was written and 2 for project was skipped
877 if ($status == 1) {
878 ## Save the library name and location
879 foreach my $name ('sharedname', 'staticname') {
880 my $val = $self->get_assignment($name);
881 if (defined $val) {
882 my $cwd = $self->getcwd();
883 my $start = $self->getstartdir();
884 my $amount = 0;
885 if ($cwd eq $start) {
886 $amount = length($start);
888 elsif (index($cwd, $start) == 0) {
889 $amount = length($start) + 1;
891 if ($self->{'pid'} eq 'child') {
892 $self->{'lib_locations'}->{$val} =
893 ++$self->{'llctr'} . '|' .
894 substr($cwd, $amount);
896 else {
898 $self->{'lib_locations'}->{$val} =
899 substr($cwd, $amount);
901 last;
905 ## Check for unused verbatim markers
906 foreach my $key (keys %{$self->{'verbatim'}}) {
907 if (defined $self->{'verbatim_accessed'}->{$key}) {
908 foreach my $ikey (keys %{$self->{'verbatim'}->{$key}}) {
909 if (!defined $self->{'verbatim_accessed'}->{$key}->{$ikey}) {
910 $self->warning("Marker $ikey does not exist.");
917 ## Reset all of the project specific data. I am explicitly
918 ## not resetting dependency_attributes. It is necessary that
919 ## this information stay for the life of the ProjectCreator
920 ## object so that the WorkspaceCreator can have access to the
921 ## information.
922 foreach my $key (keys %{$self->{'valid_components'}}) {
923 delete $self->{$key};
924 delete $self->{'defaulted'}->{$key};
926 if (defined $self->{'addtemp_state'}) {
927 $self->restore_state($self->{'addtemp_state'}, 'addtemp');
928 $self->{'addtemp_state'} = undef;
930 $self->{'assign'} = {};
931 $self->{'verbatim'} = {};
932 $self->{'verbatim_accessed'} = {$self->{'pctype'} => {}};
933 $self->{'special_supplied'} = {};
934 $self->{'flag_overrides'} = {};
935 $self->{'parents_read'} = {};
936 $self->{'inheritance_tree'} = {};
937 $self->{'remove_files'} = {};
938 $self->{'custom_special_output'} = {};
939 $self->{'custom_special_depend'} = {};
940 $self->{'expanded'} = {};
941 $self->reset_generating_types();
944 $self->{$typecheck} = 0;
946 else {
947 ## Project Beginning
948 ($status, $errorString) = $self->begin_project($values[2]);
950 ## Set up the default project name
951 if ($status) {
952 if (defined $name) {
953 if ($self->valid_project_name($name)) {
954 ## We should only set the project name if we are not
955 ## reading in a parent project.
956 if (!defined $self->{'reading_parent'}->[0]) {
957 $name =~ s/^\(\s*//;
958 $name =~ s/\s*\)$//;
959 $name = $self->transform_file_name($name);
961 ## Replace any *'s with the default name
962 if (index($name, '*') >= 0) {
963 $name = $self->fill_type_name(
964 $name,
965 $self->get_default_project_name());
968 $self->set_project_name($name);
970 else {
971 $self->warning("Ignoring project name " .
972 "$name in a base project.");
975 else {
976 $status = 0;
977 $errorString = 'Projects can not have the following in ' .
978 'the name: / \\ = ? : & " < > | # %';
983 ## Signify that we have a valid project
984 $self->{$typecheck} = 1 if ($status);
987 elsif ($values[0] eq '0') {
988 ## $values[1] = name; $values[2] = value
989 if (defined $self->{'valid_names'}->{$values[1]}) {
990 $self->process_assignment($values[1], $values[2]);
992 else {
993 $errorString = "Invalid assignment name: '$values[1]'";
994 $status = 0;
997 elsif ($values[0] eq '1') {
998 ## $values[1] = name; $values[2] = value
999 if (defined $self->{'valid_names'}->{$values[1]}) {
1000 $self->process_assignment_add($values[1], $values[2]);
1002 else {
1003 $errorString = "Invalid addition name: $values[1]";
1004 $status = 0;
1007 elsif ($values[0] eq '-1') {
1008 ## $values[1] = name; $values[2] = value
1009 if (defined $self->{'valid_names'}->{$values[1]}) {
1010 $self->process_assignment_sub($values[1], $values[2]);
1012 else {
1013 $errorString = "Invalid subtraction name: $values[1]";
1014 $status = 0;
1017 elsif ($values[0] eq 'component') {
1018 my $comp = $values[1];
1019 my $name = $values[2];
1020 my @inhr = defined $values[3] ? @{$values[3]} : ();
1021 my $vc = $self->{'valid_components'};
1023 if ($comp ne 'define_custom' && @inhr != 0) {
1024 return 0, "$comp does not allow an inheritance list";
1027 if (defined $$vc{$comp}) {
1028 ($status, $errorString) = $self->parse_components($ih, $comp, $name);
1030 else {
1031 if ($comp eq 'verbatim') {
1032 my($type, $loc, $add) = split(/\s*,\s*/, $name);
1033 ($status, $errorString) = $self->parse_verbatim($ih, $type,
1034 $loc, $add);
1036 elsif ($comp eq 'specific') {
1037 my $type = $self->matches_specific_scope($name);
1038 if (defined $type) {
1039 ($status, $errorString) = $self->parse_scope(
1040 $ih, $comp, $type,
1041 $self->{'valid_names'},
1042 $self->get_assignment_hash(),
1043 {});
1045 else {
1046 ## We still need to parse the scope, but we will be
1047 ## throwing away whatever is processed. However, it
1048 ## could still be invalid code that will cause an error.
1049 ($status, $errorString) = $self->parse_scope(
1050 $ih, $comp, undef,
1051 $self->{'valid_names'},
1052 undef,
1053 $self->get_assignment_hash());
1056 elsif ($comp eq 'define_custom') {
1057 ($status, $errorString) = $self->parse_define_custom($ih, $name, 0,
1058 \@inhr);
1060 elsif ($comp eq 'modify_custom') {
1061 ($status, $errorString) = $self->parse_define_custom($ih, $name, 1);
1063 elsif ($comp eq 'expand') {
1064 $self->{'parsing_expand'} = 1;
1065 ($status, $errorString) = $self->parse_scope($ih, $comp, $name, undef);
1066 $self->{'parsing_expand'} = undef;
1068 else {
1069 $errorString = "Invalid component name: $comp";
1070 $status = 0;
1074 elsif ($values[0] eq 'feature') {
1075 $self->{'feature_defined'} = 1;
1076 ($status, $errorString) = $self->process_feature($ih,
1077 $values[1],
1078 $values[2]);
1079 if ($status && $self->{'feature_defined'}) {
1080 $errorString = "Did not find the end of the feature";
1081 $status = 0;
1084 else {
1085 $errorString = "Unrecognized line: $line";
1086 $status = 0;
1089 elsif ($status == -1) {
1090 $status = 0;
1093 return $status, $errorString;
1097 sub parse_scoped_assignment {
1098 my($self, $tag, $type, $name, $value, $flags) = @_;
1100 ## Map the assignment name on a scoped assignment
1101 my $mapped = $self->{'valid_names'}->{$name};
1102 if (defined $mapped && UNIVERSAL::isa($mapped, 'ARRAY')) {
1103 $name = $$mapped[1];
1106 if (defined $self->{'matching_assignments'}->{$tag} &&
1107 StringProcessor::fgrep($name, $self->{'matching_assignments'}->{$tag})) {
1108 my $over = {};
1109 if (defined $self->{'flag_overrides'}->{$tag}) {
1110 $over = $self->{'flag_overrides'}->{$tag};
1112 else {
1113 $self->{'flag_overrides'}->{$tag} = $over;
1116 if ($type == 0) {
1117 $self->process_assignment($name, $value, $flags);
1119 elsif ($type == 1) {
1120 ## If there is no value in $$flags, then we need to get
1121 ## the outer scope value and put it in there.
1122 if (!defined $self->get_assignment($name, $flags)) {
1123 my $outer = $self->get_assignment($name);
1124 $self->process_assignment($name, $outer, $flags);
1126 $self->process_assignment_add($name, $value, $flags);
1128 elsif ($type == -1) {
1129 ## If there is no value in $$flags, then we need to get
1130 ## the outer scope value and put it in there.
1131 if (!defined $self->get_assignment($name, $flags)) {
1132 my $outer = $self->get_assignment($name);
1133 $self->process_assignment($name, $outer, $flags);
1135 $self->process_assignment_sub($name, $value, $flags);
1137 return 1;
1140 return 0;
1144 sub update_template_variable {
1145 my $self = shift;
1146 my $check = shift;
1147 my @values = @_;
1149 ## Save the addtemp state if we haven't done so before
1150 if (!defined $self->{'addtemp_state'}) {
1151 my %state = $self->save_state('addtemp');
1152 $self->{'addtemp_state'} = \%state;
1155 ## If the name that is used within a specific is a mapped keyword
1156 ## then we need to translate it into the mapped keyword as it will
1157 ## be used by the TemplateParser.
1158 my $name;
1159 if ($values[1] =~ /(.*::)(.*)/) {
1160 my $base = $1;
1161 my $mapped = $self->{'valid_names'}->{$2};
1162 if (defined $mapped && UNIVERSAL::isa($mapped, 'ARRAY')) {
1163 $name = $values[1];
1164 $values[1] = $base . 'custom_type->' . $$mapped[1];
1168 ## Now modify the addtemp values
1169 my $atemp = $self->get_addtemp();
1170 $self->information("'$values[1]' was used as a template modifier.");
1172 if ($check && !defined $atemp->{$values[1]}) {
1173 $name = $values[1] if (!defined $name);
1174 if ($name =~ s/.*:://) {
1175 my $value = $self->get_assignment($name);
1176 ## Regardless of whether there was and assignment value, we need to
1177 ## look at the template value of the base so that modification of a
1178 ## scoped variable includes the base values.
1179 if (defined $atemp->{$name}) {
1180 foreach my $arr (@{$atemp->{$name}}) {
1181 my @copy = @$arr;
1182 push(@{$atemp->{$values[1]}}, \@copy);
1185 unshift(@{$atemp->{$values[1]}},
1186 [0, $value, undef, $name]) if (defined $value);
1190 ## Subsitute all pseudo variables for the project specific characters.
1191 $values[2] = $self->replace_parameters($values[2], $self->{'command_subs'})
1192 if (index($values[2], '<%') >= 0);
1194 if (defined $atemp->{$values[1]}) {
1195 ## If there are template variable settings, then we need to add
1196 ## this new one to the end of the settings that did not come from
1197 ## the command line. That way, adjust_value() does not need to
1198 ## sort the values (and have knowledge about which came from the
1199 ## command line and which didn't).
1200 my $max = scalar(@{$atemp->{$values[1]}});
1201 for(my $i = 0; $i < $max; $i++) {
1202 if ($atemp->{$values[1]}->[$i]->[2]) {
1203 splice(@{$atemp->{$values[1]}}, $i, 0,
1204 [$values[0], $values[2], undef, $name]);
1205 return;
1209 else {
1210 $atemp->{$values[1]} = [];
1213 ## If the variable name is not scoped, we need to look through existing
1214 ## scoped variables that match the base. If we find one, we need to
1215 ## propagate this value into the scoped settings.
1216 if (index($values[1], '::') == -1) {
1217 $name = $values[1] if (!defined $name);
1218 foreach my $key (keys %$atemp) {
1219 if ($key ne $name) {
1220 foreach my $entry (@{$atemp->{$key}}) {
1221 if (defined $$entry[3] && $$entry[3] eq $name) {
1222 push(@{$atemp->{$key}}, [$values[0], $values[2], undef, $name]);
1223 last;
1230 ## 0: (0 set, 1 add, -1 subtract)
1231 ## 1: The text value
1232 ## 2: (true set on command line, false set in project)
1233 ## 3: The original variable name if it's scoped or mapped
1234 push(@{$atemp->{$values[1]}}, [$values[0], $values[2], undef, $name]);
1238 sub handle_unknown_assignment {
1239 my $self = shift;
1240 my $type = shift;
1241 my @values = @_;
1243 ## Unknown assignments within a 'specific' section are handled as
1244 ## template value modifications. These are handled exactly as the
1245 ## -value_template option in Options.pm.
1247 ## If $type is not defined, then we are skipping this section
1248 $self->update_template_variable(1, @values) if (defined $type);
1250 return 1, undef;
1254 sub handle_scoped_unknown {
1255 my($self, $fh, $type, $flags, $line) = @_;
1257 if (defined $type && $self->{'parsing_expand'}) {
1258 if ($type eq $self->get_default_component_name()) {
1259 return 0, 'Can not set expansion in this context';
1261 else {
1262 if (!defined $self->{'expanded'}->{$type}) {
1263 my $undef = $self->replace_env_vars(\$line);
1264 if (!$undef) {
1265 ## This is a special concession for Windows. It will not allow
1266 ## you to set an empty environment variable. If an empty
1267 ## double quoted string is found, we will assume that the user
1268 ## wanted an empty string.
1269 $line = '' if ($line eq '""');
1271 $self->{'expanded'}->{$type} = $line;
1274 return 1, undef;
1278 ## If the type is not defined, then this is something other than an
1279 ## assignment in a 'specific' section and should be flagged as an error
1280 return 0, "Unrecognized line: $line";
1283 sub add_custom_depend {
1284 my($self, $tag, $key, $aref) = @_;
1286 my @deps = @$aref;
1287 if ($self->{'convert_slashes'}) {
1288 foreach my $dep (@deps) {
1289 $dep =~ s/\//\\/g;
1293 $self->{'custom_special_depend'}->{$tag}->{$key} = []
1294 unless defined $self->{'custom_special_depend'}->{$tag}->{$key};
1295 StringProcessor::merge($self->{'custom_special_depend'}->{$tag}->{$key},
1296 \@deps);
1299 sub process_component_line {
1300 my($self, $tag, $line, $fh, $flags,
1301 $grname, $current, $excarr, $comps, $count) = @_;
1302 my $status = 1;
1303 my $error;
1304 my %exclude;
1305 my @values;
1307 ## If this returns true, then we've found an assignment
1308 if ($self->parse_assignment($line, \@values, $fh)) {
1309 $status = $self->parse_scoped_assignment($tag, @values, $flags);
1310 if (!$status) {
1311 $error = 'Unknown keyword: ' . $values[1];
1314 else {
1315 ## If we successfully remove a '!' from the front, then
1316 ## the file(s) listed are to be excluded
1317 my $rem = ($line =~ s/^\^\s*//);
1318 my $exc = $rem || ($line =~ s/^!\s*//);
1320 ## Convert any $(...) in this line before we process any
1321 ## wild card characters. If we do not, scoped assignments will
1322 ## not work nor will we get the correct wild carded file list.
1323 ## We also need to make sure that any back slashes are converted to
1324 ## slashes to ensure that later flag_overrides checks will happen
1325 ## correctly.
1326 $line = $self->relative($line);
1327 $line =~ s/\\/\//g if ($self->{'convert_slashes'});
1329 ## Now look for specially listed files.
1330 ## Regular expressions are very slow. Searching the line twice with
1331 ## index() is 328 times faster than searching with just the regular
1332 ## expression when it doesn't match (which is likely to be the case).
1333 if ((index($line, '>>') >= 0 || index($line, '<<') >= 0) &&
1334 $line =~ /(.*)\s+(>>|<<)\s+(.*)/) {
1335 $line = $1;
1336 my $oop = $2;
1337 my $iop = ($oop eq '>>' ? '<<' : '>>');
1338 my $out = ($oop eq '>>' ? $3 : undef);
1339 my $dep = ($oop eq '<<' ? $3 : undef);
1341 $line =~ s/\s+$//;
1342 if (index($line, $iop) >= 0 && $line =~ /(.*)\s+$iop\s+(.*)/) {
1343 $line = $1;
1344 $out = $2 if ($iop eq '>>');
1345 $dep = $2 if ($iop eq '<<');
1346 $line =~ s/\s+$//;
1349 ## Check for both possible error conditions
1350 if (index($line, $oop) >= 0) {
1351 $status = 0;
1352 $error = "Duplicate $oop used";
1354 elsif (index($line, $iop) >= 0) {
1355 $status = 0;
1356 $error = "Duplicate $iop used";
1359 ## Keys used internally to MPC need to be in forward slash format.
1360 my $key = $line;
1361 $key =~ s/\\/\//g if ($self->{'convert_slashes'});
1362 if (defined $out) {
1363 if (!defined $self->{'custom_special_output'}->{$tag}) {
1364 $self->{'custom_special_output'}->{$tag} = {};
1366 ## We can not convert slashes here as we do for dependencies
1367 ## (below). The files specified here need to retain the forward
1368 ## slashes as they are used elsewhere.
1369 $self->{'custom_special_output'}->{$tag}->{$key} = $self->create_array($out);
1371 if (defined $dep) {
1372 $self->add_custom_depend($tag, $key, $self->create_array($dep));
1376 ## If there is a command helper, we need to add the output files
1377 ## here. It is possible that helper determined output files are
1378 ## the only files added by this component type.
1379 my $cmdHelper = $self->find_command_helper($tag);
1380 if (defined $cmdHelper) {
1381 my $key = $line;
1382 $key =~ s/\\/\//g if ($self->{'convert_slashes'});
1383 my $cmdflags = $$flags{'commandflags'};
1384 my($add_out, $deps) = $cmdHelper->get_output($key, $cmdflags);
1386 push(@{$self->{'custom_special_output'}->{$tag}->{$key}}, @$add_out);
1387 foreach my $depTag (keys %$deps) {
1388 foreach my $depFile (keys %{$deps->{$depTag}}) {
1389 $self->add_custom_depend($depTag, $depFile,
1390 $deps->{$depTag}->{$depFile});
1395 ## Set up the files array. If the line contains a wild card
1396 ## character use CORE::glob() to get the files specified.
1397 my @files;
1398 if ($line =~ /^"([^"]+)"$/) {
1399 push(@files, $1);
1401 ## Don't glob the line if we're wanting to remove the file. Wait
1402 ## until later to do the wildcard expansion (in remove_excluded).
1403 elsif (!$rem && $line =~ /[\?\*\[\]]/) {
1404 @files = $self->mpc_glob($line);
1406 else {
1407 push(@files, $line);
1410 ## If we want to remove these files at the end too, then
1411 ## add them to our remove_files hash array.
1412 if ($rem) {
1413 if (!defined $self->{'remove_files'}->{$tag}) {
1414 $self->{'remove_files'}->{$tag} = {};
1416 foreach my $file (@files) {
1417 $self->{'remove_files'}->{$tag}->{$file} = 1;
1421 ## If we're excluding these files, then put them in the hash
1422 if ($exc) {
1423 $$grname = $current;
1424 @exclude{@files} = (@files);
1425 push(@$excarr, @files);
1427 else {
1428 ## Set the flag overrides for each file
1429 my $over = $self->{'flag_overrides'}->{$tag};
1430 if (defined $over) {
1431 foreach my $file (@files) {
1432 $$over{$file} = $flags;
1436 foreach my $file (@files) {
1437 ## Add the file if we're not excluding it
1438 push(@{$$comps{$current}}, $file) if (!defined $exclude{$file});
1440 ## The user listed a file explicitly, whether we
1441 ## excluded it or not.
1442 ++$$count;
1447 return $status, $error;
1451 sub parse_conditional {
1452 my($self, $fh, $types, $tag, $flags,
1453 $grname, $current, $exclude, $comps, $count) = @_;
1454 my $status = 1;
1455 my $error;
1456 my $type = $self->matches_specific_scope($types);
1457 my $add = (defined $type ? 1 : 0);
1459 while(<$fh>) {
1460 my $line = $self->preprocess_line($fh, $_);
1462 if ($line eq '') {
1464 elsif ($line =~ /^}\s*else\s*{$/) {
1465 $add ^= 1;
1467 elsif ($line =~ /^}$/) {
1468 last;
1470 elsif ($add) {
1471 ($status, $error) = $self->process_component_line(
1472 $tag, $line, $fh, $flags,
1473 $grname, $current,
1474 $exclude, $comps, $count);
1475 last if (!$status);
1479 return $status, $error;
1482 sub parse_components {
1483 my($self, $fh, $tag, $name) = @_;
1484 my $current = $defgroup;
1485 my $status = 1;
1486 my $error;
1487 my $names = {};
1488 my $comps = {};
1489 my $set;
1490 my %flags;
1491 my @exclude;
1492 my $custom = defined $self->{'generated_exts'}->{$tag};
1493 my $grtag = $grouped_key . $tag;
1494 my $grname;
1496 if ($custom) {
1497 ## For the custom scoped assignments, we want to put a copy of
1498 ## the original custom defined values in our flags associative array.
1499 foreach my $key (keys %custom) {
1500 if (defined $self->{'generated_exts'}->{$tag}->{$key}) {
1501 $flags{$key} = $self->{'generated_exts'}->{$tag}->{$key};
1506 if (defined $self->{$tag}) {
1507 $names = $self->{$tag};
1509 else {
1510 $self->{$tag} = $names;
1512 if (defined $$names{$name}) {
1513 $comps = $$names{$name};
1515 else {
1516 $$names{$name} = $comps;
1518 $$comps{$current} = [] if (!defined $$comps{$current});
1520 # preserve order
1521 #tie %$names, "Tie::IxHash";
1522 #tie %$comps, "Tie::IxHash";
1524 my $count = 0;
1525 while(<$fh>) {
1526 my $line = $self->preprocess_line($fh, $_);
1528 if ($line eq '') {
1530 elsif ($line =~ /^(\w+)\s*{$/) {
1531 if (!$set) {
1532 $current = $1;
1533 $set = 1;
1534 $$comps{$current} = [] if (!defined $$comps{$current});
1536 else {
1537 $status = 0;
1538 $error = 'Can not nest groups';
1539 last;
1542 elsif ($line =~ /^conditional\s*(\(([^\)]+)\))\s*{$/) {
1543 ($status, $error) = $self->parse_conditional(
1544 $fh, $2, $tag, \%flags, \$grname,
1545 $current, \@exclude, $comps,
1546 \$count);
1547 last if (!$status);
1549 elsif ($line =~ /^}$/) {
1550 if (!defined $$comps{$current}->[0] && !defined $exclude[0]) {
1551 ## The default components name was never used
1552 ## so we remove it from the components
1553 delete $$comps{$current};
1555 ## For custom_only projects, an empty section is functionally
1556 ## equivalent to not defining it at all.
1557 $self->{'defaulted'}->{$tag} = 1
1558 if (!defined $self->{'defaulted'}->{$tag} &&
1559 $self->get_assignment('custom_only'));
1561 else {
1562 ## It was used, so we need to add that name to
1563 ## the set of group names unless it's already been added.
1564 $self->process_assignment_add($grtag, $current);
1566 ## Define the defaulted section value so that if a following
1567 ## empty section of the same type is found, it will not cause the
1568 ## defaulted value to be overwritten.
1569 $self->{'defaulted'}->{$tag} = 0;
1571 if ($set) {
1572 $current = $defgroup;
1573 $set = undef;
1575 else {
1576 ## We are at the end of a component. If the only group
1577 ## we added was the default group, then we need to remove
1578 ## the group setting altogether.
1579 my $groups = $self->get_assignment($grtag);
1580 if (defined $groups) {
1581 my $grarray = $self->create_array($groups);
1582 if (scalar(@$grarray) == 1 && $$grarray[0] eq $defgroup) {
1583 $self->process_assignment($grtag, undef);
1587 ## This is not an error,
1588 ## this is the end of the components
1589 last;
1592 else {
1593 ($status, $error) = $self->process_component_line($tag, $line, $fh, \%flags,
1594 \$grname, $current,
1595 \@exclude, $comps,
1596 \$count);
1597 last if (!$status);
1601 ## If this is a "special" component, we need to see if the
1602 ## user provided all directories. If they have, then we need to
1603 ## store an array of directories that the user supplied. Otherwise,
1604 ## we just store a 1.
1605 if (defined $specialComponents{$tag}) {
1606 my @dirs;
1607 foreach my $name (keys %$names) {
1608 my $comps = $$names{$name};
1609 foreach my $comp (keys %$comps) {
1610 foreach my $item (@{$$comps{$comp}}) {
1611 if (-d $item) {
1612 push(@dirs, $item);
1614 else {
1615 @dirs = ();
1616 last;
1621 if (defined $dirs[0]) {
1622 $self->{'special_supplied'}->{$tag} = \@dirs;
1624 else {
1625 $self->{'special_supplied'}->{$tag} = 1;
1629 ## If we didn't encounter an error, didn't have any files explicitly
1630 ## listed and we attempted to exclude files, then we need to find the
1631 ## set of files that don't match the excluded files and add them.
1632 if ($status && defined $exclude[0] && defined $grname) {
1633 my $alldir = $self->get_assignment('recurse') || $flags{'recurse'};
1634 my %checked;
1635 my @files;
1636 foreach my $exc (@exclude) {
1637 my $dname = $self->mpc_dirname($exc);
1638 if (!defined $checked{$dname}) {
1639 $checked{$dname} = 1;
1640 push(@files, $self->generate_default_file_list($dname,
1641 \@exclude,
1642 undef, $alldir));
1646 $self->sift_files(\@files,
1647 $self->{'valid_components'}->{$tag},
1648 $self->get_assignment('pch_header'),
1649 $self->get_assignment('pch_source'),
1650 $tag,
1651 $$comps{$grname});
1654 return $status, $error;
1658 sub parse_verbatim {
1659 my($self, $fh, $type, $loc, $add) = @_;
1661 if (!defined $loc) {
1662 return 0, 'You must provide a location parameter to verbatim';
1665 ## All types are lower case
1666 $type = lc($type);
1668 if (!defined $self->{'verbatim'}->{$type}) {
1669 $self->{'verbatim'}->{$type} = {};
1672 ## Instead of always creating a new array for a particular type and
1673 ## location, create a new array if there isn't one already or the user
1674 ## does not want to add to the existing verbatim settings.
1675 $self->{'verbatim'}->{$type}->{$loc} = []
1676 if (!$add || !defined $self->{'verbatim'}->{$type}->{$loc});
1677 my $array = $self->{'verbatim'}->{$type}->{$loc};
1679 while(<$fh>) {
1680 my $line = $self->preprocess_line($fh, $_);
1682 ## This is not an error,
1683 ## this is the end of the verbatim
1684 last if ($line =~ /^}$/);
1685 push(@$array, $line);
1688 return 1, undef;
1692 sub process_feature {
1693 my($self, $fh, $names, $parents) = @_;
1694 my $status = 1;
1695 my $error;
1697 my $requires = '';
1698 my $avoids = '';
1699 foreach my $name (@$names) {
1700 if ($name =~ /^!\s*(.*)$/) {
1701 $avoids .= ' ' if ($avoids ne '');
1702 $avoids .= $1;
1704 else {
1705 $requires .= ' ' if ($requires ne '');
1706 $requires .= $name;
1710 if ($self->check_features($requires, $avoids)) {
1711 ## The required features are enabled, so we say that
1712 ## a project has been defined and we allow the parser to
1713 ## find the data held within the feature.
1714 ($status, $error) = $self->begin_project($parents);
1715 if ($status) {
1716 $self->{'feature_defined'} = 0;
1717 $self->{$self->{'type_check'}} = 1;
1720 else {
1721 ## Otherwise, we read in all the lines until we find the
1722 ## closing brace for the feature and it appears to the parser
1723 ## that nothing was defined.
1724 my $curly = 1;
1725 while(<$fh>) {
1726 my $line = $self->preprocess_line($fh, $_);
1728 ## This is a very simplistic way of finding the end of
1729 ## the feature definition. It will work as long as no spurious
1730 ## open curly braces are counted.
1731 ++$curly if ($line =~ /{$/);
1732 --$curly if ($line =~ /^}/);
1734 if ($curly == 0) {
1735 $self->{'feature_defined'} = 0;
1736 last;
1741 return $status, $error;
1745 sub process_array_assignment {
1746 my($self, $aref, $type, $array) = @_;
1748 if (!defined $$aref || $type == 0) {
1749 if ($type != -1) {
1750 $$aref = $array;
1753 else {
1754 if ($type == 1) {
1755 push(@{$$aref}, @$array);
1757 elsif ($type == -1) {
1758 my $count = scalar(@{$$aref});
1759 for(my $i = 0; $i < $count; ++$i) {
1760 if (StringProcessor::fgrep($$aref->[$i], $array)) {
1761 splice(@{$$aref}, $i, 1);
1762 --$i;
1763 --$count;
1771 sub parse_define_custom {
1772 my($self, $fh, $tag, $modify, $parentsRef) = @_;
1774 ## Make the tag something _files
1775 $tag = lc($tag) . '_files';
1777 ## We can not have a custom type named "generic"
1778 return 0, "$tag is reserved" if ($tag eq $generic_key);
1780 if (defined $self->{'valid_components'}->{$tag}) {
1781 if (!$modify) {
1782 return 0, "$tag has already been defined";
1785 elsif ($modify) {
1786 return 0, "$tag has not yet been defined and can not be modified";
1789 if (defined $parentsRef && @$parentsRef > 0) {
1790 if (@$parentsRef > 1) {
1791 return 0, "$tag: multiple inheritance is not allowed";
1793 my $parent = lc($$parentsRef[0]) . '_files';
1794 if (!defined $self->{'valid_components'}->{$parent}) {
1795 return 0, "$parent is not a valid custom file type";
1797 for my $k ('matching_assignments', 'generated_exts', 'valid_components') {
1798 $self->{$k}->{$tag} = $self->clone($self->{$k}->{$parent});
1800 $self->{'define_custom_parent'}->{$tag} = $parent;
1803 my $status = 0;
1804 my $errorString = "Unable to process $tag";
1806 ## Update the custom_types assignment
1807 $self->process_assignment_add('custom_types', $tag) if (!$modify);
1809 if (!defined $self->{'matching_assignments'}->{$tag}) {
1810 my @keys = keys %custom;
1811 push(@keys, @default_matching_assignments);
1812 $self->{'matching_assignments'}->{$tag} = \@keys;
1815 my $optname;
1816 my $inscope = 0;
1817 while(<$fh>) {
1818 my $line = $self->preprocess_line($fh, $_);
1820 if ($line eq '') {
1822 elsif ($line =~ /optional\s*\(([^\)]+)\)\s*{/) {
1823 $optname = $1;
1824 $optname =~ s/^\s+//;
1825 $optname =~ s/\s+$//;
1826 if (defined $customDefined{$optname} &&
1827 ($customDefined{$optname} & 0x08) != 0) {
1828 ++$inscope;
1829 if ($inscope != 1) {
1830 $status = 0;
1831 $errorString = 'Can not nest \'optional\' sections';
1832 last;
1835 else {
1836 $status = 0;
1837 $errorString = "Invalid optional name: $optname";
1838 last;
1841 elsif ($inscope) {
1842 if ($line =~ /^}$/) {
1843 $optname = undef;
1844 --$inscope;
1846 else {
1847 if ($line =~ /(\w+)\s*\(([^\)]+)\)\s*(\+)?=\s*(.*)/) {
1848 my $name = lc($1);
1849 my $opt = $2;
1850 my $add = $3;
1851 my @val = split(/\s*,\s*/, $4);
1853 ## Fix $opt spacing
1854 $opt =~ s/(\&\&|\|\|)/ $1 /g;
1855 $opt =~ s/!\s+/!/g;
1857 ## Set up the 'optional' hash table
1858 if (!$add || !defined $self->{'generated_exts'}->{$tag}->
1859 {'optional'}->{$optname}->{$name}->{$opt}) {
1860 $self->{'generated_exts'}->{$tag}->
1861 {'optional'}->{$optname}->{$name}->{$opt} = \@val;
1863 else {
1864 push(@{$self->{'generated_exts'}->{$tag}->{'optional'}->
1865 {$optname}->{$name}->{$opt}}, @val);
1868 else {
1869 $status = 0;
1870 $errorString = "Unrecognized optional line: $line";
1871 last;
1875 elsif ($line =~ /^}$/) {
1876 $status = 1;
1877 $errorString = undef;
1879 ## Propagate the custom defined values into the mapped values
1880 foreach my $key (keys %{$self->{'valid_names'}}) {
1881 if (UNIVERSAL::isa($self->{'valid_names'}->{$key}, 'ARRAY')) {
1882 my $value = $self->{'generated_exts'}->{$tag}->{
1883 $self->{'valid_names'}->{$key}->[1]};
1885 ## Bypass the process_assignment() defined in this class
1886 ## to avoid unwanted keyword mapping.
1887 $self->SUPER::process_assignment($key, $value) if (defined $value);
1891 ## Set some defaults (if they haven't already been set)
1892 if (!defined $self->{'generated_exts'}->{$tag}->{'pre_filename'}) {
1893 $self->{'generated_exts'}->{$tag}->{'pre_filename'} = [ '' ];
1895 if (!defined $self->{'generated_exts'}->{$tag}->{'pre_dirname'}) {
1896 $self->{'generated_exts'}->{$tag}->{'pre_dirname'} = [ '' ];
1898 if (!defined $self->{'generated_exts'}->{$tag}->{'pre_extension'}) {
1899 $self->{'generated_exts'}->{$tag}->{'pre_extension'} = [ '' ];
1901 if (!defined $self->{'generated_exts'}->{$tag}->{'automatic_in'}) {
1902 $self->{'generated_exts'}->{$tag}->{'automatic_in'} = 1;
1904 if (!defined $self->{'generated_exts'}->{$tag}->{'automatic_out'}) {
1905 $self->{'generated_exts'}->{$tag}->{'automatic_out'} = 1;
1907 if (!defined $self->{'generated_exts'}->{$tag}->{'output_follows_input'}) {
1908 $self->{'generated_exts'}->{$tag}->{'output_follows_input'} = 1;
1910 if (!defined $self->{'valid_components'}->{$tag}) {
1911 $self->{'valid_components'}->{$tag} = [];
1913 last;
1915 else {
1916 my @values;
1917 ## If this returns true, then we've found an assignment
1918 if ($self->parse_assignment($line, \@values, $fh)) {
1919 my($type, $name, $value) = @values;
1920 ## The 'automatic' keyword has always contained two distinct
1921 ## functions. The first is to automatically add input files of
1922 ## the specified extension. And the second is to automatically
1923 ## add generated files to the right components. It has now been
1924 ## split into separate functionality and we map the 'automatic'
1925 ## keyword to the two new ones here.
1926 my $ok = 1;
1927 my @names = $name eq 'automatic' ?
1928 ('automatic_in', 'automatic_out') : $name;
1929 foreach $name (@names) {
1930 if (defined $customDefined{$name}) {
1931 if (($customDefined{$name} & 0x01) != 0) {
1932 $value = $self->escape_regex_special($value);
1933 my @array = split(/\s*,\s*/, $value);
1934 $self->process_array_assignment(
1935 \$self->{'valid_components'}->{$tag}, $type, \@array);
1937 else {
1938 if (!defined $self->{'generated_exts'}->{$tag}) {
1939 $self->{'generated_exts'}->{$tag} = {};
1941 ## Try to convert the value into a relative path
1942 $value = $self->relative($value);
1944 if (($customDefined{$name} & 0x04) != 0) {
1945 if ($type == 0) {
1946 $self->process_assignment(
1947 $name, $value,
1948 $self->{'generated_exts'}->{$tag});
1950 elsif ($type == 1) {
1951 $self->process_assignment_add(
1952 $name, $value,
1953 $self->{'generated_exts'}->{$tag});
1955 elsif ($type == -1) {
1956 $self->process_assignment_sub(
1957 $name, $value,
1958 $self->{'generated_exts'}->{$tag});
1961 else {
1962 if (($customDefined{$name} & 0x02) != 0) {
1963 ## Transform the name from something outputext to
1964 ## something files. We expect this to match the
1965 ## names of valid_assignments.
1966 $name =~ s/outputext/files/g;
1969 ## Get it ready for regular expressions
1970 $value = $self->escape_regex_special($value);
1972 ## Split the value into an array using a comma as the
1973 ## separator. If there are no elements in the array we're
1974 ## going to add an empty element to the array. This way,
1975 ## assignments of blank values are useful.
1976 my @array = split(/\s*,\s*/, $value);
1977 push(@array, '') if ($#array == -1);
1979 ## Process the array assignment after adjusting the values
1980 $self->process_array_assignment(
1981 \$self->{'generated_exts'}->{$tag}->{$name},
1982 $type, \@array);
1986 else {
1987 $ok = 0;
1988 $status = 0;
1989 $errorString = "Invalid assignment name: '$name'";
1990 last;
1994 ## $status is zero until the end of the define custom block, so
1995 ## we can't use it for this check.
1996 last if (!$ok);
1998 elsif ($line =~ /^keyword\s+(\w+)(?:\s*=\s*(\w+)?)?/) {
1999 ## Check for keyword mapping here
2000 my $newkey = $1;
2001 my $mapkey = $2;
2002 if (defined $self->{'valid_names'}->{$newkey}) {
2003 $status = 0;
2004 $errorString = "Cannot map $newkey onto an " .
2005 "existing keyword";
2006 last;
2008 elsif (!defined $mapkey) {
2009 $self->{'valid_names'}->{$newkey} = 1;
2011 elsif ($newkey ne $mapkey) {
2012 if (defined $customDefined{$mapkey}) {
2013 $self->{'valid_names'}->{$newkey} = [ $tag, $mapkey ];
2015 else {
2016 $status = 0;
2017 $errorString = "Cannot map $newkey to an " .
2018 "undefined custom keyword: $mapkey";
2019 last;
2022 else {
2023 $status = 0;
2024 $errorString = "Cannot map $newkey to $mapkey";
2025 last;
2028 else {
2029 $status = 0;
2030 $errorString = "Unrecognized line: $line";
2031 last;
2036 return $status, $errorString;
2040 sub back_to_variable {
2041 my($self, $values) = @_;
2042 my $cwd = $self->getcwd();
2043 my $case_tolerant = $self->case_insensitive();
2044 my @values = ();
2046 ## Get both of the relative value hash maps and put them in an array
2047 my @rels = ();
2048 my($rel, $how) = $self->get_initial_relative_values();
2049 push(@rels, $rel);
2050 ($rel, $how) = $self->get_secondary_relative_values();
2051 push(@rels, $rel);
2053 ## Go through each value and try to convert it to a variable setting
2054 foreach my $ovalue (@$values) {
2055 ## Fix up the value, replacing '.' with the current working
2056 ## directory.
2057 my $value = $ovalue;
2058 $value =~ s/\\/\//g;
2059 if ($value eq '.') {
2060 $value = $cwd;
2062 else {
2063 $value =~ s/^.\//$cwd\//;
2065 my $valuelen = length($value);
2067 ## Go through each relative value hash map and see if any of the
2068 ## values match the value that we're currently inspecting.
2069 my $found = undef;
2070 foreach my $rel (@rels) {
2071 foreach my $key (keys %$rel) {
2072 ## Get the relative replacement value and convert back-slashes
2073 my $val = $$rel{$key};
2074 $val =~ s/\\/\//g;
2076 ## We only need to check for reverse replacement if the length
2077 ## of the value is greater than or equal to the length of our
2078 ## replacement value.
2079 my $vlen = length($val);
2080 if ($valuelen >= $vlen) {
2081 ## Cut the string down by the length of the replacement value
2082 my $lval = substr($value, 0, $vlen);
2084 ## Check for equivalence, taking into account file system
2085 ## case-insenitivity.
2086 if ($case_tolerant) {
2087 $found = (lc($lval) eq lc($val));
2089 else {
2090 $found = ($lval eq $val);
2093 ## If they match, replace the value and save it in our array.
2094 if ($found) {
2095 substr($value, 0, length($val)) = "\$($key)";
2096 push(@values, $value);
2097 last;
2102 ## Once it's been found, there's no reason to continue on through
2103 ## the relative hash maps.
2104 last if ($found);
2107 push(@values, $ovalue) if (!$found);
2110 return @values;
2114 sub remove_duplicate_addition {
2115 my($self, $name, $value, $nval) = @_;
2117 if (defined $nval) {
2118 ## If we are modifying the libs, libpaths, macros or includes
2119 ## assignment with either addition or subtraction, we are going to
2120 ## perform a little fix on the value to avoid multiple
2121 ## libraries and to try to insure the correct linking order
2122 if ($name eq 'macros' || $name eq 'libpaths' ||
2123 $name eq 'includes' || $name =~ /libs$/ ||
2124 index($name, $grouped_key) == 0) {
2125 my $allowed = '';
2126 my %parts;
2128 ## Convert the array into keys for a hash table
2129 @parts{@{$self->create_array($nval)}} = ();
2131 ## In order to ensure that duplicates are correctly removed, we
2132 ## need to get the modified assignment value before we attempt to
2133 ## do so.
2134 $value = $self->modify_assignment_value($name, $value);
2135 foreach my $val (@{$self->create_array($value)}) {
2136 if (!exists $parts{$val}) {
2137 ## We need to supply quotes if there is a space in the value or
2138 ## a variable. The variable may contain spaces.
2139 if ($val =~ /\s/ || $val =~ /\$\(.+\)/) {
2140 ## If we're going to add quotes around this item and the
2141 ## value ends in a backslash we need to append another
2142 ## backslash so that when it's used with
2143 ## StringProcessor::create_array() the function will not think
2144 ## that the trailing quote is escaped.
2145 $val .= '\\' if ($val =~ /\\$/);
2146 $allowed .= '"' . $val . '" ';
2148 else {
2149 $allowed .= $val . ' ';
2153 $allowed =~ s/\s+$//;
2154 return $allowed;
2158 return $value;
2162 sub read_template_input {
2163 my($self, $tkey) = @_;
2164 my $status = 1;
2165 my $errorString;
2166 my $file;
2167 my $tag;
2168 my $ti = $self->get_ti_override();
2169 my $lang = $self->get_language();
2170 my $override;
2172 if ($self->exe_target()) {
2173 if ($self->get_static() == 1) {
2174 $tag = 'lib_exe_template_input';
2175 ## Check for the TemplateInputReader for the template key provided.
2176 if (!defined $self->{$tag}->{$lang}->{$tkey}) {
2177 if (defined $$ti{'lib_exe'}) {
2178 $file = $$ti{'lib_exe'};
2179 $override = 1;
2181 else {
2182 $file = $self->get_lib_exe_template_input_file($tkey);
2186 else {
2187 $tag = 'dll_exe_template_input';
2188 ## Check for the TemplateInputReader for the template key provided.
2189 if (!defined $self->{$tag}->{$lang}->{$tkey}) {
2190 if (defined $$ti{'dll_exe'}) {
2191 $file = $$ti{'dll_exe'};
2192 $override = 1;
2194 else {
2195 $file = $self->get_dll_exe_template_input_file($tkey);
2200 else {
2201 if ($self->get_static() == 1) {
2202 $tag = 'lib_template_input';
2203 ## Check for the TemplateInputReader for the template key provided.
2204 if (!defined $self->{$tag}->{$lang}->{$tkey}) {
2205 if (defined $$ti{'lib'}) {
2206 $file = $$ti{'lib'};
2207 $override = 1;
2209 else {
2210 $file = $self->get_lib_template_input_file($tkey);
2214 else {
2215 $tag = 'dll_template_input';
2216 ## Check for the TemplateInputReader for the template key provided.
2217 if (!defined $self->{$tag}->{$lang}->{$tkey}) {
2218 if (defined $$ti{'dll'}) {
2219 $file = $$ti{'dll'};
2220 $override = 1;
2222 else {
2223 $file = $self->get_dll_template_input_file($tkey);
2229 if (defined $self->{$tag}->{$lang}->{$tkey}) {
2230 ## We have a TemplateInputReader for this template key, so we need
2231 ## to set the entry corresponding to $tikey to it for use in the
2232 ## get_template_input() method.
2233 $self->{$tag}->{$lang}->{$tikey} = $self->{$tag}->{$lang}->{$tkey};
2235 else {
2236 ## We haven't read this file yet, so we will create the template
2237 ## input reader and store it in the entry for the template key
2238 ## ($tkey) and the template input key ($tikey).
2239 my $ti = new TemplateInputReader($self->get_include_path());
2240 $self->{$tag}->{$lang}->{$tkey} = $ti;
2241 $self->{$tag}->{$lang}->{$tikey} = $ti;
2243 ## Process the template input file
2244 if (defined $file) {
2245 my $tfile = $self->search_include_path("$file.$TemplateInputExtension");
2246 if (defined $tfile) {
2247 ($status, $errorString) = $ti->read_file($tfile);
2249 else {
2250 ## Not finding a template input file is only an error if the user
2251 ## specifically provided a template input file override.
2252 if ($override) {
2253 $status = 0;
2254 $errorString = "Unable to locate template input file: $file";
2259 ## Now that we've read in the template input file, set up our
2260 ## automatic template variables.
2261 if ($self->{'make_coexistence'}) {
2262 $ti->parse_line(undef,
2263 "make_coexistence = $self->{'make_coexistence'}");
2267 ## We do this regardless of whether or not this parser is cached or
2268 ## not. If the features have changed (through a workspace cmdline
2269 ## setting), we need to reflect it.
2270 if ($status) {
2271 ## Put the features into the template input set
2272 my $features = $self->{'feature_parser'}->get_names();
2273 $self->{$tag}->{$lang}->{$tikey}->parse_line(undef,
2274 "features = @$features");
2277 return $status, $errorString;
2281 sub already_added {
2282 my($self, $array, $name) = @_;
2283 my $case_tolerant = $self->case_insensitive();
2285 ## This method expects that the file name will be unix style
2286 $name =~ s/\\/\//g if ($self->{'convert_slashes'});
2288 ## Remove the leading ./
2289 $name =~ s/^\.\///;
2290 my $dsname = "./$name";
2292 ## Take into account file system case-insenitivity.
2293 if ($case_tolerant) {
2294 $name = lc($name);
2295 $dsname = lc($dsname);
2298 foreach my $file (@$array) {
2299 my $my_file = ($case_tolerant ? lc($file) : $file);
2301 return 1 if ($my_file eq $name || $my_file eq $dsname);
2304 return 0;
2308 sub get_applied_custom_keyword {
2309 my($self, $name, $type, $file) = @_;
2311 if (defined $self->{'flag_overrides'}->{$type} &&
2312 defined $self->{'flag_overrides'}->{$type}->{$file} &&
2313 defined $self->{'flag_overrides'}->{$type}->{$file}->{$name}) {
2314 return $self->relative(
2315 $self->{'flag_overrides'}->{$type}->{$file}->{$name}, 1);
2318 return $self->relative($self->get_assignment(
2319 $name,
2320 $self->{'generated_exts'}->{$type}), 1);
2324 sub evaluate_optional_option {
2325 my($self, $opt, $value) = @_;
2327 if ($opt =~ /^!\s*(.*)/) {
2328 return (!exists $$value{$1} ? 1 : 0);
2330 else {
2331 return (exists $$value{$opt} ? 1 : 0);
2336 sub process_optional_option {
2337 my($self, $opt, $value) = @_;
2338 my $status;
2339 my @parts = grep(!/^$/, split(/\s+/, $opt));
2340 my $pcount = scalar(@parts);
2342 for(my $i = 0; $i < $pcount; $i++) {
2343 if ($parts[$i] eq '&&' || $parts[$i] eq '||') {
2344 if (defined $status) {
2345 if (defined $parts[$i + 1]) {
2346 if ($parts[$i] eq '&&') {
2347 $status &&= $self->evaluate_optional_option($parts[$i + 1],
2348 $value);
2350 else {
2351 ## We are coming into an '||', if status is already true
2352 ## then we can leave immediately
2353 last if ($status);
2355 $status ||= $self->evaluate_optional_option($parts[$i + 1],
2356 $value);
2359 else {
2360 $self->warning("Expected token in optional after $parts[$i]");
2363 else {
2364 $self->warning("Unexpected token in optional: $parts[$i]");
2366 ++$i;
2368 else {
2369 if (!defined $status) {
2370 $status = $self->evaluate_optional_option($parts[$i], $value);
2372 else {
2373 $self->warning("Unexpected token in optional: $parts[$i]");
2378 return $status;
2382 sub add_optional_filename_portion {
2383 my($self, $gentype, $tag, $file, $array) = @_;
2385 if (defined $self->{'generated_exts'}->{$gentype}->{'optional'}->{$tag}) {
2386 foreach my $name (keys %{$self->{'generated_exts'}->{$gentype}->{'optional'}->{$tag}}) {
2387 foreach my $opt (keys %{$self->{'generated_exts'}->{$gentype}->{'optional'}->{$tag}->{$name}}) {
2388 ## Get the name value
2389 my $value = $self->get_applied_custom_keyword($name,
2390 $gentype, $file);
2392 ## Convert the value into a hash map for easy lookup
2393 my %values;
2394 @values{split(/\s+/, $value)} = () if (defined $value);
2396 ## See if the option or options are contained in the value. We
2397 ## need to call this even if $value is not defined due to the
2398 ## ability to negate optional parameters.
2399 if ($self->process_optional_option($opt, \%values)) {
2400 ## Add the optional portion
2401 push(@$array, @{$self->{'generated_exts'}->{$gentype}->{'optional'}->{$tag}->{$name}->{$opt}});
2409 sub get_pre_keyword_array {
2410 my($self, $keyword, $gentype, $tag, $file) = @_;
2412 ## Get the general pre extension array.
2413 ## $self->{'generated_exts'}->{$gentype}->{$keyword} is guaranteed to
2414 ## be defined due to the defaulting that is done in
2415 ## parse_define_custom() and the only three calls to this method use
2416 ## valid $keyword values.
2417 my @array = @{$self->{'generated_exts'}->{$gentype}->{$keyword}};
2419 ## Add the component specific pre extension array
2420 my @additional;
2421 $tag =~ s/files$/$keyword/;
2422 if (defined $self->{'generated_exts'}->{$gentype}->{$tag}) {
2423 push(@additional, @{$self->{'generated_exts'}->{$gentype}->{$tag}});
2426 ## Add in any optional portion to the array
2427 foreach my $itag ($keyword, $tag) {
2428 $self->add_optional_filename_portion($gentype, $itag,
2429 $file, \@additional);
2432 ## If the current array only has the default,
2433 ## then we need to remove it
2434 if (defined $additional[0]) {
2435 if ($#array == 0 && $array[0] eq '') {
2436 pop(@array);
2438 push(@array, @additional);
2441 return @array;
2445 sub add_explicit_output {
2446 my($self, $file, $type, $tag, $array, $arrs) = @_;
2448 if (defined $self->{'custom_special_output'}->{$type} &&
2449 defined $self->{'custom_special_output'}->{$type}->{$file}) {
2450 if (defined $self->{'valid_components'}->{$tag}) {
2451 my @files;
2452 foreach my $check (@{$self->{'custom_special_output'}->{$type}->{$file}}) {
2453 foreach my $regext (@{$self->{'valid_components'}->{$tag}}) {
2454 if ($check =~ /$regext$/) {
2455 my $add = 1;
2456 if ($tag eq 'source_files') {
2457 foreach my $tregext (@{$self->{'valid_components'}->{'template_files'}}) {
2458 if ($check =~ /$tregext$/) {
2459 $add = undef;
2460 last;
2464 if ($add) {
2465 ## If gendir was specified, then we need to account for that
2466 my $dir = '';
2467 if (defined $self->{'flag_overrides'}->{$type} &&
2468 defined $self->{'flag_overrides'}->{$type}->{$file} &&
2469 defined $self->{'flag_overrides'}->{$type}->{$file}->{'gendir'} &&
2470 $self->{'flag_overrides'}->{$type}->{$file}->{'gendir'} ne '.') {
2471 $dir = $self->{'flag_overrides'}->{$type}->{$file}->{'gendir'} . '/';
2472 $dir =~ s/\\/\//g if ($self->{'convert_slashes'});
2475 push(@files, "$dir$check");
2476 last;
2481 if (defined $files[0]) {
2482 if ($arrs) {
2483 push(@$array, \@files);
2485 else {
2486 push(@$array, @files);
2493 sub generated_filenames {
2494 my($self, $part, $type, $tag, $file, $noext, $arrs) = @_;
2496 ## A custom type is not allowed to generate it's own input files
2497 return () if ($type eq $tag);
2499 ## See if the type for which we are generating ($tag) is also a custom
2500 ## file type. If it is, we need to do some massaging.
2501 my $otag = $tag;
2502 if (defined $self->{'generated_exts'}->{$tag}) {
2503 ## If the custom type ($type) doesn't specify that it generates
2504 ## generic files, we need to see if there is a command helper for
2505 ## this type and see what sort of output it knows about.
2506 my $inputexts = $self->{'generated_exts'}->{$type}->{$generic_key};
2507 if (!defined $inputexts) {
2508 my $cmdHelper = $self->find_command_helper($type);
2509 $inputexts = $cmdHelper->get_outputexts() if (defined $cmdHelper);
2512 ## We will need to use 'generic_files' instead of $tag if $tag is
2513 ## defined in 'generated_exts', but only for the type that will
2514 ## actually generate the right type of generic file.
2515 my $good;
2516 if (defined $inputexts) {
2517 foreach my $inputext (@$inputexts) {
2518 my $ext = $inputext;
2519 $ext =~ s/\\//g;
2520 foreach my $extreg (@{$self->{'valid_components'}->{$tag}}) {
2521 if ($ext =~ /$extreg$/) {
2522 $tag = $generic_key;
2523 $good = 1;
2524 last;
2527 last if ($good);
2531 ## If we were not able to find the right file type, then we can get
2532 ## out early. However, if the type for which we are generating
2533 ## ($tag) is a built-in type, we need to continue on as there is a
2534 ## possibility that the input type ($type) will generate files for
2535 ## the generating type.
2536 return () if (!$good &&
2537 !defined $language{$self->get_language()}->[0]->{$tag});
2540 my @pearr = $self->get_pre_keyword_array('pre_extension',
2541 $type, $tag, $file);
2542 my @pfarr = $self->get_pre_keyword_array('pre_filename',
2543 $type, $tag, $file);
2544 my @pdarr = $self->get_pre_keyword_array('pre_dirname',
2545 $type, $tag, $file);
2546 my @exts = (defined $self->{'generated_exts'}->{$type}->{$tag} ?
2547 @{$self->{'generated_exts'}->{$type}->{$tag}} : ());
2549 if (!defined $exts[0]) {
2550 my $backtag = $tag;
2551 if ($backtag =~ s/files$/outputext/) {
2552 $self->add_optional_filename_portion($type, $backtag,
2553 $file, \@exts);
2557 my @array;
2558 if (!defined $exts[0] && $#pearr == 0 && $#pfarr == 0 && $#pdarr == 0 &&
2559 $pearr[0] eq '' && $pfarr[0] eq '' && $pdarr[0] eq '') {
2560 ## If both arrays are defined to be the defaults, then there
2561 ## is nothing for us to do.
2563 else {
2564 my $dir = '';
2565 my $base;
2567 ## Correctly deal with pre filename and directories
2568 if ($part =~ /(.*[\/\\])([^\/\\]+)$/) {
2569 ## Split the directory and base name of the file. Only set the
2570 ## directory if the output follows the input directory.
2571 $dir = $1
2572 if ($self->{'generated_exts'}->{$type}->{'output_follows_input'});
2573 $base = $2;
2575 else {
2576 $base = $part;
2579 ## If gendir was specified, then we need to account for that
2580 if (defined $self->{'flag_overrides'}->{$type} &&
2581 defined $self->{'flag_overrides'}->{$type}->{$file} &&
2582 defined $self->{'flag_overrides'}->{$type}->{$file}->{'gendir'}) {
2583 if ($self->{'flag_overrides'}->{$type}->{$file}->{'gendir'} eq '.') {
2584 $dir = '';
2586 else {
2587 $dir = $self->{'flag_overrides'}->{$type}->{$file}->{'gendir'} . '/';
2588 $dir =~ s/\\/\//g if ($self->{'convert_slashes'});
2592 ## Loop through creating all of the possible file names
2593 foreach my $pe (@pearr) {
2594 my @genfile;
2595 $pe =~ s/\\\././g;
2596 foreach my $pf (@pfarr) {
2597 $pf =~ s/\\\././g;
2598 foreach my $pd (@pdarr) {
2599 if ($noext) {
2600 push(@genfile, "$pd$dir$pf$base$pe");
2602 else {
2603 foreach my $ext (@exts) {
2604 $ext =~ s/\\\././g;
2605 push(@genfile, "$pd$dir$pf$base$pe$ext");
2610 if ($arrs) {
2611 push(@array, \@genfile);
2613 else {
2614 push(@array, @genfile);
2619 ## Now add the explicit output. We need to use the original tag value
2620 ## ($otag) so that we can find the custom output files.
2621 $self->add_explicit_output($file, $type, $otag, \@array, $arrs);
2622 return @array;
2626 sub add_generated_files {
2627 my($self, $gentype, $tag, $group, $arr) = @_;
2629 ## This method is called by list_default_generated. It performs the
2630 ## actual file insertion and grouping.
2631 ## Get the generated filenames
2632 my @added;
2633 foreach my $file (keys %$arr) {
2634 foreach my $gen ($self->generated_filenames($$arr{$file}, $gentype,
2635 $tag, $file, 1)) {
2636 $self->list_generated_file($gentype, $tag, \@added, $gen, $$arr{$file});
2640 if (defined $added[0]) {
2641 my $names = $self->{$tag};
2643 ## Get all files in one list and save the directory
2644 ## and component group in a hashed array.
2645 my @all;
2646 my %dircomp;
2647 foreach my $name (keys %$names) {
2648 foreach my $key (keys %{$$names{$name}}) {
2649 push(@all, @{$$names{$name}->{$key}});
2650 foreach my $file (@{$$names{$name}->{$key}}) {
2651 $dircomp{$self->mpc_dirname($file)} = $key;
2656 ## Create a small array of only the files we want to add.
2657 ## We put them all together so we can keep them in order when
2658 ## we put them at the front of the main file list.
2659 my @oktoadd;
2660 foreach my $file (@added) {
2661 push(@oktoadd, $file) if (!$self->already_added(\@all, $file));
2664 ## If we have files to add, make sure we add them to a group
2665 ## that has the same directory location as the files we're adding.
2666 if (defined $oktoadd[0]) {
2667 my $key = (defined $group ? $group :
2668 $dircomp{$self->mpc_dirname($oktoadd[0])});
2669 if (!defined $key) {
2670 my $check = $oktoadd[0];
2671 foreach my $regext (@{$self->{'valid_components'}->{$tag}}) {
2672 last if ($check =~ s/$regext$//);
2674 foreach my $vc (keys %{$self->{'valid_components'}}) {
2675 ## If this component name does not match the component name for
2676 ## which we are adding files and there are components defined
2677 ## for it, we will look to see if we can find a matching group
2678 ## name. We have to make sure that we do not use the hash map
2679 ## ($self->{$vc}) unless it's defined. Doing so will
2680 ## automatically create the map and that will cause MPC to
2681 ## think that the user provided the empty setting (when it
2682 ## wasn't).
2683 if ($vc ne $tag && defined $self->{$vc}) {
2684 foreach my $name (keys %{$self->{$vc}}) {
2685 foreach my $ckey (keys %{$self->{$vc}->{$name}}) {
2686 if ($ckey ne $defgroup) {
2687 foreach my $ofile (@{$self->{$vc}->{$name}->{$ckey}}) {
2688 my $file = $ofile;
2689 foreach my $regext (@{$self->{'valid_components'}->{$vc}}) {
2690 last if ($file =~ s/$regext$//);
2692 if ($file eq $check) {
2693 $key = $ckey;
2694 last;
2698 last if (defined $key);
2701 last if (defined $key);
2704 $key = $defgroup if (!defined $key);
2706 foreach my $name (keys %$names) {
2707 if (!defined $$names{$name}->{$key}) {
2708 if ($key ne $defgroup &&
2709 defined $$names{$name}->{$defgroup} &&
2710 defined $$names{$name}->{$defgroup}->[0]) {
2711 $self->process_assignment_add($grouped_key . $tag, $defgroup);
2713 $$names{$name}->{$key} = [];
2714 $self->process_assignment_add($grouped_key . $tag, $key);
2716 unshift(@{$$names{$name}->{$key}}, @oktoadd);
2723 sub search_for_entry {
2724 my($self, $file, $marray, $preproc) = @_;
2725 my $name;
2726 my $fh = new FileHandle();
2728 if (open($fh, $file)) {
2729 my $poundifed = 0;
2730 my $commented = 0;
2732 while(<$fh>) {
2733 ## Remove c++ style comments
2734 $_ =~ s/\/\/.*// if (!$commented);
2736 ## Remove one line c style comments
2737 $_ =~ s/\/\*.*\*\///g;
2739 if ($commented) {
2740 if (/\*\//) {
2741 ## Found the end of a multi-line c style comment
2742 --$commented;
2745 else {
2746 if (/\/\*/) {
2747 ## Found the beginning of a multi-line c style comment
2748 ++$commented;
2750 elsif ($preproc) {
2751 ## If the current language supports a c preprocessor, we
2752 ## will perform a minimal check for #if 0
2753 if (/#\s*if\s+0/) {
2754 ## Found the beginning of a #if 0
2755 ++$poundifed;
2757 elsif ($poundifed) {
2758 if (/#\s*if/) {
2759 ## We need to keep track of any other #if directives
2760 ## to be sure that when we see an #endif we don't
2761 ## count the wrong one.
2762 ++$poundifed;
2764 elsif (/#\s*endif/) {
2765 ## Found a #endif, so decrement our count
2766 --$poundifed;
2772 ## Check for main; Make sure it's not #if 0'ed and not commented out
2773 if (!$poundifed && !$commented) {
2774 my $found = undef;
2775 foreach my $main (@$marray) {
2776 if (/\s+$main\s*\(/ || /^\s*$main\s*\(/) {
2777 ## If we've found a main, set the exename to the basename
2778 ## of the cpp file with the extension removed
2779 $name = $self->mpc_basename($file);
2780 $name =~ s/\.[^\.]+$//;
2781 $found = 1;
2782 last;
2784 last if ($found);
2788 close($fh);
2790 return $name;
2794 sub find_main_file {
2795 my($self, $sources) = @_;
2796 my $lang = $self->get_language();
2797 my @main = $language{$lang}->[3];
2798 my $preproc = $language{$lang}->[4];
2800 ## If additional main's have been supplied by the user for this
2801 ## language type, then just push them onto the array.
2802 push(@main, @{$mains{$lang}}) if (defined $mains{$lang});
2804 ## Now search each source file until we've found a main function.
2805 foreach my $file (@$sources) {
2806 my $exename = $self->search_for_entry($file, \@main, $preproc);
2807 return $exename if (defined $exename);
2810 return undef;
2814 sub generate_default_target_names {
2815 my $self = shift;
2817 ## If this is a custom_only project, we need not waste time setting the
2818 ## sharedname, staticname or exename. Searching all of the files for a
2819 ## main function is very time consuming and unnecessary.
2820 return undef if ($self->get_assignment('custom_only'));
2822 if (!$self->exe_target()) {
2823 my $sharedname = $self->get_assignment('sharedname');
2824 my $staticname = $self->get_assignment('staticname');
2825 my $shared_empty;
2827 if (defined $sharedname) {
2828 if ($sharedname eq '') {
2829 $shared_empty = 1;
2830 $sharedname = undef;
2831 $self->process_assignment('sharedname', $sharedname);
2833 elsif (!defined $staticname) {
2834 $staticname = $sharedname;
2835 $self->process_assignment('staticname', $staticname);
2838 if (defined $staticname && !$shared_empty && !defined $sharedname) {
2839 $sharedname = $staticname;
2840 $self->process_assignment('sharedname', $sharedname);
2843 ## If it's neither an exe or library target, we will search
2844 ## through the source files for a main()
2845 if (!$self->lib_target()) {
2846 ## Set the exename assignment
2847 my @sources = $self->get_component_list('source_files', 1);
2848 my $exename = $self->find_main_file(\@sources);
2849 $self->process_assignment('exename', $exename) if (defined $exename);
2851 ## If we still don't have a project type, then we will
2852 ## default to a library if there are source or resource files
2853 if (!defined $exename) {
2854 if (!defined $sources[0]) {
2855 @sources = $self->get_component_list($self->get_resource_tag(), 1);
2857 if (defined $sources[0]) {
2858 if (!$shared_empty) {
2859 $self->process_assignment('sharedname',
2860 $self->{'unmodified_project_name'});
2862 $self->process_assignment('staticname',
2863 $self->{'unmodified_project_name'});
2869 ## If we are generating only static projects, then we need to
2870 ## unset the sharedname, so that we can insure that projects of
2871 ## various types only generate static targets.
2872 if ($self->get_static() == 1) {
2873 my $sharedname = $self->get_assignment('sharedname');
2874 if (defined $sharedname) {
2875 $self->process_assignment('sharedname', undef);
2879 ## Check for the use of an asterisk in the name
2880 foreach my $key ('exename', 'sharedname', 'staticname') {
2881 my $value = $self->get_assignment($key);
2882 if (defined $value && index($value, '*') >= 0) {
2883 $value = $self->fill_type_name($value,
2884 $self->{'unmodified_project_name'});
2885 $self->process_assignment($key, $value);
2891 sub generate_default_pch_filenames {
2892 my($self, $files) = @_;
2893 my $pchhdef = (defined $self->get_assignment('pch_header'));
2894 my $pchcdef = (defined $self->get_assignment('pch_source'));
2896 if (!$pchhdef || !$pchcdef) {
2897 my $pname = $self->get_assignment('project_name');
2898 my $hcount = 0;
2899 my $ccount = 0;
2900 my $hmatching;
2901 my $cmatching;
2902 foreach my $file (@$files) {
2903 ## If the file doesn't even contain _pch, then there's no point
2904 ## in looping through all of the extensions
2905 if (index($file, '_pch') >= 0) {
2906 if (!$pchhdef) {
2907 foreach my $ext (@{$self->{'valid_components'}->{'header_files'}}) {
2908 if ($file =~ /(.*_pch$ext)$/) {
2909 $self->process_assignment('pch_header', $1);
2910 ++$hcount;
2911 $hmatching = $file if (index($file, $pname) >= 0);
2912 last;
2916 if (!$pchcdef) {
2917 foreach my $ext (@{$self->{'valid_components'}->{'source_files'}}) {
2918 if ($file =~ /(.*_pch$ext)$/) {
2919 $self->process_assignment('pch_source', $1);
2920 ++$ccount;
2921 $cmatching = $file if (index($file, $pname) >= 0);
2922 last;
2928 if (!$pchhdef && $hcount > 1 && defined $hmatching) {
2929 $self->process_assignment('pch_header', $hmatching);
2931 if (!$pchcdef && $ccount > 1 && defined $cmatching) {
2932 $self->process_assignment('pch_source', $cmatching);
2938 sub fix_pch_filenames {
2939 my $self = shift;
2941 ## Unset the precompiled header settings if they are set but empty
2942 foreach my $type ('pch_header', 'pch_source') {
2943 my $pch = $self->get_assignment($type);
2944 $self->process_assignment($type, undef) if (defined $pch && $pch eq '');
2949 sub remove_extra_pch_listings {
2950 my $self = shift;
2951 my @pchs = ('pch_header', 'pch_source');
2952 my @tags = ('header_files', 'source_files');
2954 for(my $j = 0; $j < 2; ++$j) {
2955 my $pch = $self->get_assignment($pchs[$j]);
2957 if (defined $pch) {
2958 ## If we are converting slashes, then we need to
2959 ## convert the pch file back to forward slashes
2960 $pch =~ s/\\/\//g if ($self->{'convert_slashes'});
2962 ## Find out which files are duplicated
2963 my $names = $self->{$tags[$j]};
2964 foreach my $name (keys %$names) {
2965 my $comps = $$names{$name};
2966 foreach my $key (keys %$comps) {
2967 my $array = $$comps{$key};
2968 my $count = scalar(@$array);
2969 for(my $i = 0; $i < $count; ++$i) {
2970 if ($pch eq $$array[$i]) {
2971 splice(@$array, $i, 1);
2972 --$count;
2982 sub sift_files {
2983 my($self, $files, $exts, $pchh, $pchc, $tag, $array, $alldir) = @_;
2984 my @saved;
2985 my $havec = (defined $self->{'exclude_components'}->{$tag});
2987 ## The special actions taken based on $saverc only applies to
2988 ## C++ resource files.
2989 my $saverc = (!$alldir && $tag eq $self->get_resource_tag() &&
2990 $self->languageIs(Creator::cplusplus));
2992 foreach my $ext (@$exts) {
2993 foreach my $file (grep(/$ext$/, @$files)) {
2994 ## Always exclude the precompiled header and cpp
2995 if ((!defined $pchh || $file ne $pchh) &&
2996 (!defined $pchc || $file ne $pchc)) {
2997 if ($havec) {
2998 my $exclude = 0;
2999 foreach my $exc (@{$self->{'exclude_components'}->{$tag}}) {
3000 if ($file =~ /$exc$/) {
3001 $exclude = 1;
3002 last;
3005 next if ($exclude);
3007 elsif ($saverc) {
3008 ## Save these files for later. There may
3009 ## be more than one and we want to try and
3010 ## find the one that corresponds to this project
3011 push(@saved, $file);
3012 next;
3015 push(@$array, $file) if (!$self->already_added($array, $file));
3020 ## Now deal with the saved files
3021 if (defined $saved[0]) {
3022 if (!defined $saved[1]) {
3023 ## Theres only one rc file, take it
3024 push(@$array, $saved[0]);
3026 else {
3027 my $pjname = $self->escape_regex_special(
3028 $self->transform_file_name(
3029 $self->get_assignment('project_name')));
3030 ## Use a case insensitive search.
3031 ## After all, this is a Windows specific file type.
3032 foreach my $save (@saved) {
3033 if ($save =~ /$pjname/i) {
3034 if (!$self->already_added($array, $save)) {
3035 push(@$array, $save);
3044 sub sift_default_file_list {
3045 my($self, $tag, $file, $built, $exts, $recurse, $pchh, $pchc) = @_;
3046 my $alldir = $recurse ||
3047 (defined $self->{'flag_overrides'}->{$tag} &&
3048 defined $self->{'flag_overrides'}->{$tag}->{$file} &&
3049 $self->{'flag_overrides'}->{$tag}->{$file}->{'recurse'});
3050 my @gen = $self->generate_default_file_list($file, [], undef, $alldir);
3052 $self->sift_files(\@gen, $exts, $pchh, $pchc, $tag, $built, $alldir);
3056 sub correct_generated_files {
3057 my($self, $defcomp, $exts, $tag, $array) = @_;
3059 if (defined $sourceComponents{$tag}) {
3060 my $grtag = $grouped_key . $tag;
3061 foreach my $gentype (keys %{$self->{'generated_exts'}}) {
3062 ## If we are not automatically adding generated output, then we
3063 ## need to skip this component type.
3064 next if (!$self->{'generated_exts'}->{$gentype}->{'automatic_out'});
3066 ## If we are auto-generating the source_files, then
3067 ## we need to make sure that any generated source
3068 ## files that are added are put at the front of the list.
3069 my $newgroup;
3070 my @input;
3072 ## If I call keys %{$self->{$gentype}} using perl 5.6.1
3073 ## it returns nothing. I have to put it in an
3074 ## intermediate variable to ensure that I get the keys.
3075 my $names = $self->{$gentype};
3076 foreach my $name (keys %$names) {
3077 foreach my $key (keys %{$$names{$name}}) {
3078 push(@input, @{$$names{$name}->{$key}});
3079 $newgroup = $key if ($key ne $defgroup);
3083 if (defined $input[0]) {
3084 my @front;
3085 my @copy = @$array;
3087 @$array = ();
3088 foreach my $input (@input) {
3089 my $part = $self->remove_wanted_extension(
3090 $input,
3091 $self->{'valid_components'}->{$gentype});
3093 my @files = $self->generated_filenames($part, $gentype,
3094 $tag, $input);
3095 if (defined $copy[0]) {
3096 my $found = 0;
3097 foreach my $file (@files) {
3098 for(my $i = 0; $i < scalar(@copy); $i++) {
3099 my $re = $self->escape_regex_special($copy[$i]);
3100 if ($file eq $copy[$i] || $file =~ /[\/\\]$re$/) {
3101 ## No need to check for previously added files
3102 ## here since there are none.
3103 $found = 1;
3104 push(@front, $file);
3105 splice(@copy, $i, 1);
3106 last;
3109 last if ($found);
3111 if (!$found) {
3112 ## The first file listed in @files is the preferred
3113 ## extension for the custom command. Take the first
3114 ## file extension and see if it matches one in the accepted
3115 ## extensions.
3116 if (defined $files[0]) {
3117 my $ext;
3118 if ($files[0] =~ /.*(\.[^\.]+)$/) {
3119 $ext = $self->escape_regex_special($1);
3121 if (defined $ext) {
3122 ## If it doesn't match one of the accepted extensions,
3123 ## then just use the first extension from the type for
3124 ## which we are generating.
3125 $ext = $$exts[0] if (!StringProcessor::fgrep($ext, $exts));
3128 ## Add all the files that match the chosen extension
3129 foreach my $file (@files) {
3130 push(@front, $file) if ($file =~ /$ext$/);
3135 else {
3136 my $ext = $$exts[0];
3137 foreach my $file (@files) {
3138 push(@front, $file) if ($file =~ /$ext$/);
3142 if (defined $copy[0]) {
3143 ## No need to check for previously added files
3144 ## here since there are none.
3145 push(@$array, @copy);
3146 if (defined $self->get_assignment($grtag)) {
3147 $self->process_assignment_add($grtag, $defgroup);
3150 if (defined $front[0]) {
3151 if (defined $newgroup) {
3152 if (defined $copy[0]) {
3153 $self->process_assignment_add($grtag, $defgroup);
3155 if (!defined $self->{$tag}->{$defcomp}->{$newgroup}) {
3156 $self->{$tag}->{$defcomp}->{$newgroup} = \@front;
3158 else {
3159 push(@{$self->{$tag}->{$defcomp}->{$newgroup}}, @front);
3161 $self->process_assignment_add($grtag, $newgroup);
3163 else {
3164 unshift(@$array, @front);
3172 sub generate_default_components {
3173 my($self, $files, $passed) = @_;
3174 my $genext = $self->{'generated_exts'};
3175 my @gc = reverse sort { $self->sort_generated_types($a, $b)
3176 } keys %$genext;
3177 my @tags = (defined $passed ? $passed :
3178 (@gc, keys %{$language{$self->get_language()}->[0]}));
3179 my $pchh = $self->get_assignment('pch_header');
3180 my $pchc = $self->get_assignment('pch_source');
3181 my $recurse = $self->get_assignment('recurse');
3182 my $defcomp = $self->get_default_component_name();
3183 my $flo = $self->{'flag_overrides'};
3184 my $cmdflags = 'commandflags';
3186 ## The order of @tags does make a difference in the way that generated
3187 ## files get added. Hence the sort call on the generate_exts keys to
3188 ## ensure that user defined types come first. They are reverse sorted
3189 ## using the custom sort function to ensure that user defined types
3190 ## that rely on other user defined types for input files are processed
3191 ## first.
3192 foreach my $tag (@tags) {
3193 if (!defined $genext->{$tag} ||
3194 $genext->{$tag}->{'automatic_in'}) {
3195 my $exts = $self->{'valid_components'}->{$tag};
3196 if (defined $$exts[0]) {
3197 if (defined $self->{$tag}) {
3198 ## If the tag is defined, then process directories
3199 my $names = $self->{$tag};
3200 foreach my $name (keys %$names) {
3201 my $comps = $$names{$name};
3202 foreach my $comp (keys %$comps) {
3203 my $array = $$comps{$comp};
3204 if (defined $passed) {
3205 $self->sift_files($files, $exts, $pchh, $pchc, $tag, $array);
3207 else {
3208 my @built;
3209 my $alldirs = 1;
3210 foreach my $file (@$array) {
3211 if (-d $file) {
3212 my @portion;
3213 $self->sift_default_file_list($tag, $file, \@portion,
3214 $exts, $recurse, $pchh, $pchc);
3216 ## Since the file was actually a directory, we will
3217 ## need to propagate the flag overrides (if there are
3218 ## any) to the newly located files.
3219 if (defined $flo->{$tag} &&
3220 defined $flo->{$tag}->{$file}) {
3221 foreach my $built (@portion) {
3222 $flo->{$tag}->{$built} = $flo->{$tag}->{$file};
3226 ## Always push the @portion array onto the back of
3227 ## @built.
3228 push(@built, @portion);
3230 else {
3231 $alldirs = undef;
3232 if (!$self->already_added(\@built, $file)) {
3233 push(@built, $file);
3237 if ($alldirs) {
3238 $self->correct_generated_files($defcomp, $exts,
3239 $tag, \@built);
3241 $$comps{$comp} = \@built;
3246 else {
3247 ## Generate default values for undefined tags
3248 $self->{$tag} = {};
3249 my $comps = {};
3250 $self->{$tag}->{$defcomp} = $comps;
3251 $$comps{$defgroup} = [];
3252 my $array = $$comps{$defgroup};
3254 $self->{'defaulted'}->{$tag} = 1;
3256 if (!defined $specialComponents{$tag}) {
3257 $self->sift_files($files, $exts, $pchh, $pchc, $tag, $array);
3258 $self->correct_generated_files($defcomp, $exts, $tag, $array);
3262 ## If the type that we're generating defaults for ($tag) is a
3263 ## custom type, then we need to see if other custom types
3264 ## ($gentype) will generate files that will be used as input. It
3265 ## has to be done here so that the built-in types will have all
3266 ## of the possible input files that they can.
3267 if (defined $genext->{$tag}) {
3268 foreach my $gentype (keys %{$genext}) {
3269 if ($gentype ne $tag) {
3270 $self->list_default_generated($gentype, [$tag]);
3274 ## Now that we have the files for this type ($tag), we need to
3275 ## locate a command helper for the custom command and see if it
3276 ## knows about any additional output files based on the file
3277 ## name.
3278 my $cmdHelper = $self->find_command_helper($tag);
3279 if (defined $cmdHelper) {
3280 my $names = $self->{$tag};
3281 foreach my $name (keys %$names) {
3282 my $comps = $$names{$name};
3283 foreach my $comp (keys %$comps) {
3284 my $array = $$comps{$comp};
3285 foreach my $file (@$array) {
3286 my $flags = defined $flo->{$tag}->{$file} ?
3287 $flo->{$tag}->{$file}->{$cmdflags} :
3288 $genext->{$tag}->{$cmdflags};
3289 my ($add_out, $deps) = $cmdHelper->get_output($file, $flags);
3290 push(@{$self->{'custom_special_output'}->{$tag}->{$file}},
3291 @$add_out);
3292 foreach my $depTag (keys %$deps) {
3293 foreach my $depFile (keys %{$deps->{$depTag}}) {
3294 $self->add_custom_depend($depTag, $depFile,
3295 $deps->{$depTag}->{$depFile});
3309 sub remove_duplicated_files {
3310 my($self, $dest, $source) = @_;
3311 my @slist = $self->get_component_list($source, 1);
3313 ## There's no point in going on if there's nothing in this component
3314 ## list.
3315 return undef if ($#slist == -1);
3317 ## Convert the array into keys for a hash table
3318 my %shash;
3319 @shash{@slist} = ();
3321 ## Find out which source files are listed
3322 my $names = $self->{$dest};
3323 foreach my $name (keys %$names) {
3324 foreach my $key (keys %{$$names{$name}}) {
3325 my $array = $$names{$name}->{$key};
3326 my $count = scalar(@$array);
3327 for(my $i = 0; $i < $count; ++$i) {
3328 ## Is the source file in the component array?
3329 if (exists $shash{$$array[$i]}) {
3330 ## Remove the element and fix the index and count
3331 splice(@$array, $i, 1);
3332 --$count;
3333 --$i;
3341 sub generated_source_listed {
3342 my($self, $gent, $tag, $arr, $sext) = @_;
3343 my $names = $self->{$tag};
3345 ## Find out which generated source files are listed
3346 foreach my $name (keys %$names) {
3347 my $comps = $$names{$name};
3348 foreach my $key (keys %$comps) {
3349 foreach my $val (@{$$comps{$key}}) {
3350 foreach my $i (keys %$arr) {
3351 my @gfiles = $self->generated_filenames($$arr{$i}, $gent, $tag, $i);
3352 foreach my $re (@gfiles) {
3353 $re = $self->escape_regex_special($re);
3354 return 1 if ($val =~ /$re$/);
3361 return 0;
3365 sub list_default_generated {
3366 my($self, $gentype, $tags) = @_;
3368 ## This method is called when the user has custom input files and has
3369 ## provided source files. If the user defaults the component (i.e.
3370 ## source_files, resource_files, etc.) they are filled in by the
3371 ## generate_default_components method.
3373 if (defined $self->{'generated_exts'}->{$gentype} &&
3374 $self->{'generated_exts'}->{$gentype}->{'automatic_out'}) {
3375 ## After all source and headers have been defaulted, see if we
3376 ## need to add the generated files
3377 if (defined $self->{$gentype}) {
3378 ## Build up the list of files
3379 my %arr;
3380 #tie %arr, "Tie::IxHash"; # preserve insertion order.
3382 my $names = $self->{$gentype};
3383 my $group;
3384 foreach my $name (keys %$names) {
3385 foreach my $key (keys %{$$names{$name}}) {
3386 my $array = $$names{$name}->{$key};
3388 ## Take the last group name we encounter
3389 $group = $key if ($key ne $defgroup);
3391 foreach my $val (@$array) {
3392 $arr{$val} = $self->remove_wanted_extension(
3393 $val,
3394 $self->{'valid_components'}->{$gentype});
3399 foreach my $type (@$tags) {
3400 ## Only add generated files if the following is true:
3401 ## 1) The generating type is not the same as the receiving type.
3402 ## 2) The receiving type is not "special" (unless it hasn't been
3403 ## supplied by the user).
3404 ## 3) The receiving type is not user defined or it is user
3405 ## defined and has 'automatic_in' set to true.
3406 if ($gentype ne $type &&
3407 (!$specialComponents{$type} ||
3408 (!$self->{'special_supplied'}->{$type} ||
3409 UNIVERSAL::isa($self->{'special_supplied'}->{$type}, 'ARRAY'))) &&
3410 (!defined $self->{'generated_exts'}->{$type} ||
3411 $self->{'generated_exts'}->{$type}->{'automatic_in'})) {
3412 if (!$self->generated_source_listed(
3413 $gentype, $type, \%arr,
3414 $self->{'valid_components'}->{$gentype})) {
3415 $self->add_generated_files($gentype, $type, $group, \%arr);
3424 sub prepend_gendir {
3425 my($self, $created, $ofile, $gentype) = @_;
3426 my $key;
3428 if (defined $self->{'flag_overrides'}->{$gentype}) {
3429 foreach my $ext (@{$self->{'valid_components'}->{$gentype}}) {
3430 my $e = $ext;
3431 $e =~ s/\\//g;
3432 $key = "$ofile$e";
3434 last if (defined $self->{'flag_overrides'}->{$gentype}->{$key});
3435 $key = undef;
3438 if (defined $key) {
3439 if (StringProcessor::fgrep('gendir',
3440 $self->{'matching_assignments'}->{$gentype})) {
3441 my $dir = $self->{'flag_overrides'}->{$gentype}->{$key}->{'gendir'};
3442 if (defined $dir) {
3443 ## Convert the file to unix style for basename
3444 if ($self->{'convert_slashes'}) {
3445 $created =~ s/\\/\//g;
3446 $dir =~ s/\\/\//g;
3448 return ($dir eq '.' ? '' : "$dir/") . $self->mpc_basename($created);
3454 return $created;
3458 sub list_generated_file {
3459 my($self, $gentype, $tag, $array, $file, $ofile) = @_;
3460 my $count = 0;
3462 ## Go through each file listed in our original type and attempt to find
3463 ## out if it is the generated file we may need to add ($file).
3464 foreach my $gen ($self->get_component_list($gentype, 1)) {
3465 my $input = $gen;
3467 ## Take the file and see if it contains an extension that our
3468 ## generating type ($gentype) knows about. If it does, remove it and
3469 ## stop looking for the extension.
3470 foreach my $ext (@{$self->{'valid_components'}->{$gentype}}) {
3471 ## Remove the extension.
3472 ## If it works, then we can exit this loop.
3473 last if ($gen =~ s/$ext$//);
3476 ## If the user provided file does not match any of the
3477 ## extensions specified by the custom definition, we need
3478 ## to remove the extension or else this file will not be
3479 ## added to the project.
3480 $gen =~ s/\.[^\.]+$// if ($gen eq $input);
3482 ## See if we need to add the file. We always need to check since the
3483 ## output file may have absolutely nothing in common with the input
3484 ## file.
3485 foreach my $created ($self->generated_filenames($gen, $gentype,
3486 $tag, $input)) {
3487 ## $gen is a file that has a custom definition that generates
3488 ## files of the type $tag. The $file passed in is of type
3489 ## $gentype and, as far as I can tell, $created will always be
3490 ## longer or of the same length of $file. It doesn't really
3491 ## matter if $file contains a '.' or not.
3492 if (index($created, $file) != -1) {
3493 if (defined $ofile) {
3494 $created = $self->prepend_gendir($created, $ofile, $gentype);
3496 if (!$self->already_added($array, $created)) {
3497 push(@$array, $created);
3498 ++$count;
3500 last;
3505 return $count;
3509 sub add_corresponding_component_files {
3510 my($self, $filecomp, $tag) = @_;
3511 my $grname = $grouped_key . $tag;
3513 ## Create a hash array keyed off of the existing files of the type
3514 ## that we plan on adding.
3515 my $fexist = 0;
3516 my %scfiles;
3517 my $names = $self->{$tag};
3518 foreach my $name (keys %$names) {
3519 ## Check to see if files exist in the default group
3520 if (defined $$names{$name}->{$defgroup} &&
3521 defined $$names{$name}->{$defgroup}->[0]) {
3522 $fexist = 1;
3524 foreach my $comp (keys %{$$names{$name}}) {
3525 @scfiles{@{$$names{$name}->{$comp}}} = ();
3529 ## Create an array of extensions for the files we want to add
3530 my @exts;
3531 foreach my $ext (@{$self->{'valid_components'}->{$tag}}) {
3532 push(@exts, $ext);
3533 $exts[$#exts] =~ s/\\//g;
3536 ## Check each file against a possible new file addition
3537 my $adddefaultgroup = 0;
3538 my $oktoadddefault = 0;
3539 foreach my $sfile (keys %$filecomp) {
3540 my $found = 0;
3541 foreach my $ext (@exts) {
3542 if (exists $scfiles{"$sfile$ext"}) {
3543 $found = 1;
3544 last;
3548 if (!$found) {
3549 ## Get the array of files for the selected component name
3550 my $array = [];
3551 my $comp = $$filecomp{$sfile};
3552 foreach my $name (keys %$names) {
3553 if (defined $$names{$name}->{$comp}) {
3554 $array = $$names{$name}->{$comp};
3558 ## First, see if it will be generated so that we can correctly
3559 ## deal with 'gendir' settings.
3560 foreach my $gentype (keys %{$self->{'generated_exts'}}) {
3561 $found += $self->list_generated_file($gentype, $tag, $array, $sfile);
3564 ## Next check to see if the file exists
3565 if (!$found) {
3566 foreach my $ext (@exts) {
3567 if (-r "$sfile$ext") {
3568 my $file = "$sfile$ext";
3569 if (!$self->already_added($array, $file)) {
3570 push(@$array, $file);
3571 ++$found;
3573 last;
3578 ## If we have any files at all in the component array, check
3579 ## to see if we need to add a new group name
3580 if (defined $$array[0]) {
3581 if ($comp eq $defgroup) {
3582 $adddefaultgroup = 1;
3584 else {
3585 my $grval = $self->get_assignment($grname);
3586 if (!defined $grval ||
3587 !StringProcessor::fgrep($comp, $self->create_array($grval))) {
3588 $self->process_assignment_add($grname, $comp);
3590 $oktoadddefault = 1;
3591 $adddefaultgroup |= $fexist;
3594 ## Put the array back into the component list
3595 if ($found) {
3596 foreach my $name (keys %$names) {
3597 $$names{$name}->{$comp} = $array;
3604 ## We only need to add the default group name if we wanted to
3605 ## add the default group when adding new files and we added a group
3606 ## by some other name. Otherwise, defaulted files would always be
3607 ## in a group, which is not what we want.
3608 if ($adddefaultgroup && $oktoadddefault) {
3609 $self->process_assignment_add($grname, $defgroup);
3614 sub get_default_project_name {
3615 my $self = shift;
3616 my $name = $self->{'current_input'};
3618 if ($name eq '') {
3619 $name = $self->transform_file_name($self->base_directory());
3621 else {
3622 ## Since files on UNIX can have back slashes, we transform them
3623 ## into underscores.
3624 $name =~ s/\\/_/g;
3626 ## Convert the name to a usable name
3627 $name = $self->transform_file_name($name);
3629 ## Take off the extension
3630 $name =~ s/\.[^\.]+$//;
3633 return $name;
3637 sub remove_excluded {
3638 my $self = shift;
3639 my @tags = @_;
3641 ## Process each file type and remove the excluded files
3642 foreach my $tag (@tags) {
3643 my $names = $self->{$tag};
3644 foreach my $name (keys %$names) {
3645 foreach my $comp (keys %{$$names{$name}}) {
3646 my $count = scalar(@{$$names{$name}->{$comp}});
3647 for(my $i = 0; $i < $count; ++$i) {
3648 my $file = $$names{$name}->{$comp}->[$i];
3649 if (defined $self->{'remove_files'}->{$tag}->{$file}) {
3650 splice(@{$$names{$name}->{$comp}}, $i, 1);
3651 --$i;
3652 --$count;
3654 else {
3655 ## The file does not match exactly with one of the files to
3656 ## remove. Look for wildcard specifications in the files to
3657 ## be removed and perform the removal if one of them matches
3658 ## the current file.
3659 foreach my $key (keys %{$self->{'remove_files'}->{$tag}}) {
3660 if ($key =~ /[\*\?\[\]]/) {
3661 my $regex = $key;
3662 $regex =~ s/\./\\./g;
3663 $regex =~ s/\*/\.\*/g;
3664 $regex =~ s/\?/\./g;
3665 if ($file =~ /^$regex$/) {
3666 splice(@{$$names{$name}->{$comp}}, $i, 1);
3667 --$i;
3668 --$count;
3669 last;
3677 delete $self->{'remove_files'}->{$tag};
3682 sub sort_generated_types {
3683 ## We need to sort the custom component types such that a custom type
3684 ## that generates input for another custom type comes first in the
3685 ## list.
3686 my($self, $left, $right, $norecurse) = @_;
3687 foreach my $key (keys %{$self->{'generated_exts'}->{$left}}) {
3688 if ($key =~ /_files$/) {
3689 foreach my $regex (@{$self->{'generated_exts'}->{$left}->{$key}}) {
3690 my $ext = $regex;
3691 $ext =~ s/\\//g;
3692 foreach my $vreg (@{$self->{'valid_components'}->{$right}}) {
3693 return -1 if ($ext =~ /$vreg$/);
3698 if (!$norecurse && $self->sort_generated_types($right, $left, 1) == -1) {
3699 return 1;
3702 return 0;
3705 sub generate_defaults {
3706 my $self = shift;
3708 ## Generate default project name
3709 if (!defined $self->get_assignment('project_name')) {
3710 $self->set_project_name($self->get_default_project_name());
3713 ## Generate the default pch file names (if needed)
3714 my @files = $self->generate_default_file_list(
3715 '.', [],
3716 undef, $self->get_assignment('recurse'));
3717 $self->generate_default_pch_filenames(\@files);
3719 ## If the pch file names are empty strings then we need to fix that
3720 $self->fix_pch_filenames();
3722 ## Generate default components, but %specialComponents
3723 ## are skipped in the initial default components generation
3724 $self->generate_default_components(\@files);
3726 ## Remove source files that are also listed in the template files
3727 ## If we do not do this, then generated projects can be invalid.
3728 $self->remove_duplicated_files('source_files', 'template_files');
3730 ## If pch files are listed in header_files or source_files more than
3731 ## once, we need to remove the extras
3732 $self->remove_extra_pch_listings();
3734 ## Generate the default generated list of files only if we defaulted
3735 ## the generated file list. I want to ensure that source_files comes
3736 ## first in the list to pick up group information (since source_files
3737 ## are most likely going to be grouped than anything else).
3738 my @vc = sort { return -1 if $a eq 'source_files';
3739 return 1 if $b eq 'source_files';
3740 return $b cmp $a; } keys %{$self->{'valid_components'}};
3741 my @gvc = sort { $self->sort_generated_types($a, $b)
3742 } keys %{$self->{'generated_exts'}};
3743 foreach my $gentype (@gvc) {
3744 $self->list_default_generated($gentype, \@vc);
3747 ## Now that all of the source files have been added
3748 ## we need to remove those that have need to be removed
3749 $self->remove_excluded('source_files');
3751 ## Collect up all of the source files that have already been listed
3752 ## with the extension removed for use directly below.
3753 my %sourcecomp;
3754 foreach my $sourcetag (keys %sourceComponents) {
3755 my $names = $self->{$sourcetag};
3756 foreach my $name (keys %$names) {
3757 foreach my $comp (keys %{$$names{$name}}) {
3758 foreach my $sfile (@{$$names{$name}->{$comp}}) {
3759 my $mod = $sfile;
3760 $mod =~ s/\.[^\.]+$//;
3761 $sourcecomp{$mod} = $comp;
3767 ## Add %specialComponents files based on the
3768 ## source_components (i.e. .h and .i or .inl based on .cpp)
3769 foreach my $tag (keys %specialComponents) {
3770 $self->add_corresponding_component_files(\%sourcecomp, $tag);
3773 ## Now, if the %specialComponents are still empty
3774 ## then take any file that matches the components extension
3775 foreach my $tag (keys %specialComponents) {
3776 if (!$self->{'special_supplied'}->{$tag} ||
3777 UNIVERSAL::isa($self->{'special_supplied'}->{$tag}, 'ARRAY')) {
3778 my $names = $self->{$tag};
3779 if (defined $names) {
3780 ## We only want to generate default components if we have
3781 ## defaulted the source files or we have no files listed
3782 ## in the current special component.
3783 my $ok = $self->{'defaulted'}->{'source_files'};
3784 if (!$ok) {
3785 my @all;
3786 foreach my $name (keys %$names) {
3787 foreach my $key (keys %{$$names{$name}}) {
3788 push(@all, @{$$names{$name}->{$key}});
3791 $ok = (!defined $all[0]);
3793 if ($ok) {
3794 ## If the "special" type was supplied and it was all
3795 ## directories, we need to use those directories to generate
3796 ## the default components instead of the current directory.
3797 my $fileref = \@files;
3798 if (defined $self->{'special_supplied'}->{$tag} &&
3799 UNIVERSAL::isa($self->{'special_supplied'}->{$tag}, 'ARRAY')) {
3800 my @special;
3801 foreach my $dir (@{$self->{'special_supplied'}->{$tag}}) {
3802 push(@special, $self->generate_default_file_list(
3803 $dir, [], undef,
3804 $self->get_assignment('recurse')));
3806 $fileref = \@special;
3808 $self->generate_default_components($fileref, $tag);
3814 ## The code to add template files automatically when it is left
3815 ## defaulted by the user may add source files that happen to end in _t
3816 ## (minus the extension). If we do not remove template files that are
3817 ## also listed as source files, the generated projects can be invalid.
3818 $self->remove_duplicated_files('template_files', 'source_files');
3820 ## Now that all of the other files have been added
3821 ## we need to remove those that have need to be removed
3822 my @rmkeys = keys %{$self->{'remove_files'}};
3823 $self->remove_excluded(@rmkeys) if (defined $rmkeys[0]);
3825 ## Tie custom files together if need be. This currently only applies
3826 ## to types with command helpers. At some point, if it is found to be
3827 ## desirous, we could extend the MPC syntax somehow to support this
3828 ## sort of thing manually.
3829 my $dep = 'dependent';
3830 foreach my $gentype (@gvc) {
3831 my $cmdHelper = $self->find_command_helper($gentype);
3832 if (defined $cmdHelper) {
3833 ## There has to be at least two files files in order for
3834 ## something to be tied together.
3835 my @files = $self->get_component_list($gentype, 1);
3836 if ($#files >= 1) {
3837 foreach my $file (@files) {
3838 my $part = $self->remove_wanted_extension(
3839 $file, $self->{'valid_components'}->{$gentype});
3840 my($tied, $vc) = $cmdHelper->get_tied($file, \@files);
3841 foreach my $tie (@$tied) {
3842 my @gen;
3843 if (!defined $vc) {
3844 foreach $vc (@vc) {
3845 @gen = $self->generated_filenames($part, $gentype,
3846 $vc, $file);
3847 last if ($#gen >= 0);
3851 ## We have a tied file, now we need to actually perform
3852 ## the tieing of the two. We will do this by saying that
3853 ## the output of the original is necessary for the
3854 ## processing of the tied file.
3855 @gen = $self->generated_filenames($part, $gentype,
3856 $vc, $file) if (!$gen[0]);
3858 ## We have found a set of files that are generated
3859 ## based on the component type of the original file
3860 ## ($gentype), so we just add the first one and
3861 ## we're done.
3862 my $first = $gen[0];
3863 $self->{'flag_overrides'}->{$gentype}->{$tie}->{$dep} =
3864 $self->{'generated_exts'}->{$gentype}->{$dep}
3865 if (!defined $self->{'flag_overrides'}->{$gentype}->{$tie}->{$dep});
3867 $self->{'flag_overrides'}->{$gentype}->{$tie}->{$dep} .= " $first"
3868 if (!defined $self->{'flag_overrides'}->{$gentype}->{$tie}->{$dep} ||
3869 $self->{'flag_overrides'}->{$gentype}->{$tie}->{$dep} !~ /\b$first\b/);
3878 sub set_project_name {
3879 my($self, $name) = @_;
3881 ## Save the unmodified project name so that when we
3882 ## need to determine the default target name, we can use
3883 ## what is expected by the user.
3884 $self->{'unmodified_project_name'} = $name;
3886 ## If we are applying the name modifier to the project
3887 ## then we will modify the project name
3888 if ($self->get_apply_project()) {
3889 my $nmod = $self->get_name_modifier();
3891 if (defined $nmod) {
3892 $nmod =~ s/\*/$name/g;
3893 $name = $nmod;
3897 ## Set the project_name assignment so that the TemplateParser
3898 ## can get the project name.
3899 $self->process_assignment('project_name', $name);
3903 sub project_name {
3904 return $_[0]->get_assignment('project_name');
3908 sub lib_target {
3909 my $self = shift;
3910 return (defined $self->get_assignment('sharedname') ||
3911 defined $self->get_assignment('staticname'));
3915 sub exe_target {
3916 return (defined $_[0]->get_assignment('exename'));
3920 sub get_component_list {
3921 my($self, $tag, $noconvert) = @_;
3922 my $names = $self->{$tag};
3923 my @list;
3925 foreach my $name (keys %$names) {
3926 foreach my $key (keys %{$$names{$name}}) {
3927 push(@list, @{$$names{$name}->{$key}});
3931 ## By default, if 'convert_slashes' is true, then we convert slashes
3932 ## to backslashes. There are cases where we do not want to convert
3933 ## the slashes, in that case get_component_list() was called with
3934 ## an additional parameter indicating this.
3935 if (!$noconvert && $self->{'convert_slashes'}) {
3936 foreach my $item (@list) {
3937 $item =~ s/\//\\/g;
3941 if ($self->{'sort_files'}) {
3942 @list = sort { $self->file_sorter($a, $b) } @list;
3945 return @list;
3949 sub check_custom_output {
3950 my($self, $based, $cinput, $ainput, $type, $comps) = @_;
3951 my @outputs;
3953 foreach my $array ($self->generated_filenames($cinput, $based,
3954 $type, $ainput, 0, 1)) {
3955 foreach my $built (@$array) {
3956 if (@$comps == 0) {
3957 push(@outputs, $built);
3958 last;
3960 elsif (defined $specialComponents{$type} &&
3961 (!$self->{'special_supplied'}->{$type} ||
3962 UNIVERSAL::isa($self->{'special_supplied'}->{$type}, 'ARRAY'))) {
3963 push(@outputs, $built);
3964 last;
3966 else {
3967 my $base = $built;
3968 $base =~ s/\\/\//g if ($self->{'convert_slashes'});
3969 my $re = $self->escape_regex_special($self->mpc_basename($base));
3970 foreach my $c (@$comps) {
3971 ## We only match if the built file name matches from
3972 ## beginning to end or from a slash to the end.
3973 if ($c =~ /^$re$/ || $c =~ /[\/\\]$re$/) {
3974 push(@outputs, $built);
3975 last;
3982 return @outputs;
3986 sub get_special_value {
3987 my $self = shift;
3988 my $type = shift;
3989 my $cmd = shift;
3990 my $based = shift;
3991 my @params = @_;
3993 ## These names (held in $type) are variables that contain various
3994 ## commands that will be used in templates within the context of a
3995 ## foreach (e.g., <%custom_type->input_files%> or <%feature->value%>).
3996 if ($type eq 'feature') {
3997 return $self->get_feature_value($cmd, $based);
3999 elsif (index($type, 'custom_type') == 0) {
4000 return $self->get_custom_value($cmd, $based, @params);
4002 elsif (index($type, $grouped_key) == 0) {
4003 return $self->get_grouped_value($type, $cmd, $based);
4005 elsif (defined $self->get_addtemp()->{$type . 's'}) {
4006 if ($cmd eq '_default') {
4007 $based =~ /^([^:]+):/;
4008 return defined $1 ? $1 : $based;
4010 else {
4011 if ($based =~ /:(.*)/) {
4012 my %attr = map { split('=', $_) } split(',', $1);
4013 return $attr{$cmd};
4017 else {
4018 my $language = $self->get_language();
4020 ## If the passed in type is not a builtin type, try the type with an
4021 ## 's' on the end.
4022 $type .= 's' if (!defined $language{$language}->[0]->{$type});
4024 ## This is a hack for dealing with the fact that built-in types
4025 ## (e.g., Source_Files, Header_Files, etc.) are not real custom
4026 ## definitions. However, we can "modify" them to some extent.
4027 return $self->get_builtin_value($type, $cmd, $based)
4028 if (defined $language{$language}->[0]->{$type});
4031 return undef;
4035 sub get_feature_value {
4036 my($self, $cmd, $based) = @_;
4038 if ($cmd eq 'value') {
4039 my $val = $self->{'feature_parser'}->get_value($based);
4040 if (defined $val && $val != 0) {
4041 return 1;
4045 return undef;
4049 sub get_grouped_value {
4050 my($self, $type, $cmd, $based) = @_;
4051 my $value;
4053 ## Make it all lower case
4054 $type = lc($type);
4056 ## Remove the grouped_ part
4057 $type =~ s/^$grouped_key//;
4059 ## Add the s if it isn't there
4060 $type .= 's' if ($type !~ /s$/);
4062 my $names = $self->{$type};
4063 if ($cmd eq 'files') {
4064 foreach my $name (keys %$names) {
4065 my $comps = $$names{$name};
4066 my @keys = keys %$comps;
4067 if (StringProcessor::fgrep($based, \@keys)) {
4068 if ($self->{'convert_slashes'}) {
4069 my @converted;
4070 foreach my $file (@{$$comps{$based}}) {
4071 push(@converted, $self->slash_to_backslash($file));
4073 $value = \@converted;
4075 else {
4076 $value = $$comps{$based};
4078 if ($self->{'sort_files'}) {
4079 my @sorted = sort { $self->file_sorter($a, $b) } @$value;
4080 $value = \@sorted;
4085 elsif ($cmd eq 'component_name') {
4086 ## If there is more than one name, then we will need
4087 ## to deal with that at a later time.
4088 foreach my $name (keys %$names) {
4089 $value = $name;
4093 return $value;
4097 sub get_builtin_value {
4098 my($self, $type, $cmd, $based) = @_;
4100 ## If the passed in type does not have a generated_exts definition,
4101 ## then try the type with an 's' on the end.
4102 $type .= 's' if (!defined $self->{'generated_exts'}->{$type});
4104 ## If we have a builtin type that has the variable ($cmd) that we are
4105 ## looking for, process the value through command parameter conversion.
4106 if (defined $self->{'generated_exts'}->{$type} &&
4107 defined $self->{'generated_exts'}->{$type}->{$cmd}) {
4108 return $self->convert_command_parameters(
4109 $type, $self->{'generated_exts'}->{$type}->{$cmd},
4110 $based, $self->get_builtin_output($based));
4113 ## Otherwise, there's nothing here.
4114 return undef;
4117 sub get_command_subs {
4118 my $self = shift;
4119 my %valid;
4121 ## Add the built-in OS compatibility commands
4122 if (UNIVERSAL::isa($self, 'WinProjectBase') ||
4123 $self->use_win_compatibility_commands()) {
4124 $valid{'cat'} = 'type';
4125 $valid{'cmp'} = 'fc /b';
4126 $valid{'cp'} = 'copy /y';
4127 $valid{'mkdir'} = 'mkdir';
4128 $valid{'mv'} = 'move /y';
4129 $valid{'os'} = 'win32';
4130 $valid{'rm'} = 'del /f/s/q';
4131 $valid{'rmdir'} = 'rmdir /s/q';
4132 $valid{'nul'} = 'nul';
4133 $valid{'slash'} = '\\';
4134 $valid{'bat'} = '.bat';
4135 $valid{'cmd'} = '.cmd';
4136 $valid{'exe'} = '.exe';
4137 $valid{'pathsep'} = ';';
4139 else {
4140 $valid{'cat'} = 'cat';
4141 $valid{'cmp'} = 'cmp';
4142 $valid{'cp'} = 'cp -f';
4143 $valid{'mkdir'} = 'mkdir -p';
4144 $valid{'mv'} = 'mv -f';
4145 $valid{'os'} = 'unix';
4146 $valid{'rm'} = 'rm -rf';
4147 $valid{'rmdir'} = 'rm -rf';
4148 $valid{'nul'} = '/dev/null';
4149 $valid{'slash'} = '/';
4150 $valid{'bat'} = '';
4151 $valid{'cmd'} = '';
4152 $valid{'exe'} = '';
4153 $valid{'pathsep'} = ':';
4156 ## Add the project specific compatibility commands
4157 $valid{'gt'} = $self->get_gt_symbol();
4158 $valid{'lt'} = $self->get_lt_symbol();
4159 $valid{'and'} = $self->get_and_symbol();
4160 $valid{'or'} = $self->get_or_symbol();
4161 $valid{'quote'} = $self->get_quote_symbol();
4162 $valid{'equote'} = $self->get_escaped_quote_symbol();
4163 $valid{'crlf'} = $self->crlf();
4164 $valid{'cmdsep'} = $self->get_cmdsep_symbol();
4165 $valid{'temporary'} = 'temp.$$$$.' . int(rand(0xffffffff));
4166 $valid{'prj_type'} = $self->{'pctype'};
4168 return \%valid;
4172 sub replace_parameters {
4173 my($self, $str, $valid, $nowarn, $input, $output, $always_clear) = @_;
4175 my %saved;
4176 my $count = 0;
4177 while ($str =~ /<%(\w+)(\(\w+\))?%>/) {
4178 my $name = $1;
4179 my $modifier = $2;
4180 if (defined $modifier) {
4181 my $tmp = $name;
4182 $name = $modifier;
4183 $name =~ s/[\(\)]//g;
4184 $modifier = $tmp;
4187 ## Support both pseudo variables and project settings
4188 if (defined $$valid{$name} || $self->is_keyword($name)) {
4189 ## If the pseudo variable is defined or the project setting has a
4190 ## value, then we'll need to do the replacement. However, if it's
4191 ## a project keyword and it's not defined, we will need to delay
4192 ## the replacement until later (unless $always_clear is true).
4193 my $replace;
4194 my $clear = $always_clear;
4195 if (defined $$valid{$name}) {
4196 $replace = $$valid{$name};
4198 elsif ($self->is_keyword($name)) {
4199 $replace = $self->get_assignment($name);
4202 ## Perform the modification and replacement here
4203 if (defined $replace) {
4204 if (defined $modifier) {
4205 if ($modifier eq 'noextension') {
4206 $replace =~ s/\.[^\.]+$//;
4208 else {
4209 $self->warning("Unknown parameter modifier $modifier.");
4212 $str =~ s/<%\w+(\(\w+\))?%>/$replace/;
4214 elsif ($clear) {
4215 ## We need to clear out this variable usage.
4216 $str =~ s/<%\w+(\(\w+\))?%>//;
4218 else {
4219 ## Save this variable usage to be put back after we're done
4220 ## processing the string.
4221 my $key = "\1" . $count++ . "\1";
4222 if ($str =~ s/(<%\w+(\(\w+\))?%>)/$key/) {
4223 $saved{$key} = $1;
4227 else {
4228 $str =~ s/<%\w+(\(\w+\))?%>//;
4230 ## We only want to warn the user that we did not recognize the
4231 ## pseudo template parameter if there was an input and an output
4232 ## file passed to this function. If this variable was used
4233 ## without the parenthesis (as in an if statement), then we don't
4234 ## want to warn the user.
4235 if (defined $input && defined $output) {
4236 if (!defined $$nowarn{$name}) {
4237 $self->warning("<%$name%> was not recognized.");
4240 ## If we didn't recognize the pseudo template parameter then
4241 ## we don't want to return anything back.
4242 return undef;
4247 ## Replace the saved variables so that they may be replaced (or
4248 ## removed) later on.
4249 foreach my $key (keys %saved) {
4250 $str =~ s/$key/$saved{$key}/;
4252 return $str;
4256 sub convert_command_parameters {
4257 my($self, $ktype, $str, $input, $output) = @_;
4258 my %nowarn;
4259 my %valid = %{$self->{'command_subs'}};
4261 ## Add in the values that change for every call to this function
4262 $valid{'temporary'} = 'temp.$$$$.' . int(rand(0xffffffff));
4264 if (defined $input) {
4265 $valid{'input'} = $input;
4266 $valid{'input_basename'} = $self->mpc_basename($input);
4267 $valid{'input_dirname'} = $self->mpc_dirname($input);
4268 $valid{'input_noext'} = $input;
4270 ## An input file doesn't always have an extension. If there isn't
4271 ## one, then we need to set the 'input_ext' field to an empty string
4272 ## ($1 will not necessarily have a valid value).
4273 if ($valid{'input_noext'} =~ s/(\.[^\.]+)$//) {
4274 $valid{'input_ext'} = $1;
4276 else {
4277 $valid{'input_ext'} = '';
4280 ## Check for the gendir setting associated with this input file. We
4281 ## have to check at so many levels so we don't inadvertantly create
4282 ## intermediate hash tables.
4283 if (defined $self->{'flag_overrides'}->{$ktype} &&
4284 defined $self->{'flag_overrides'}->{$ktype}->{$input} &&
4285 $self->{'flag_overrides'}->{$ktype}->{$input}->{'gendir'}) {
4286 $valid{'gendir'} = $self->{'flag_overrides'}->{$ktype}->{$input}->{'gendir'};
4290 ## If there is no gendir setting, just set it to the current directory.
4291 $valid{'gendir'} = '.' if (!defined $valid{'gendir'});
4293 if (defined $output) {
4294 my $first = 1;
4295 $valid{'output'} = "@$output";
4296 foreach my $out (@$output) {
4297 ## An output file doesn't always have an extension. If there isn't
4298 ## one, then we need to set the 'output_ext' field to an empty
4299 ## string ($1 will not necessarily have a valid value).
4300 my $noext = $out;
4301 if ($noext =~ s/(\.[^\.]+)$//) {
4302 $valid{'output_ext'} = $1;
4304 else {
4305 $valid{'output_ext'} = '';
4307 $valid{'output_noext'} .= (!$first ? ' ' : '') . $noext;
4309 ## In order to call basename or dirname, we must make sure that the
4310 ## directory separators are forward slashes.
4311 my $file = $out;
4312 $file =~ s/\\/\//g if ($self->{'convert_slashes'});
4313 $valid{'output_basename'} .= (!$first ? ' ' : '') .
4314 $self->mpc_basename($file);
4315 $valid{'output_dirname'} .= (!$first ? ' ' : '') .
4316 $self->mpc_dirname($file);
4317 $first = 0;
4321 ## Add in the specific types of output files
4322 if (defined $output) {
4323 foreach my $type (keys %{$self->{'valid_components'}}) {
4324 my $key = $type;
4325 $key =~ s/s$//gi;
4326 $nowarn{$key} = 1;
4327 $nowarn{$key . '_noext'} = 1;
4328 foreach my $ext (@{$self->{'valid_components'}->{$type}}) {
4329 foreach my $out (@$output) {
4330 if ($out =~ /$ext$/) {
4331 $valid{$key} = $out;
4332 $valid{$key . '_noext'} = $out;
4333 $valid{$key . '_noext'} =~ s/$ext$//;
4334 last;
4341 return $self->replace_parameters($str, \%valid, \%nowarn, $input, $output, 1);
4345 sub get_custom_special_output {
4346 my $self = shift;
4347 my $tag = shift;
4348 my $input = shift;
4349 if (defined $self->{'custom_special_output'}->{$tag} &&
4350 defined $self->{'custom_special_output'}->{$tag}->{$input} &&
4351 (!defined $self->{'flag_overrides'}->{$tag} ||
4352 !defined $self->{'flag_overrides'}->{$tag}->{$input} ||
4353 !defined $self->{'flag_overrides'}->{$tag}->{$input}->{'gendir'}
4354 || $self->{'flag_overrides'}->{$tag}->{$input}->{'gendir'} eq '.')) {
4355 return $self->{'custom_special_output'}->{$tag}->{$input};
4357 return [];
4361 sub get_first_custom_output {
4362 my $self = shift;
4363 my $input = shift;
4364 my $tag = shift;
4365 my %vcomps;
4366 foreach my $vc (keys %{$self->{'valid_components'}}) {
4367 my @comps = $self->get_component_list($vc);
4368 $vcomps{$vc} = \@comps;
4370 $vcomps{$generic_key} = [];
4371 my $ainput = $input;
4372 my $cinput = $input;
4374 ## Remove the extension
4375 $cinput =~ s/\.[^\.]+$//;
4377 ## If we are converting slashes,
4378 ## change them back for this parameter
4379 $ainput =~ s/\\/\//g if ($self->{'convert_slashes'});
4381 foreach my $vc (keys %{$self->{'valid_components'}}) {
4382 my @cout = $self->check_custom_output($tag, $cinput, $ainput, $vc,
4383 $vcomps{$vc});
4384 return $cout[0] if @cout;
4386 my @cout = $self->check_custom_output($tag, $cinput, $ainput, $generic_key,
4387 $vcomps{$generic_key});
4388 return $cout[0] if @cout;
4389 my $aref = $self->get_custom_special_output($tag, $ainput);
4390 return $$aref[0] if @$aref;
4391 return '';
4395 sub get_custom_assign_or_override {
4396 my $self = shift;
4397 my $var = shift; # which variable? (command, commandflags, etc.)
4398 my $tag = shift; # custom_files
4399 my $input = shift; # input file name which may override
4400 my @params = @_;
4402 my $key = undef;
4403 if (defined $self->{'flag_overrides'}->{$tag}) {
4404 my $ustyle = $input;
4405 $ustyle =~ s/\\/\//g if ($self->{'convert_slashes'});
4406 my $dir = $self->mpc_dirname($ustyle);
4407 if (defined $self->{'flag_overrides'}->{$tag}->{$ustyle}) {
4408 $key = $ustyle;
4410 elsif (defined $self->{'flag_overrides'}->{$tag}->{$dir}) {
4411 $key = $dir;
4414 my $value = undef;
4415 if (defined $key) {
4416 $value = $self->{'flag_overrides'}->{$tag}->{$key}->{$var};
4418 if (!defined $value) {
4419 $value = $self->get_assignment($var, $self->{'generated_exts'}->{$tag});
4421 return undef if !defined $value;
4422 if (defined $customDefined{$var} && ($customDefined{$var} & 0x14)) {
4423 return $self->convert_command_parameters($tag, $value, $input, undef, @params);
4425 return $value;
4429 sub get_custom_value {
4430 my $self = shift;
4431 my $cmd = shift;
4432 my $based = shift;
4433 my @params = @_;
4434 my $value;
4436 if ($cmd eq 'input_files') {
4437 ## Get the component list for the component type
4438 my @array = $self->get_component_list($based);
4440 ## Check for directories in the component list. If the component
4441 ## type is not automatic, we may have directories here and will need
4442 ## to get the file list for that type.
4443 my $once;
4444 for(my $i = 0; $i < scalar(@array); ++$i) {
4445 if (-d $array[$i]) {
4446 if (!defined $once) {
4447 $once = {'recurse' => $self->get_assignment('recurse'),
4448 'pchh' => $self->get_assignment('pch_header'),
4449 'pchc' => $self->get_assignment('pch_source'),
4452 my @built;
4453 $self->sift_default_file_list($based, $array[$i], \@built,
4454 $self->{'valid_components'}->{$based},
4455 $$once{'recurse'},
4456 $$once{'pchh'}, $$once{'pchc'});
4457 splice(@array, $i, 1, @built);
4458 $i += $#built;
4462 $value = \@array;
4464 $self->{'custom_output_files'} = {};
4465 $self->{'custom_dependency_files'} = {};
4466 $self->{'custom_multi_cmd'} = {};
4467 my %vcomps;
4468 foreach my $vc (keys %{$self->{'valid_components'}}) {
4469 my @comps = $self->get_component_list($vc);
4470 $vcomps{$vc} = \@comps;
4472 $vcomps{$generic_key} = [];
4474 foreach my $input (@array) {
4475 my @outputs;
4476 my $ainput = $input;
4477 my $cinput = $input;
4479 ## Remove the extension
4480 $cinput =~ s/\.[^\.]+$//;
4482 ## If we are converting slashes,
4483 ## change them back for this parameter
4484 $ainput =~ s/\\/\//g if ($self->{'convert_slashes'});
4486 if (defined $self->{'combined_custom'}->{$based}) {
4487 $self->{'custom_multi_cmd'}->{$input} =
4488 $self->{'combined_custom'}->{$based};
4490 my $cdf = $self->{'custom_dependency_files'};
4491 my $csd = $self->{'custom_special_depend'};
4492 foreach my $tag (@{$self->{'combined_custom'}->{$based}}) {
4493 if (defined $csd->{$tag} && defined $csd->{$tag}->{$ainput}) {
4494 $cdf->{$input} = [] if (!defined $cdf->{$input});
4495 StringProcessor::merge($cdf->{$input}, $csd->{$tag}->{$ainput});
4499 else {
4500 $self->{'custom_dependency_files'}->{$input} =
4501 $self->{'custom_special_depend'}->{$based}->{$ainput};
4504 ## Add all of the output files. We can not add $generic_key to the
4505 ## list here (as it used to be). It may have been handled by
4506 ## generated_filenames.
4507 foreach my $vc (keys %{$self->{'valid_components'}}) {
4508 ## The output of multiple components could be input for the
4509 ## current component type ($based). We need to avoid adding
4510 ## duplicates here.
4511 if (defined $self->{'combined_custom'}->{$based}) {
4512 foreach my $tag (@{$self->{'combined_custom'}->{$based}}) {
4513 my @cout = $self->check_custom_output($tag, $cinput, $ainput, $vc,
4514 $vcomps{$vc});
4515 StringProcessor::merge(\@outputs, \@cout);
4518 else {
4519 my @cout = $self->check_custom_output($based, $cinput, $ainput, $vc,
4520 $vcomps{$vc});
4521 StringProcessor::merge(\@outputs, \@cout);
4524 if (defined $self->{'combined_custom'}->{$based}) {
4525 foreach my $tag (@{$self->{'combined_custom'}->{$based}}) {
4526 my @cout = $self->check_custom_output($tag, $cinput, $ainput,
4527 $generic_key,
4528 $vcomps{$generic_key});
4529 StringProcessor::merge(\@outputs, \@cout);
4532 else {
4533 my @cout = $self->check_custom_output($based, $cinput, $ainput,
4534 $generic_key,
4535 $vcomps{$generic_key});
4536 StringProcessor::merge(\@outputs, \@cout);
4539 ## Add specially listed files avoiding duplicates. We don't want
4540 ## to add these files if gendir is set to something besides .
4541 if (defined $self->{'combined_custom'}->{$based}) {
4542 foreach my $tag (@{$self->{'combined_custom'}->{$based}}) {
4543 StringProcessor::merge(\@outputs,
4544 $self->get_custom_special_output($tag,
4545 $ainput));
4548 else {
4549 StringProcessor::merge(\@outputs,
4550 $self->get_custom_special_output($based,
4551 $ainput));
4554 if ($self->{'convert_slashes'}) {
4555 foreach my $output (@outputs) {
4556 $output =~ s/\//\\/g;
4559 if ($self->{'sort_files'}) {
4560 @outputs = sort { $self->file_sorter($a, $b) } @outputs;
4562 $self->{'custom_output_files'}->{$input} = \@outputs;
4565 elsif ($cmd eq 'output_files') {
4566 # Generate output files based on $based
4567 if (defined $self->{'custom_output_files'}) {
4568 $value = $self->{'custom_output_files'}->{$based};
4571 elsif ($cmd eq 'source_output_files') {
4572 # Generate source output files based on $based
4573 if (defined $self->{'custom_output_files'}) {
4574 $value = [];
4575 foreach my $file (@{$self->{'custom_output_files'}->{$based}}) {
4576 foreach my $ext (@{$self->{'valid_components'}->{'source_files'}}) {
4577 if ($file =~ /$ext$/) {
4578 ## We've found a file that matches one of the source file
4579 ## extensions. Now we have to make sure that it doesn't
4580 ## match a template file extension.
4581 my $matched = 0;
4582 foreach my $text (@{$self->{'valid_components'}->{'template_files'}}) {
4583 if ($file =~ /$text$/) {
4584 $matched = 1;
4585 last;
4588 push(@$value, $file) if (!$matched);
4589 last;
4595 elsif ($cmd eq 'non_source_output_files') {
4596 # Generate non source output files based on $based
4597 if (defined $self->{'custom_output_files'}) {
4598 $value = [];
4599 foreach my $file (@{$self->{'custom_output_files'}->{$based}}) {
4600 my $source = 0;
4601 foreach my $ext (@{$self->{'valid_components'}->{'source_files'}}) {
4602 if ($file =~ /$ext$/) {
4603 $source = 1;
4604 ## We've found a file that matches one of the source file
4605 ## extensions. Now we have to make sure that it doesn't
4606 ## match a template file extension.
4607 foreach my $text (@{$self->{'valid_components'}->{'template_files'}}) {
4608 if ($file =~ /$text$/) {
4609 $source = 0;
4610 last;
4613 last if ($source);
4616 push(@$value, $file) if (!$source);
4620 elsif ($cmd eq 'inputexts') {
4621 my @array = @{$self->{'valid_components'}->{$based}};
4622 foreach my $val (@array) {
4623 $val =~ s/\\\.//g;
4625 $value = \@array;
4627 elsif ($cmd eq 'dependencies') {
4628 $value = $self->{'custom_dependency_files'}->{$based};
4630 elsif ($cmd eq 'commands') { # only used with 'combined_custom'
4631 $value = [];
4632 my %details = ('flags' => 'commandflags',
4633 'outopt' => 'output_option',
4634 'gdir' => 'gendir');
4635 for my $tag (@{$self->{'custom_multi_cmd'}->{$based}}) {
4636 my $command = $self->get_custom_assign_or_override('command', $tag,
4637 $based, @params);
4638 push(@$value, $command);
4639 my $det = $self->{'custom_multi_details'}->{$command} = {};
4640 for my $k (keys %details) {
4641 $det->{$k} = $self->get_custom_assign_or_override($details{$k}, $tag,
4642 $based, @params);
4644 if ($det->{'outopt'} && $self->{'custom_output_files'}->{$based}) {
4645 # only 1 output file is supported with output_option
4646 $det->{'outfile'} = $self->get_first_custom_output($based, $tag);
4647 $det->{'outfile'} =~ s/\//\\/g if $self->{'convert_slashes'};
4648 if (defined $det->{'gdir'}) {
4649 my $basename = $det->{'outfile'};
4650 if ($self->{'convert_slashes'}) {
4651 $basename =~ s/.*[\/\\]//;
4653 else {
4654 $basename =~ s/.*\///;
4656 $det->{'outfile'} =
4657 $det->{'gdir'} . $self->{'command_subs'}->{'slash'} . $basename;
4662 elsif ($cmd eq 'flags' || $cmd eq 'outopt' || $cmd eq 'outfile' ||
4663 $cmd eq 'gdir') {
4664 # only used with 'combined_custom'
4665 $value = $self->{'custom_multi_details'}->{$based}->{$cmd} || '';
4667 elsif (defined $customDefined{$cmd}) {
4668 $value = $self->get_assignment($cmd,
4669 $self->{'generated_exts'}->{$based});
4670 if (defined $value && ($customDefined{$cmd} & 0x14) != 0) {
4671 $value = $self->convert_command_parameters($based, $value, @params);
4675 return $value;
4679 sub check_features {
4680 my($self, $requires, $avoids, $info) = @_;
4681 my $status = 1;
4682 my $why;
4684 if (defined $requires) {
4685 foreach my $require (split(/\s+/, $requires)) {
4686 my $fval = $self->{'feature_parser'}->get_value($require);
4688 ## By default, if the feature is not listed, then it is enabled.
4689 if (defined $fval && !$fval) {
4690 $why = "requires $require";
4691 $status = 0;
4692 last;
4695 ## For automakes sake, if we're to this point the feature is
4696 ## enabled and we will set it in the feature parser explicitly
4697 if (!defined $fval) {
4698 $self->{'feature_parser'}->parse_line(undef, "$require = 1");
4703 ## If it passes the requires, then check the avoids
4704 if ($status) {
4705 if (defined $avoids) {
4706 foreach my $avoid (split(/\s+/, $avoids)) {
4707 my $fval = $self->{'feature_parser'}->get_value($avoid);
4709 ## By default, if the feature is not listed, then it is enabled.
4710 if (!defined $fval || $fval) {
4711 $why = "avoids $avoid";
4712 $status = 0;
4713 last;
4719 if ($info && !$status) {
4720 $self->details("Skipping " . $self->get_assignment('project_name') .
4721 " ($self->{'current_input'}); it $why.");
4724 return $status;
4728 sub need_to_write_project {
4729 my $self = shift;
4730 my $count = 0;
4732 ## We always write a project if the user has provided a verbatim.
4733 ## We have no idea what that verbatim clause does, so we need to just
4734 ## do what the user tells us to do.
4735 return 1 if (defined $self->{'verbatim'}->{$self->{'pctype'}});
4737 ## The order here is important, we must check for source or resource
4738 ## files first and then for custom input files.
4739 foreach my $key ('source_files', $self->get_resource_tag(),
4740 keys %{$self->{'generated_exts'}}) {
4741 ## For implicitly-discovered projects, just having a resource file without
4742 ## source or generated file is not enough to write a project.
4743 next if $self->{'current_input'} eq '' && $key eq $self->get_resource_tag();
4744 my $names = $self->{$key};
4745 foreach my $name (keys %$names) {
4746 foreach my $key (keys %{$names->{$name}}) {
4747 ## See if the project contains a file that corresponds to this
4748 ## component name.
4749 if (defined $names->{$name}->{$key}->[0]) {
4750 if ($count >= 2) {
4751 ## Return 2 if we have found a custom input file (and thus no
4752 ## source or resource files due to the foreach order).
4753 return 2;
4755 ## We have either source files or resource files, we need to
4756 ## see if this project creator supports the current language.
4757 ## If it doesn't then we don't need to create the project.
4758 elsif ($self->languageSupported()) {
4759 ## Return 1 if we have found a source file or a resource file.
4760 return 1;
4765 $count++;
4768 ## Indicate that there is no need to write the project
4769 return 0;
4773 sub write_output_file {
4774 my($self, $webapp) = @_;
4775 my $status = 0;
4776 my $error;
4777 my $tover = $self->get_template_override();
4778 my @templates = $self->get_template();
4780 ## The template override will override all templates
4781 @templates = ($tover) if (defined $tover);
4783 foreach my $template (@templates) {
4784 ## Save the template name for use as a key for various function calls
4785 $self->{'current_template'} = $template;
4787 ## Create the output file name based on the project name and the
4788 ## template that we're currently using.
4789 my $name = $self->transform_file_name(
4790 $self->project_file_name(undef,
4791 $self->{'current_template'}));
4793 ## If the template files does not end in the template extension
4794 ## then we will add it on.
4795 if ($template !~ /$TemplateExtension$/) {
4796 $template .= '.' . $TemplateExtension;
4799 ## If the template file does not contain a path, then we
4800 ## will search through the include paths for it.
4801 my $tfile;
4802 if ($template =~ /[\/\\]/i) {
4803 $tfile = $template;
4805 else {
4806 $tfile = $self->search_include_path($template);
4809 if (defined $tfile) {
4810 ## Read in the template values for the specific target and project
4811 ## type. The template input file we get may depend upon the
4812 ## current template that we're using.
4813 ($status, $error) = $self->read_template_input(
4814 $self->{'current_template'});
4815 last if (!$status);
4817 my $tp = new TemplateParser($self);
4819 ## Set the project_file assignment for the template parser
4820 $self->process_assignment('project_file', $name);
4822 ($status, $error) = $tp->parse_file($tfile);
4823 last if (!$status);
4825 if (defined $self->{'source_callback'} &&
4826 $self->file_visible($self->{'current_template'})) {
4827 my $cb = $self->{'source_callback'};
4828 my $pjname = $self->get_assignment('project_name');
4829 my @list = $self->get_component_list('source_files');
4830 if (UNIVERSAL::isa($cb, 'ARRAY')) {
4831 my @copy = @$cb;
4832 my $s = shift(@copy);
4833 &$s(@copy, $name, $pjname, \@list);
4835 elsif (UNIVERSAL::isa($cb, 'CODE')) {
4836 &$cb($name, $pjname, \@list);
4838 else {
4839 $self->warning("Ignoring callback: $cb.");
4843 if ($self->get_toplevel()) {
4844 my $outdir = $self->get_outdir();
4845 my $oname = $name;
4847 $name = "$outdir/$name";
4849 my $fh = new FileHandle();
4850 my $dir = $self->mpc_dirname($name);
4852 mkpath($dir, 0, 0777) if ($dir ne '.');
4854 if ($webapp) {
4855 ## At this point in time, webapps do not get a project file,
4856 ## but they do appear in the workspace
4858 elsif ($self->compare_output()) {
4859 ## First write the output to a temporary file
4860 my $tmp = "$outdir/MPC$>.$$";
4861 my $different = 1;
4862 if (open($fh, ">$tmp")) {
4863 my $lines = $tp->get_lines();
4864 foreach my $line (@$lines) {
4865 print $fh $line;
4867 close($fh);
4869 $different = 0 if (!$self->files_are_different($name, $tmp));
4871 else {
4872 $error = "Unable to open $tmp for output.";
4873 $status = 0;
4874 last;
4877 ## If they are different, then rename the temporary file
4878 if ($different) {
4879 unlink($name);
4880 if (rename($tmp, $name)) {
4881 $error = $self->post_file_creation($name);
4882 if (defined $error) {
4883 $status = 0;
4884 last;
4887 else {
4888 $error = "Unable to open $name for output.";
4889 $status = 0;
4890 last;
4893 else {
4894 ## We will pretend that we wrote the file
4895 unlink($tmp);
4898 else {
4899 if (open($fh, ">$name")) {
4900 my $lines = $tp->get_lines();
4901 foreach my $line (@$lines) {
4902 print $fh $line;
4904 close($fh);
4905 $error = $self->post_file_creation($name);
4906 if (defined $error) {
4907 $status = 0;
4908 last;
4911 else {
4912 $error = "Unable to open $name for output.";
4913 $status = 0;
4914 last;
4918 ## There may be more than one template associated with this
4919 ## project creator. If there is, we can only add one generated
4920 ## file and we rely on the project creator to tell us which
4921 ## template generates the file that we need to track.
4922 $self->add_file_written($oname)
4923 if ($self->file_visible($self->{'current_template'}));
4926 else {
4927 $error = "Unable to locate the template file: $template.";
4928 $status = 0;
4929 last;
4932 return $status, $error;
4936 sub write_install_file {
4937 my $self = shift;
4938 my $fh = new FileHandle();
4939 my $insfile = $self->transform_file_name(
4940 $self->get_assignment('project_name')) .
4941 '.ins';
4942 my $outdir = $self->get_outdir();
4944 $insfile = "$outdir/$insfile";
4946 unlink($insfile);
4947 if (open($fh, ">$insfile")) {
4948 $self->get_install_info(sub {print $fh $_[0]});
4949 close $fh;
4950 return 1, undef;
4952 return 0, 'Unable write to ' . $insfile;
4956 sub get_install_info {
4957 my $self = shift;
4958 my $callback = shift;
4959 foreach my $vc (keys %{$self->{'valid_components'}}) {
4960 my $names = $self->{$vc};
4961 foreach my $name (keys %$names) {
4962 foreach my $key (keys %{$$names{$name}}) {
4963 my $array = $$names{$name}->{$key};
4964 if (defined $$array[0]) {
4965 &$callback("$vc:\n");
4966 foreach my $file (@$array) {
4967 if (defined $self->{'flag_overrides'}->{$vc} &&
4968 defined $self->{'flag_overrides'}->{$vc}->{$file} &&
4969 defined $self->{'flag_overrides'}->{$vc}->{$file}->{'gendir'}) {
4970 &$callback(join(' ', map {/ / ? "\"$_\"" : $_} ($file,
4971 $self->{'flag_overrides'}->{$vc}->{$file}->{'gendir'})) . "\n");
4973 else {
4974 &$callback("$file\n");
4977 &$callback("\n");
4982 if ($self->exe_target()) {
4983 my $exeout = $self->get_assignment('exeout');
4984 &$callback("exe_output:\n");
4985 &$callback((defined $exeout ? $self->relative($exeout) : '') .
4986 ' ' . $self->get_assignment('exename') . "\n");
4988 elsif ($self->lib_target()) {
4989 my $shared = $self->get_assignment('sharedname');
4990 my $static = $self->get_assignment('staticname');
4991 my $dllout = $self->relative($self->get_assignment('dllout'));
4992 my $libout = $self->relative($self->get_assignment('libout'));
4994 &$callback("lib_output:\n");
4996 if (defined $shared && $shared ne '') {
4997 &$callback((defined $dllout ? $dllout : $libout) . " $shared\n");
4999 if ((defined $static && $static ne '') &&
5000 (defined $dllout || !defined $shared ||
5001 (defined $shared && $shared ne $static))) {
5002 &$callback("$libout $static\n");
5008 sub write_project {
5009 my $self = shift;
5010 my $status = 2;
5011 my $error;
5012 my $progress = $self->get_progress_callback();
5014 &$progress() if (defined $progress);
5016 if ($self->check_features($self->get_assignment('requires'),
5017 $self->get_assignment('avoids'),
5018 1)) {
5019 my $webapp = $self->get_assignment('webapp');
5020 my $ntwp = $self->need_to_write_project();
5021 if ($webapp || $ntwp) {
5022 if ($webapp && !$self->webapp_supported()) {
5023 $self->warning("Web Applications are not supported by this type.");
5025 else {
5026 ## A return value of 2 from need_to_write_project() indicates
5027 ## that the only reason that we need to write the project is that
5028 ## there are custom input files (i.e., no source or resource
5029 ## files).
5030 $self->process_assignment('custom_only', '1') if ($ntwp == 2);
5032 if ($self->get_assignment('custom_only')) {
5033 $self->remove_non_custom_settings();
5036 if ($self->{'escape_spaces'}) {
5037 foreach my $name ('exename', 'sharedname', 'staticname',
5038 'exeout', 'dllout', 'libout') {
5039 my $value = $self->get_assignment($name);
5040 if (defined $value && $value =~ s/(\s)/\\$1/g) {
5041 $self->process_assignment($name, $value);
5044 foreach my $key (keys %{$self->{'valid_components'}}) {
5045 my $names = $self->{$key};
5046 foreach my $name (keys %$names) {
5047 foreach my $key (keys %{$$names{$name}}) {
5048 foreach my $file (@{$$names{$name}->{$key}}) {
5049 $file =~ s/(\s)/\\$1/g;
5056 ## Hook for implementing type-specific behavior.
5057 ($status, $error) = $self->pre_write_output_file($webapp);
5058 if (!$status) {
5059 return $status, $error;
5061 ## We don't need to pass a file name here. write_output_file()
5062 ## will determine the file name for itself.
5063 ($status, $error) = $self->write_output_file($webapp);
5065 ## Write the .ins file if the user requested it and we were
5066 ## successful.
5067 if ($self->{'generate_ins'} && $status) {
5068 ($status, $error) = $self->write_install_file();
5072 elsif ($self->warn_useless_project()) {
5073 my $msg = $self->transform_file_name($self->project_file_name()) .
5074 " has no useful targets.";
5076 if ($self->{'current_input'} eq '') {
5077 $self->information($msg);
5079 else {
5080 $self->warning($msg);
5085 return $status, $error;
5089 sub get_project_info {
5090 return $_[0]->{'project_info'};
5094 sub get_lib_locations {
5095 if ($_[0]->{'pid'} eq 'child') {
5096 my $lib_locs;
5097 for my $k (sort { substr($a, 0 , index ($a, '|')) <=>
5098 substr ($b, 0, index ($b, '|')) } keys %{$_[0]->{'lib_locations'}}) {
5100 # if we are a worker, we need to strip leading 'number|'
5101 my $x = $_[0]->{'lib_locations'}->{$k};
5102 $x =~ s/\d+\|//;
5104 $lib_locs->{substr ($k, index ($k, '|') + 1)} = $x;
5106 return $lib_locs
5108 else {
5109 return $_[0]->{'lib_locations'};
5114 sub get_inheritance_tree {
5115 return $_[0]->{'inheritance_tree'};
5119 sub set_component_extensions {
5120 my $self = shift;
5121 my $vc = $self->{'valid_components'};
5122 my $ec = $self->{'exclude_components'};
5124 foreach my $key (keys %$vc) {
5125 my $ov = $self->override_valid_component_extensions($key,
5126 @{$$vc{$key}});
5127 $$vc{$key} = $ov if (defined $ov);
5130 foreach my $key (keys %$ec) {
5131 my $ov = $self->override_exclude_component_extensions($key,
5132 @{$$ec{$key}});
5133 $$ec{$key} = $ov if (defined $ov);
5138 sub get_component_extensions {
5139 my($self, $comp) = @_;
5140 my @ext;
5141 if (defined $self->{'valid_components'}->{$comp}) {
5142 ## Build up an array of extensions. Since they are stored as regular
5143 ## expressions, we need to remove the escaped period to provide the
5144 ## minimal amount of text for each extension to provide maximum
5145 ## flexibility within the project template.
5146 foreach my $re (@{$self->{'valid_components'}->{$comp}}) {
5147 push(@ext, $re);
5148 $ext[$#ext] =~ s/\\\.//;
5151 return @ext;
5155 sub set_source_listing_callback {
5156 my($self, $cb) = @_;
5157 $self->{'source_callback'} = $cb;
5161 sub reset_values {
5162 my $self = shift;
5164 ## Only put data structures that need to be cleared
5165 ## out when the mpc file is done being read, not at the
5166 ## end of each project within the mpc file. Those go in
5167 ## the closing curly brace section of parse_line().
5168 $self->{'project_info'} = [];
5169 $self->{'lib_locations'} = {};
5170 $self->reset_generating_types();
5174 sub add_default_matching_assignments {
5175 my $self = shift;
5176 my $lang = $self->get_language();
5178 foreach my $key (keys %{$language{$lang}->[0]}) {
5179 push(@{$language{$lang}->[2]->{$key}}, @default_matching_assignments)
5180 if (!StringProcessor::fgrep($default_matching_assignments[0],
5181 $language{$lang}->[2]->{$key}));
5186 sub reset_generating_types {
5187 my $self = shift;
5188 my $lang = $self->get_language();
5189 my %reset = ('valid_components' => $language{$lang}->[0],
5190 'custom_only_removed' => $language{$lang}->[0],
5191 'exclude_components' => $language{$lang}->[1],
5192 'matching_assignments' => $language{$lang}->[2],
5193 'generated_exts' => {},
5194 'combined_custom' => {},
5195 'valid_names' => \%validNames,
5198 foreach my $r (keys %reset) {
5199 $self->{$r} = {};
5200 foreach my $key (keys %{$reset{$r}}) {
5201 $self->{$r}->{$key} = $reset{$r}->{$key};
5205 $self->{'custom_types'} = {};
5206 $self->{'define_custom_parent'} = {};
5208 ## Allow subclasses to override the default extensions
5209 $self->set_component_extensions();
5213 sub get_template_input {
5214 my $self = shift;
5215 my $lang = $self->get_language();
5217 ## This follows along the same logic as read_template_input() by
5218 ## checking for exe target and then defaulting to a lib target
5219 if ($self->exe_target()) {
5220 if ($self->get_static() == 1) {
5221 return $self->{'lib_exe_template_input'}->{$lang}->{$tikey};
5223 else {
5224 return $self->{'dll_exe_template_input'}->{$lang}->{$tikey};
5228 if ($self->get_static() == 1) {
5229 return $self->{'lib_template_input'}->{$lang}->{$tikey};
5232 return $self->{'dll_template_input'}->{$lang}->{$tikey};
5236 sub update_project_info {
5237 my($self, $tparser, $append, $names, $sep) = @_;
5238 my $value = '';
5239 $sep = '' if (!defined $sep);
5241 ## Append the values of all names into one string
5242 my $ncount = scalar(@$names) - 1;
5243 for(my $i = 0; $i <= $ncount; $i++) {
5244 $value .= $self->translate_value(
5245 $$names[$i],
5246 $tparser->get_value_with_default($$names[$i]));
5247 $value .= $sep if ($i != $ncount);
5250 ## There may be more than one template associated with this project
5251 ## creator. If there is, we can only add one generated file and we
5252 ## rely on the project creator to tell us which template generates the
5253 ## file that we need to track.
5254 if ($self->file_visible($self->{'current_template'})) {
5255 ## If we already have an array, take the one off the top. Otherwise,
5256 ## create a new one which will be added below.
5257 my $arr = ($append && defined $self->{'project_info'}->[0] ?
5258 pop(@{$self->{'project_info'}}) : []);
5260 ## Set up the hash table when we are starting a new project_info
5261 $self->{'project_info_hash_table'} = {} if (!$append);
5263 ## If we haven't seen this value yet, put it on the array
5264 if (!defined $self->{'project_info_hash_table'}->{"@$names $value"}) {
5265 $self->{'project_info_hash_table'}->{"@$names $value"} = 1;
5266 push(@$arr, $value);
5269 ## Always push the array back onto the project_info
5270 push(@{$self->{'project_info'}}, $arr);
5273 return $value;
5277 sub access_pi_values {
5278 my $self = shift;
5279 my $pjs = shift;
5280 my $proj = shift;
5282 ## This will use the keys left in @_ as indices into the project
5283 ## info array. But, if the user wants configurations, we need to
5284 ## pop that key off and access it along with all the rest of the
5285 ## elements in the array. The CONFIGURATIONS key should always
5286 ## be last if it's included at all. If it's not, the caller will
5287 ## only receive the first configuration instead of all of them.
5288 if ($_[$#_] == CONFIGURATIONS) {
5289 my $last = scalar(@{$$pjs{$proj}}) - 1;
5290 pop(@_);
5291 return @{$$pjs{$proj}}[@_], @{$$pjs{$proj}}[CONFIGURATIONS..$last];
5294 return @{$$pjs{$proj}}[@_];
5298 sub adjust_value {
5299 my($self, $names, $value, $tp) = @_;
5300 my $atemp = $self->get_addtemp();
5302 ## Perform any additions, subtractions
5303 ## or overrides for the template values.
5304 foreach my $name (@$names) {
5305 if (defined $name && defined $atemp->{lc($name)}) {
5306 my $lname = lc($name);
5307 my $base = $lname;
5308 $base =~ s/.*:://;
5310 ## If the template variable is a complex name, then we need to make
5311 ## sure that the mapped value belongs to the correct type based on
5312 ## the base of the complex name. The $tp (TemplateParser) variable
5313 ## will, in the majority of all calls to this method, be defined so
5314 ## it is checked second to avoid checking it if the name isn't
5315 ## complex.
5316 if ($base =~ /(.+)\->/ && defined $tp) {
5317 my $v = $tp->get_value($1);
5318 if (defined $v) {
5319 my $found = undef;
5320 foreach my $val (@{$atemp->{$lname}}) {
5321 if (defined $$val[3]) {
5322 my $mapped = $self->{'valid_names'}->{$$val[3]};
5323 if (defined $mapped && UNIVERSAL::isa($mapped, 'ARRAY')) {
5324 $found = 1 if ($v ne $$mapped[0]);
5326 last;
5329 next if ($found);
5333 my $replace = (defined $self->{'valid_names'}->{$base} &&
5334 ($self->{'valid_names'}->{$base} & 0x04) == 0);
5335 foreach my $val (@{$atemp->{$lname}}) {
5336 if ($replace && index($$val[1], '<%') >= 0) {
5337 $$val[1] = $self->replace_parameters($$val[1],
5338 $self->{'command_subs'});
5340 my $arr = $self->create_array($$val[1]);
5341 if ($$val[0] > 0) {
5342 if (!defined $value) {
5343 $value = '';
5345 if (UNIVERSAL::isa($value, 'ARRAY')) {
5346 ## Avoid adding duplicates. If the existing array contains
5347 ## the value already, remove it from the newly created array.
5348 for(my $i = 0; $i < scalar(@$value); $i++) {
5349 if (StringProcessor::fgrep($$value[$i], $arr)) {
5350 splice(@$value, $i, 1);
5351 $i--;
5355 ## We need to make $value a new array reference ($arr)
5356 ## to avoid modifying the array reference pointed to by $value
5357 unshift(@$arr, @$value);
5358 $value = $arr;
5360 else {
5361 $value .= " $$val[1]";
5364 elsif ($$val[0] < 0) {
5365 if (defined $value) {
5366 my $parts;
5367 if (UNIVERSAL::isa($value, 'ARRAY')) {
5368 $parts = $value;
5370 else {
5371 $parts = $self->create_array($value);
5374 $value = [];
5375 foreach my $part (@$parts) {
5376 if ($part ne '') {
5377 push(@$value, $part) if (!StringProcessor::fgrep($part, $arr));
5382 else {
5383 ## If the user set the variable to empty, then we need to
5384 ## set the value to undef
5385 $value = (defined $$arr[0] ? $arr : undef);
5388 last;
5392 return $value;
5396 sub get_verbatim {
5397 my($self, $marker) = @_;
5398 my $str;
5399 my $thash = $self->{'verbatim'}->{$self->{'pctype'}};
5401 if (defined $thash) {
5402 if (defined $thash->{$marker}) {
5403 my $crlf = $self->crlf();
5404 foreach my $line (@{$thash->{$marker}}) {
5405 $str = '' if (!defined $str);
5406 $str .= $self->process_special($line) . $crlf;
5408 if (defined $str) {
5409 $str .= $crlf;
5410 $self->{'verbatim_accessed'}->{$self->{'pctype'}}->{$marker} = 1;
5415 return $str;
5419 sub generate_recursive_input_list {
5420 my($self, $dir, $exclude) = @_;
5421 return $self->extension_recursive_input_list($dir,
5422 $exclude,
5423 $ProjectCreatorExtension);
5427 sub get_modified_project_file_name {
5428 my($self, $name, $ext) = @_;
5429 my $nmod = $self->get_name_modifier();
5431 ## We don't apply the name modifier to the project file
5432 ## name if we have already applied it to the project name
5433 ## since the project file name comes from the project name.
5434 if (defined $nmod && !$self->get_apply_project()) {
5435 $nmod =~ s/\*/$name/g;
5436 $name = $nmod;
5438 return "$name$ext";
5442 sub get_valid_names {
5443 return $_[0]->{'valid_names'};
5447 sub get_feature_parser {
5448 return $_[0]->{'feature_parser'};
5452 sub preserve_assignment_order {
5453 my($self, $name) = @_;
5454 my $mapped = $self->{'valid_names'}->{$name};
5456 ## Only return the value stored in the valid_names hash map if it's
5457 ## defined and it's not an array reference. The array reference is
5458 ## a keyword mapping and all mapped keywords should have preserved
5459 ## assignment order.
5460 if (defined $mapped && !UNIVERSAL::isa($mapped, 'ARRAY')) {
5461 return ($mapped & 1);
5464 return 1;
5468 sub add_to_template_input_value {
5469 my($self, $name) = @_;
5470 my $mapped = $self->{'valid_names'}->{$name};
5472 ## Only return the value stored in the valid_names hash map if it's
5473 ## defined and it's not an array reference. The array reference is
5474 ## a keyword mapping and no mapped keywords should be added to
5475 ## template input variables.
5476 if (defined $mapped && !UNIVERSAL::isa($mapped, 'ARRAY')) {
5477 return ($mapped & 2);
5480 return 0;
5484 sub dependency_combined_static_library {
5485 #my $self = shift;
5486 return defined $ENV{MPC_DEPENDENCY_COMBINED_STATIC_LIBRARY};
5490 sub translate_value {
5491 my($self, $key, $val) = @_;
5493 if ($key eq 'after' && $val ne '') {
5494 my $arr = $self->create_array($val);
5495 $val = '';
5497 if ($self->require_dependencies()) {
5498 foreach my $entry (@$arr) {
5499 if ($self->get_apply_project()) {
5500 my $nmod = $self->get_name_modifier();
5501 if (defined $nmod) {
5502 $nmod =~ s/\*/$entry/g;
5503 $entry = $nmod;
5506 $val .= '"' . ($self->dependency_is_filename() ?
5507 $self->project_file_name($entry) : $entry) . '" ';
5509 $val =~ s/\s+$//;
5512 return $val;
5516 sub requires_parameters {
5517 #my $self = shift;
5518 #my $name = shift;
5519 return $custom{$_[1]};
5523 sub project_file_name {
5524 my($self, $name, $template) = @_;
5526 ## Fill in the name if one wasn't provided
5527 $name = $self->get_assignment('project_name') if (!defined $name);
5529 ## Apply the transformation so that any name modifiers are utilized.
5530 return $self->get_modified_project_file_name(
5531 $self->project_file_prefix() .
5532 $self->transform_file_name($name),
5533 $self->project_file_extension());
5537 sub remove_non_custom_settings {
5538 my $self = shift;
5540 ## Remove any files that may have automatically been added
5541 ## to this project. If they were explicitly added, then we
5542 ## will leave them in the project.
5543 foreach my $key (keys %{$self->{'custom_only_removed'}}) {
5544 if ($self->{'defaulted'}->{$key}) {
5545 $self->{$key} = {};
5549 ## Unset the exename, sharedname and staticname
5550 $self->process_assignment('exename', undef);
5551 $self->process_assignment('sharedname', undef);
5552 $self->process_assignment('staticname', undef);
5556 sub remove_wanted_extension {
5557 my($self, $name, $array) = @_;
5559 foreach my $wanted (@$array) {
5560 return $name if ($name =~ s/$wanted$//);
5563 ## If the user provided file does not match any of the
5564 ## extensions specified by the custom definition, we need
5565 ## to remove the extension or else this file will not be
5566 ## added to the project.
5567 $name =~ s/\.[^\.]+$//;
5568 return $name;
5572 sub resolve_alias {
5573 if (index($_[1], 'install') >= 0) {
5574 my $resolved = $_[1];
5575 if ($resolved =~ s/(.*::)install$/$1exeout/) {
5577 elsif ($resolved eq 'install') {
5578 $resolved = 'exeout';
5580 return $resolved;
5582 return $_[1];
5586 sub create_feature_parser {
5587 my($self, $features, $feature) = @_;
5588 my $gfeature = $self->{'gfeature_file'};
5589 my $typefeaturef = (defined $gfeature ?
5590 $self->mpc_dirname($gfeature) . '/' : '') .
5591 $self->{'pctype'} . '.features';
5592 $typefeaturef = undef if (! -r $typefeaturef);
5593 if (defined $feature && $feature !~ /[\/\\]/i) {
5594 my $searched = $self->search_include_path($feature);
5595 $feature = $searched if (defined $searched);
5597 my $fp = new FeatureParser($features,
5598 $gfeature,
5599 $typefeaturef,
5600 $feature);
5602 my $slo = $fp->get_value($static_libs_feature);
5603 if (!defined $slo) {
5604 my $sval = $self->get_static() || 0;
5605 $fp->parse_line(undef,
5606 $static_libs_feature . ' = ' . $sval);
5609 return $fp;
5613 sub restore_state_helper {
5614 my($self, $skey, $old, $new) = @_;
5616 if ($skey eq 'feature_file') {
5617 if ($self->{'features_changed'} ||
5618 !(!defined $old && !defined $new ||
5619 (defined $old && defined $new && $old eq $new))) {
5620 ## Create a new feature parser. This relies on the fact that
5621 ## 'features' is restored first in restore_state().
5622 $self->{'feature_parser'} = $self->create_feature_parser(
5623 $self->get_features(), $new);
5624 $self->{'features_changed'} = undef;
5627 elsif ($skey eq 'ti') {
5628 my $lang = $self->get_language();
5629 my @keys = keys %$old;
5630 @keys = keys %$new if (!defined $keys[0]);
5631 foreach my $key (@keys) {
5632 if (!defined $$old{$key} || !defined $$new{$key} ||
5633 $$old{$key} ne $$new{$key}) {
5634 ## Clear out the template input reader that we're currently set
5635 ## to use.
5636 $self->{$key . '_template_input'}->{$lang}->{$tikey} = undef;
5640 elsif ($skey eq 'features') {
5641 ## If the user has changed the 'features' setting, then we need to
5642 ## make sure that we create a new feature parser regardless of
5643 ## whether or not the feature file has changed.
5644 $self->{'features_changed'} = ("@$old" ne "@$new");
5646 elsif ($skey eq 'language') {
5647 if ($old ne $new) {
5648 $self->add_default_matching_assignments();
5654 sub get_initial_relative_values {
5655 return $_[0]->{'expanded'}, 1;
5658 sub add_main_function {
5659 my $langmain = shift;
5661 ## See if a language was supplied.
5662 if ($langmain =~ /([^:]+):(.+)/) {
5663 ## If the language supplied is not one that we know about, return an
5664 ## error message.
5665 return 'Invalid language: ' . $1 if (!defined $language{$1});
5667 ## Otherwise, add it to the list for the language.
5668 push(@{$mains{$1}}, $2);
5670 else {
5671 ## No language was supplied, so add the main to all of the languages
5672 ## that we support.
5673 foreach my $lang (keys %language) {
5674 push(@{$mains{$lang}}, $langmain);
5678 ## Return no error message.
5679 return undef;
5682 sub get_resource_tag {
5683 my $self = shift;
5684 my $lang = $self->get_language();
5686 ## Not all entries in the %language map have a resource tag.
5687 ## For this, we will just return the tag for C++ since it probably
5688 ## doesn't really matter anyway.
5689 return defined $language{$lang}->[5] ? $language{$lang}->[5] : $cppresource;
5692 sub find_command_helper {
5693 my($self, $tag) = @_;
5695 ## No tag results in no command helper
5696 return undef if (!defined $tag);
5698 ## See if we have a command helper for this tag
5699 my $ch = CommandHelper::get($tag);
5700 return $ch if (defined $ch);
5702 ## None for the base define custom, try again with the parent
5703 return $self->find_command_helper($self->{'define_custom_parent'}->{$tag});
5706 sub get_dependency_attribute {
5707 ## Return the dependency attribute specified as the first parameter to
5708 ## this method (not counting the ProjectCreator object).
5709 return $_[0]->{'dependency_attributes'}->{$_[1]};
5712 sub valid_project_name {
5713 #my($self, $name) = @_;
5714 return $_[1] !~ /[\/\\=\?:&"<>|#%]/;
5718 sub append_flag_override {
5719 ## Append $value to the flag_overrides for <$tag, $input, $key>
5720 my $self = shift;
5721 my $tag = shift;
5722 my $key = shift;
5723 my $input = shift;
5724 my $value = shift;
5725 return if !defined $value || $value eq '';
5726 my %join = ('postcommand' => ' ' . $self->{'command_subs'}->{'and'} . ' ');
5727 my $sep = ($join{$key}) ? $join{$key} : ' ';
5728 my $fo = $self->{'flag_overrides'}->{$tag};
5729 $fo->{$input}->{$key} .= ($fo->{$input}->{$key} ? $sep : '') . $value;
5733 # Some project types can't represent the same input file being used by
5734 # more than one custom type. This function will look for such cases and
5735 # combine them into a single invocation of a synthetic custom type that
5736 # inherits properties from both of them.
5737 # Project types needing this transformation should call this function from
5738 # their overridden pre_write_output_file() method.
5739 sub combine_custom_types {
5740 my $self = shift;
5741 my %input; # (input_file_name => [custom1_files, custom2_files], ...)
5742 my $fo = $self->{'flag_overrides'};
5743 my %gendir; # (input_file_name => {directory => count}, ...)
5745 # Build the %input data structure as an index of how each input file is used.
5746 foreach my $tag (keys %{$self->{'generated_exts'}}) {
5747 foreach my $complist (values %{$self->{$tag}}) {
5748 foreach my $group (keys %$complist) {
5749 foreach my $in (@{$complist->{$group}}) {
5750 # only add to %input if some command would be run for this type
5751 my $ustyle = $in;
5752 $ustyle =~ s/\\/\//g if $self->{'convert_slashes'};
5753 my $dir = $self->mpc_dirname($ustyle);
5754 my $of = (!defined $fo->{$tag} ? undef :
5755 (defined $fo->{$tag}->{$ustyle} ? $ustyle :
5756 (defined $fo->{$tag}->{$dir} ? $dir : undef)));
5757 if ($self->{'generated_exts'}->{$tag}->{'command'} ||
5758 (defined $of && $fo->{$tag}->{$of}->{'command'})) {
5759 push(@{$input{$in}}, $tag);
5760 if (defined $fo->{$tag}->{$of}->{'gendir'}) {
5761 $gendir{$in}->{$fo->{$tag}->{$of}->{'gendir'}}++;
5769 # For each input file used in multiple custom types, move it into the new
5770 # synthetic type.
5771 foreach my $in (keys %input) {
5772 next if scalar @{$input{$in}} < 2;
5773 my $combo_tag = join('_and_', map {/(.+)_files$/; $1} @{$input{$in}})
5774 . '_files';
5775 if (!$self->{'combined_custom'}->{$combo_tag}) {
5776 $self->{'combined_custom'}->{$combo_tag} = $input{$in};
5777 $self->process_assignment_add('custom_types', $combo_tag);
5778 my $ge = $self->{'generated_exts'}->{$combo_tag} = {};
5780 my $combo_vc = $self->{'valid_components'}->{$combo_tag} = [];
5781 foreach my $tag (@{$input{$in}}) {
5782 StringProcessor::merge($combo_vc, $self->{'valid_components'}->{$tag});
5783 if ($self->{'generated_exts'}->{$tag}->{'libpath'}) {
5784 $ge->{'libpath'} .= ($ge->{'libpath'} ?
5785 $self->{'command_subs'}->{'pathsep'} : '') .
5786 $self->{'generated_exts'}->{$tag}->{'libpath'};
5789 $fo->{$combo_tag} = {};
5790 my @keys = keys %custom;
5791 push(@keys, @default_matching_assignments);
5792 $self->{'matching_assignments'}->{$combo_tag} = \@keys;
5795 my @gendir_keys = keys %{$gendir{$in}};
5796 if ($#gendir_keys == 0) {
5797 $fo->{$combo_tag}->{$in}->{'gendir'} = $gendir_keys[0];
5800 # Add to new type -- groups aren't relevant here, so just use the default
5801 push(@{$self->{$combo_tag}->{'default'}->{'default_group'}}, $in);
5803 # Remove from existing types
5804 my $override_recurse = 0;
5805 foreach my $tag (@{$input{$in}}) {
5806 foreach my $complist (values %{$self->{$tag}}) {
5807 foreach my $group (keys %$complist) {
5808 foreach my $idx (0 .. $#{$complist->{$group}}) {
5809 if ($complist->{$group}->[$idx] eq $in) {
5810 splice(@{$complist->{$group}}, $idx, 1);
5815 if (defined $fo->{$tag} && defined $fo->{$tag}->{$in} &&
5816 defined $fo->{$tag}->{$in} && $fo->{$tag}->{$in}->{'recurse'}) {
5817 ++$override_recurse;
5819 foreach my $k ('dependent', 'dependent_libs', 'postcommand') {
5820 $self->append_flag_override($combo_tag, $k, $in,
5821 (defined $fo && defined $fo->{$k})
5822 ? $fo->{$k}
5823 : $self->{'generated_exts'}->{$tag}->{$k});
5827 # If all existing uses agree to recurse, the new type should recurse too
5828 if ($override_recurse == scalar @{$input{$in}}) {
5829 $fo->{$combo_tag}->{$in}->{'recurse'} = 1;
5834 return 1;
5838 # ************************************************************
5839 # Accessors used by support scripts
5840 # ************************************************************
5842 sub getKeywords {
5843 return \%validNames;
5846 sub getValidComponents {
5847 my $language = shift;
5848 return (defined $language{$language} ? $language{$language}->[0] : undef);
5851 # ************************************************************
5852 # Virtual Methods To Be Overridden
5853 # ************************************************************
5855 sub get_builtin_output {
5856 #my($self, $input) = @_;
5857 return [];
5860 sub languageSupported {
5861 #my $self = shift;
5862 return $_[0]->get_language() eq Creator::cplusplus;
5865 sub file_visible {
5866 #my($self, $template) = @_;
5867 return 1;
5870 sub webapp_supported {
5871 #my $self = shift;
5872 return 0;
5876 sub use_win_compatibility_commands {
5877 #my $self = shift;
5878 return $ENV{MPC_USE_WIN_COMMANDS};
5882 sub post_file_creation {
5883 #my $self = shift;
5884 #my $file = shift;
5885 return undef;
5889 sub escape_spaces {
5890 #my $self = shift;
5891 return 0;
5895 sub validated_directory {
5896 my($self, $dir) = @_;
5897 return $dir;
5900 sub get_quote_symbol {
5901 #my $self = shift;
5902 return '"';
5905 sub get_escaped_quote_symbol {
5906 #my $self = shift;
5907 return '\\\"';
5910 sub get_gt_symbol {
5911 #my $self = shift;
5912 return '>';
5916 sub get_lt_symbol {
5917 #my $self = shift;
5918 return '<';
5922 sub get_and_symbol {
5923 #my $self = shift;
5924 return '&&';
5928 sub get_or_symbol {
5929 #my $self = shift;
5930 return '||';
5934 sub get_cmdsep_symbol {
5935 #my $self = shift;
5936 return ';';
5940 sub dollar_special {
5941 #my $self = shift;
5942 return 0;
5946 sub expand_variables_from_template_values {
5947 #my $self = shift;
5948 return 1;
5952 sub require_dependencies {
5953 #my $self = shift;
5954 return 1;
5958 sub dependency_is_filename {
5959 #my $self = shift;
5960 return 1;
5964 sub fill_value {
5965 #my $self = shift;
5966 #my $name = shift;
5967 return undef;
5971 sub project_file_prefix {
5972 #my $self = shift;
5973 return '';
5977 sub project_file_extension {
5978 #my $self = shift;
5979 return '';
5983 sub override_valid_component_extensions {
5984 #my $self = shift;
5985 #my $comp = shift;
5986 return undef;
5990 sub override_exclude_component_extensions {
5991 #my $self = shift;
5992 #my $comp = shift;
5993 return undef;
5997 sub get_dll_exe_template_input_file {
5998 #my($self, $tkey) = @_;
5999 return undef;
6003 sub get_lib_exe_template_input_file {
6004 my($self, $tkey) = @_;
6005 return $self->get_dll_exe_template_input_file($tkey);
6009 sub get_lib_template_input_file {
6010 my($self, $tkey) = @_;
6011 return $self->get_dll_template_input_file($tkey);
6015 sub get_dll_template_input_file {
6016 #my($self, $tkey) = @_;
6017 return undef;
6021 sub get_template {
6022 return $_[0]->{'pctype'};
6025 sub requires_forward_slashes {
6026 return 0;
6029 sub warn_useless_project {
6030 return 1;
6033 sub pre_write_output_file {
6034 return 1;