Merge pull request #178 from DOCGroup/elliottc/more_databases
[MPC.git] / modules / ProjectCreator.pm
blob5776ea722e881e4ab05d6e33ae8edd78e8c6a22f
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;
356 $self->{'forcount'} = 0;
358 $self->add_default_matching_assignments();
359 $self->reset_generating_types();
361 $self->{'pid'} = $pid;
362 $self->{'llctr'} = 0; # counts the hash insertion order for mp-mpc
364 return $self;
368 sub is_keyword {
369 ## Is the name passed in a known keyword for a project. This includes
370 ## keywords mapped by Define_Custom or Modify_Custom.
371 my($self, $name) = @_;
372 return $self->{'valid_names'}->{$name};
376 sub read_global_configuration {
377 my $self = shift;
378 my $input = $self->get_global_cfg();
379 my $status = 1;
381 if (defined $input) {
382 ## If it doesn't contain a path, search the include path
383 if ($input !~ /[\/\\]/) {
384 $input = $self->search_include_path($input);
385 $input = $self->get_global_cfg() if (!defined $input);
388 ## Read and parse the global project file
389 $self->{'reading_global'} = 1;
390 $status = $self->parse_file($input);
391 $self->{'reading_global'} = 0;
394 return $status;
398 sub convert_to_template_assignment {
399 my($self, $name, $value, $calledfrom) = @_;
401 ## If the value we are going to set for $name has been used as a
402 ## scoped template variable, we need to hijack the whole assignment
403 ## and turn it into a template variable assignment.
404 my $atemp = $self->get_addtemp();
405 foreach my $key (grep(/::$name$/, keys %$atemp)) {
406 $self->update_template_variable(0, $calledfrom, $key, $value);
411 sub create_recursive_settings {
412 my($self, $name, $value, $assign) = @_;
414 ## Handle both recursive_includes and recursive_libpaths in one
415 ## search and replace.
416 if ($name =~ s/^recursive_//) {
417 ## This portion of code was lifted directly from Creator::relative()
418 ## but modified to always expand the variables. We will turn the
419 ## expanded values back into variables below and once they're passed
420 ## off to the assignment processing code, they will be turned into
421 ## relative values (if possible).
422 if (index($value, '$') >= 0) {
423 my $ovalue = $value;
424 my($rel, $how) = $self->get_initial_relative_values();
425 $value = $self->expand_variables($value, $rel, 0, undef, 1);
427 if ($ovalue eq $value || index($value, '$') >= 0) {
428 ($rel, $how) = $self->get_secondary_relative_values();
429 $value = $self->expand_variables($value, $rel, 0, undef, 1, 1);
433 ## Create an array out of the recursive directory list. Convert all
434 ## of the relative or full path values back into $() values.
435 my @dirs = ();
436 my $elems = $self->create_array($value);
437 foreach my $elem (@$elems) {
438 my $dlist = $self->recursive_directory_list($elem, []);
439 if ($dlist eq '') {
440 ## This directory doesn't exist, just add the original value
441 push(@dirs, $elem);
443 else {
444 ## Create an array out of the directory list and add it to our
445 ## array.
446 my $array = $self->create_array($dlist);
447 push(@dirs, @$array);
451 ## We need to return a string, so we join it all together space
452 ## separated.
453 $value = join(' ', $self->back_to_variable(\@dirs));
456 return $name, $value;
459 sub process_assignment {
460 my($self, $name, $value, $assign, $calledfrom) = @_;
461 $calledfrom = 0 if (!defined $calledfrom);
463 ## See if the name is one of the special "recursive" settings. If so,
464 ## fix up the value and change the name.
465 ($name, $value) = $self->create_recursive_settings($name, $value, $assign);
467 if (defined $value) {
468 if ($name eq 'after') {
469 mpc_debug::chkpnt_pre_after_keyword_assignment($name, $value, $assign, $calledfrom);
470 ## Support dependency attributes. They may or may not be used by
471 ## the project or workspace creator implementation. They are
472 ## stored separately from the dependencies themselves. Also, note
473 ## that a value to be added may contain more than one element to be
474 ## added. This function will be called for each one, so we only
475 ## need to handle one at a time.
476 if ($value =~ s/(\s*([^:]+)):([^\s]+)/$1/) {
477 ## The value may contain multiple projects. But, only one
478 ## dependency attribute will be present at any time. So, once we
479 ## get here, we need to remove any of the other projects from the
480 ## front of the key string.
481 my $key = $2;
482 my $value = $3;
483 $key =~ s/.*\s+//;
484 $self->{'dependency_attributes'}->{$key} = $value;
487 ## Check the after value and warn the user in the event that it
488 ## contains a value that can not be used within a project name.
489 if (!$self->valid_project_name($value)) {
490 $self->warning("after '$value' contains an invalid project name in " .
491 $self->{'current_input'} . ' at line ' .
492 $self->get_line_number() . '.');
495 ## Support the '*' mechanism as in the project name, to allow
496 ## the user to correctly depend on another project within the same
497 ## directory.
498 if (index($value, '*') >= 0) {
499 $value = $self->fill_type_name($value,
500 $self->get_default_project_name());
502 mpc_debug::chkpnt_post_after_keyword_assignment($name, $value, $assign, $calledfrom);
504 ## Support the '*' mechanism for libs assignment as well.
505 elsif ($name eq 'libs' && index($value, '*') >= 0) {
506 $value = $self->fill_type_name($value, $self->get_default_project_name());
509 ## If this particular project type does not consider the dollar sign
510 ## special and the user has provided two dollarsigns as an escape, we
511 ## will turn it into a single dollar sign.
512 if (!$self->{'dollar_special'} && index($value, '$$') >= 0) {
513 $value =~ s/\$\$/\$/g;
516 ## If the assignment name is valid and requires parameter (<%...%>)
517 ## replacement, then do so. But, only do so on actual keywords.
518 ## User defined keywords must not have the parameters replaced in
519 ## order for them to get the correct replacement values later on.
520 if (defined $validNames{$name} &&
521 ($validNames{$name} & 0x04) == 0 && index($value, '<%') >= 0) {
522 $value = $self->replace_parameters($value, $self->{'command_subs'});
526 if ($calledfrom == 0) {
527 $self->convert_to_template_assignment($name, $value, $calledfrom);
530 ## Call the base process_assigment() after we have modified the name and
531 ## value.
532 $self->SUPER::process_assignment($name, $value, $assign);
534 ## Support keyword mapping here only at the project level scope. The
535 ## scoped keyword mapping is done through the parse_scoped_assignment()
536 ## method.
537 if (!defined $assign || $assign == $self->get_assignment_hash()) {
538 my $mapped = $self->{'valid_names'}->{$name};
539 if (defined $mapped && UNIVERSAL::isa($mapped, 'ARRAY')) {
540 $self->parse_scoped_assignment($$mapped[0], 0,
541 $$mapped[1], $value,
542 $self->{'generated_exts'}->{$$mapped[0]});
548 sub process_assignment_add {
549 my($self, $name, $value, $assign) = @_;
551 ## See if the name is one of the special "recursive" settings. If so,
552 ## fix up the value and change the name.
553 ($name, $value) = $self->create_recursive_settings($name, $value, $assign);
555 return $self->SUPER::process_assignment_add($name, $value, $assign);
559 sub process_assignment_sub {
560 my($self, $name, $value, $assign) = @_;
562 ## See if the name is one of the special "recursive" settings. If so,
563 ## fix up the value and change the name.
564 ($name, $value) = $self->create_recursive_settings($name, $value, $assign);
566 ## If the assignment name is valid and requires parameter (<%...%>)
567 ## replacement, then do so. But, only do so on actual keywords.
568 ## User defined keywords must not have the parameters replaced in
569 ## order for them to get the correct replacement values later on.
570 if (defined $validNames{$name} &&
571 ($validNames{$name} & 0x04) == 0 && index($value, '<%') >= 0) {
572 $value = $self->replace_parameters($value, $self->{'command_subs'});
575 return $self->SUPER::process_assignment_sub($name, $value, $assign);
579 sub addition_core {
580 my($self, $name, $value, $nval, $assign) = @_;
582 ## If there is a previous value ($nval) and the keyword is going to be
583 ## evaled, we need to separate the values with a command separator.
584 ## This has to be done at the MPC level because it isn't always
585 ## possible for the user to know if a value has already been added to
586 ## the keyword (prebuild, postbuild and postclean).
587 if (defined $nval &&
588 defined $validNames{$name} && ($validNames{$name} & 4)) {
589 if ($self->preserve_assignment_order($name)) {
590 $value = '<%cmdsep%> ' . $value;
592 else {
593 $value .= '<%cmdsep%>';
597 ## For an addition, we need to see if it is a project keyword being
598 ## used within a 'specific' section. If it is, we may need to update
599 ## scoped settings for that variable (which are in essence template
600 ## variables).
601 $self->convert_to_template_assignment($name, $value, 1);
603 ## Next, we just give everything to the base class method.
604 $self->SUPER::addition_core($name, $value, $nval, $assign);
608 sub subtraction_core {
609 my($self, $name, $value, $nval, $assign) = @_;
611 ## For a subtraction, we need to see if it is a project keyword being
612 ## used within a 'specific' section. If it is, we may need to update
613 ## scoped settings for that variable (which are in essence template
614 ## variables).
615 $self->convert_to_template_assignment($name, $value, -1);
617 ## Next, we just give everything to the base class method.
618 $self->SUPER::subtraction_core($name, $value, $nval, $assign);
622 sub get_assignment_for_modification {
623 my($self, $name, $assign, $subtraction) = @_;
625 ## If we weren't passed an assignment hash, then we need to
626 ## look one up that may possibly correctly deal with keyword mappings
627 if (!defined $assign) {
628 my $mapped = $self->{'valid_names'}->{$name};
630 if (defined $mapped && UNIVERSAL::isa($mapped, 'ARRAY')) {
631 $name = $$mapped[1];
632 $assign = $self->{'generated_exts'}->{$$mapped[0]};
636 ## Get the assignment value
637 my $value = $self->get_assignment($name, $assign);
639 ## If we are involved in a subtraction, we get back a value and
640 ## it's a scoped or mapped assignment, then we need to possibly
641 ## expand any template variables. Otherwise, the subtractions
642 ## may not work correctly.
643 if ($subtraction && defined $value && defined $assign) {
644 $value = $self->relative($value, 1);
647 return $value;
651 sub begin_project {
652 my($self, $parents) = @_;
653 my $status = 1;
654 my $error;
656 ## Deal with the inheritance hierarchy first
657 ## Add in the base projects from the command line
658 if (!$self->{'reading_global'} &&
659 !defined $self->{'reading_parent'}->[0]) {
660 my $baseprojs = $self->get_baseprojs();
662 if (defined $parents) {
663 StringProcessor::merge($parents, $baseprojs);
665 else {
666 $parents = $baseprojs;
670 if (defined $parents) {
671 foreach my $parent (@$parents) {
672 ## Read in the parent onto ourself
673 my $file = $self->search_include_path(
674 "$parent.$BaseClassExtension");
675 if (!defined $file) {
676 $file = $self->search_include_path(
677 "$parent.$ProjectCreatorExtension");
680 if (defined $file) {
681 if (defined $self->{'reading_parent'}->[0]) {
682 if (StringProcessor::fgrep($file, $self->{'reading_parent'})) {
683 $status = 0;
684 $error = 'Cyclic inheritance detected: ' . $parent;
688 if ($status) {
689 if (!defined $self->{'parents_read'}->{$file}) {
690 $self->{'parents_read'}->{$file} = 1;
692 ## Push the base project file onto the parent stack
693 push(@{$self->{'reading_parent'}}, $file);
695 ## Collect up some information about the inheritance tree
696 my $tree = $self->{'current_input'};
697 if (!defined $self->{'inheritance_tree'}->{$tree}) {
698 $self->{'inheritance_tree'}->{$tree} = {};
700 my $hash = $self->{'inheritance_tree'}->{$tree};
701 foreach my $p (@{$self->{'reading_parent'}}) {
702 $$hash{$p} = {} if (!defined $$hash{$p});
703 $hash = $$hash{$p};
706 ## Begin reading the parent
707 mpc_debug::chkpnt_pre_parse_base_project($file);
708 $status = $self->parse_file($file);
709 mpc_debug::chkpnt_post_parse_base_project($file, $status);
711 ## Take the base project file off of the parent stack
712 pop(@{$self->{'reading_parent'}});
714 $error = "Invalid parent: $parent" if (!$status);
716 else {
717 ## The base project has already been read. So, if
718 ## we are reading the original project (not a parent base
719 ## project), then the current base project is redundant.
720 if (!defined $self->{'reading_parent'}->[0]) {
721 $file =~ s/\.[^\.]+$//;
722 $self->information('Inheriting from \'' .
723 $self->mpc_basename($file) .
724 '\' in ' . $self->{'current_input'} .
725 ' is redundant at line ' .
726 $self->get_line_number() . '.');
731 else {
732 $status = 0;
733 $error = "Unable to locate parent: $parent";
738 ## Copy each value from global_assign into assign
739 if (!$self->{'reading_global'}) {
740 foreach my $key (keys %{$self->{'global_assign'}}) {
741 if (!defined $self->{'assign'}->{$key}) {
742 $self->{'assign'}->{$key} = $self->{'global_assign'}->{$key};
747 return $status, $error;
751 sub get_process_project_type {
752 my($self, $types) = @_;
753 my $type = '';
754 my $defcomp = $self->get_default_component_name();
756 foreach my $t (split(/\s*,\s*/, $types)) {
757 my $not = ($t =~ s/^!\s*//);
758 if ($not) {
759 if ($t eq $self->{'pctype'}) {
760 $type = '';
761 last;
763 else {
764 $type = $self->{'pctype'};
767 elsif ($t eq $self->{'pctype'} || $t eq $defcomp) {
768 $type = $t;
769 last;
773 return $type;
777 sub matches_specific_scope {
778 my($self, $elements) = @_;
780 ## First check for properties that correspond to the current project
781 ## type. Elements that begin with "prop:" indicate a property.
782 my $list = '';
783 my $props = $self->get_properties();
784 foreach my $prop (split(/\s*,\s*/, $elements)) {
785 my $not = ($prop =~ s/^!\s*//);
786 if ($prop =~/(.+):(.+)/) {
787 if ($1 eq 'prop') {
788 $prop = $2;
789 if ($not) {
790 return $self->{'pctype'} if (!$$props{$prop});
792 else {
793 return $self->{'pctype'} if ($$props{$prop});
796 else {
797 $self->warning("$prop is not recognized.");
800 else {
801 $list .= ($not ? '!' : '') . $prop . ',';
805 ## If none of the elements match a property, then check the type
806 ## against the current project type or the default component name
807 ## (which is what it would be set to if a specific clause is used with
808 ## out parenthesis).
809 my $type = $self->get_process_project_type($list);
810 return $self->{'pctype'} if ($type eq $self->{'pctype'} ||
811 $type eq $self->get_default_component_name());
813 ## Nothing matched
814 return undef;
818 sub parse_line {
819 my($self, $ih, $line) = @_;
820 my($status,
821 $errorString,
822 @values) = $self->parse_known($line, $ih);
824 ## parse_known() passes back an array of values
825 ## that make up the contents of the line parsed.
826 ## The array can have 0 to 4 items. The first,
827 ## if defined, is always an identifier of some
828 ## sort.
830 if ($status && defined $values[0]) {
831 if ($values[0] eq $self->{'grammar_type'}) {
832 my $name = $values[1];
833 my $typecheck = $self->{'type_check'};
834 if (defined $name && $name eq '}') {
835 ## Project Ending
836 if (!defined $self->{'reading_parent'}->[0] &&
837 !$self->{'reading_global'}) {
838 ## Call into the project type's pre-generation hook.
839 $self->pre_generation();
841 ## Fill in all the default values
842 $self->generate_defaults();
844 ## Perform any additions, subtractions
845 ## or overrides for the project values.
846 my $addproj = $self->get_addproj();
847 foreach my $ap (keys %$addproj) {
848 if (defined $self->{'valid_names'}->{$ap}) {
849 foreach my $val (@{$$addproj{$ap}}) {
850 if ($$val[0] > 0) {
851 $self->process_assignment_add($ap, $$val[1]);
853 elsif ($$val[0] < 0) {
854 $self->process_assignment_sub($ap, $$val[1]);
856 else {
857 $self->process_assignment($ap, $$val[1]);
861 else {
862 $errorString = 'Invalid ' .
863 "assignment modification name: $ap";
864 $status = 0;
868 if ($status) {
869 ## Generate default target names after all source files are added
870 ## and after we've added in all of the options from the
871 ## command line. If the user set exename on the command line
872 ## and no "main" is found, sharedname will be set too and
873 ## most templates do not handle that well.
874 $self->generate_default_target_names();
876 ## End of project; Write out the file.
877 ($status, $errorString) = $self->write_project();
879 ## write_project() can return 0 for error, 1 for project
880 ## was written and 2 for project was skipped
881 if ($status == 1) {
882 ## Save the library name and location
883 foreach my $name ('sharedname', 'staticname') {
884 my $val = $self->get_assignment($name);
885 if (defined $val) {
886 my $cwd = $self->getcwd();
887 my $start = $self->getstartdir();
888 my $amount = 0;
889 if ($cwd eq $start) {
890 $amount = length($start);
892 elsif (index($cwd, $start) == 0) {
893 $amount = length($start) + 1;
895 if ($self->{'pid'} eq 'child') {
896 $self->{'lib_locations'}->{$val} =
897 ++$self->{'llctr'} . '|' .
898 substr($cwd, $amount);
900 else {
902 $self->{'lib_locations'}->{$val} =
903 substr($cwd, $amount);
905 last;
909 ## Check for unused verbatim markers
910 foreach my $key (keys %{$self->{'verbatim'}}) {
911 if (defined $self->{'verbatim_accessed'}->{$key}) {
912 foreach my $ikey (keys %{$self->{'verbatim'}->{$key}}) {
913 if (!defined $self->{'verbatim_accessed'}->{$key}->{$ikey}) {
914 $self->warning("Marker $ikey does not exist.");
921 ## Reset all of the project specific data. I am explicitly
922 ## not resetting dependency_attributes. It is necessary that
923 ## this information stay for the life of the ProjectCreator
924 ## object so that the WorkspaceCreator can have access to the
925 ## information.
926 foreach my $key (keys %{$self->{'valid_components'}}) {
927 delete $self->{$key};
928 delete $self->{'defaulted'}->{$key};
930 if (defined $self->{'addtemp_state'}) {
931 $self->restore_state($self->{'addtemp_state'}, 'addtemp');
932 $self->{'addtemp_state'} = undef;
934 $self->{'assign'} = {};
935 $self->{'verbatim'} = {};
936 $self->{'verbatim_accessed'} = {$self->{'pctype'} => {}};
937 $self->{'special_supplied'} = {};
938 $self->{'flag_overrides'} = {};
939 $self->{'parents_read'} = {};
940 $self->{'inheritance_tree'} = {};
941 $self->{'remove_files'} = {};
942 $self->{'custom_special_output'} = {};
943 $self->{'custom_special_depend'} = {};
944 $self->{'expanded'} = {};
945 $self->reset_generating_types();
948 $self->{$typecheck} = 0;
950 else {
951 ## Project Beginning
952 ($status, $errorString) = $self->begin_project($values[2]);
954 ## Set up the default project name
955 if ($status) {
956 if (defined $name) {
957 if ($self->valid_project_name($name)) {
958 ## We should only set the project name if we are not
959 ## reading in a parent project.
960 if (!defined $self->{'reading_parent'}->[0]) {
961 $name =~ s/^\(\s*//;
962 $name =~ s/\s*\)$//;
963 $name = $self->transform_file_name($name);
965 ## Replace any *'s with the default name
966 if (index($name, '*') >= 0) {
967 $name = $self->fill_type_name(
968 $name,
969 $self->get_default_project_name());
972 $self->set_project_name($name);
974 else {
975 $self->warning("Ignoring project name " .
976 "$name in a base project.");
979 else {
980 $status = 0;
981 $errorString = 'Projects can not have the following in ' .
982 'the name: / \\ = ? : & " < > | # %';
987 ## Signify that we have a valid project
988 $self->{$typecheck} = 1 if ($status);
991 elsif ($values[0] eq '0') {
992 ## $values[1] = name; $values[2] = value
993 if (defined $self->{'valid_names'}->{$values[1]}) {
994 $self->process_assignment($values[1], $values[2]);
996 else {
997 $errorString = "Invalid assignment name: '$values[1]'";
998 $status = 0;
1001 elsif ($values[0] eq '1') {
1002 ## $values[1] = name; $values[2] = value
1003 if (defined $self->{'valid_names'}->{$values[1]}) {
1004 $self->process_assignment_add($values[1], $values[2]);
1006 else {
1007 $errorString = "Invalid addition name: $values[1]";
1008 $status = 0;
1011 elsif ($values[0] eq '-1') {
1012 ## $values[1] = name; $values[2] = value
1013 if (defined $self->{'valid_names'}->{$values[1]}) {
1014 $self->process_assignment_sub($values[1], $values[2]);
1016 else {
1017 $errorString = "Invalid subtraction name: $values[1]";
1018 $status = 0;
1021 elsif ($values[0] eq 'component') {
1022 my $comp = $values[1];
1023 my $name = $values[2];
1024 my @inhr = defined $values[3] ? @{$values[3]} : ();
1025 my $vc = $self->{'valid_components'};
1027 if ($comp ne 'define_custom' && @inhr != 0) {
1028 return 0, "$comp does not allow an inheritance list";
1031 if (defined $$vc{$comp}) {
1032 ($status, $errorString) = $self->parse_components($ih, $comp, $name);
1034 else {
1035 if ($comp eq 'verbatim') {
1036 my($type, $loc, $add) = split(/\s*,\s*/, $name);
1037 ($status, $errorString) = $self->parse_verbatim($ih, $type,
1038 $loc, $add);
1040 elsif ($comp eq 'specific') {
1041 my $type = $self->matches_specific_scope($name);
1042 if (defined $type) {
1043 ($status, $errorString) = $self->parse_scope(
1044 $ih, $comp, $type,
1045 $self->{'valid_names'},
1046 $self->get_assignment_hash(),
1047 {});
1049 else {
1050 ## We still need to parse the scope, but we will be
1051 ## throwing away whatever is processed. However, it
1052 ## could still be invalid code that will cause an error.
1053 ($status, $errorString) = $self->parse_scope(
1054 $ih, $comp, undef,
1055 $self->{'valid_names'},
1056 undef,
1057 $self->get_assignment_hash());
1060 elsif ($comp eq 'define_custom') {
1061 ($status, $errorString) = $self->parse_define_custom($ih, $name, 0,
1062 \@inhr);
1064 elsif ($comp eq 'modify_custom') {
1065 ($status, $errorString) = $self->parse_define_custom($ih, $name, 1);
1067 elsif ($comp eq 'expand') {
1068 $self->{'parsing_expand'} = 1;
1069 ($status, $errorString) = $self->parse_scope($ih, $comp, $name, undef);
1070 $self->{'parsing_expand'} = undef;
1072 else {
1073 $errorString = "Invalid component name: $comp";
1074 $status = 0;
1078 elsif ($values[0] eq 'feature') {
1079 $self->{'feature_defined'} = 1;
1080 ($status, $errorString) = $self->process_feature($ih,
1081 $values[1],
1082 $values[2]);
1083 if ($status && $self->{'feature_defined'}) {
1084 $errorString = "Did not find the end of the feature";
1085 $status = 0;
1088 else {
1089 $errorString = "Unrecognized line: $line";
1090 $status = 0;
1093 elsif ($status == -1) {
1094 $status = 0;
1097 return $status, $errorString;
1101 sub parse_scoped_assignment {
1102 my($self, $tag, $type, $name, $value, $flags) = @_;
1104 ## Map the assignment name on a scoped assignment
1105 my $mapped = $self->{'valid_names'}->{$name};
1106 if (defined $mapped && UNIVERSAL::isa($mapped, 'ARRAY')) {
1107 $name = $$mapped[1];
1110 if (defined $self->{'matching_assignments'}->{$tag} &&
1111 StringProcessor::fgrep($name, $self->{'matching_assignments'}->{$tag})) {
1112 my $over = {};
1113 if (defined $self->{'flag_overrides'}->{$tag}) {
1114 $over = $self->{'flag_overrides'}->{$tag};
1116 else {
1117 $self->{'flag_overrides'}->{$tag} = $over;
1120 if ($type == 0) {
1121 $self->process_assignment($name, $value, $flags);
1123 elsif ($type == 1) {
1124 ## If there is no value in $$flags, then we need to get
1125 ## the outer scope value and put it in there.
1126 if (!defined $self->get_assignment($name, $flags)) {
1127 my $outer = $self->get_assignment($name);
1128 $self->process_assignment($name, $outer, $flags);
1130 $self->process_assignment_add($name, $value, $flags);
1132 elsif ($type == -1) {
1133 ## If there is no value in $$flags, then we need to get
1134 ## the outer scope value and put it in there.
1135 if (!defined $self->get_assignment($name, $flags)) {
1136 my $outer = $self->get_assignment($name);
1137 $self->process_assignment($name, $outer, $flags);
1139 $self->process_assignment_sub($name, $value, $flags);
1141 return 1;
1144 return 0;
1148 sub update_template_variable {
1149 my $self = shift;
1150 my $check = shift;
1151 my @values = @_;
1153 ## Save the addtemp state if we haven't done so before
1154 if (!defined $self->{'addtemp_state'}) {
1155 my %state = $self->save_state('addtemp');
1156 $self->{'addtemp_state'} = \%state;
1159 ## If the name that is used within a specific is a mapped keyword
1160 ## then we need to translate it into the mapped keyword as it will
1161 ## be used by the TemplateParser.
1162 my $name;
1163 if ($values[1] =~ /(.*::)(.*)/) {
1164 my $base = $1;
1165 my $mapped = $self->{'valid_names'}->{$2};
1166 if (defined $mapped && UNIVERSAL::isa($mapped, 'ARRAY')) {
1167 $name = $values[1];
1168 $values[1] = $base . 'custom_type->' . $$mapped[1];
1172 ## Now modify the addtemp values
1173 my $atemp = $self->get_addtemp();
1174 $self->information("'$values[1]' was used as a template modifier.");
1176 if ($check && !defined $atemp->{$values[1]}) {
1177 $name = $values[1] if (!defined $name);
1178 if ($name =~ s/.*:://) {
1179 my $value = $self->get_assignment($name);
1180 ## Regardless of whether there was and assignment value, we need to
1181 ## look at the template value of the base so that modification of a
1182 ## scoped variable includes the base values.
1183 if (defined $atemp->{$name}) {
1184 foreach my $arr (@{$atemp->{$name}}) {
1185 my @copy = @$arr;
1186 push(@{$atemp->{$values[1]}}, \@copy);
1189 unshift(@{$atemp->{$values[1]}},
1190 [0, $value, undef, $name]) if (defined $value);
1194 ## Subsitute all pseudo variables for the project specific characters.
1195 $values[2] = $self->replace_parameters($values[2], $self->{'command_subs'})
1196 if (index($values[2], '<%') >= 0);
1198 if (defined $atemp->{$values[1]}) {
1199 ## If there are template variable settings, then we need to add
1200 ## this new one to the end of the settings that did not come from
1201 ## the command line. That way, adjust_value() does not need to
1202 ## sort the values (and have knowledge about which came from the
1203 ## command line and which didn't).
1204 my $max = scalar(@{$atemp->{$values[1]}});
1205 for(my $i = 0; $i < $max; $i++) {
1206 if ($atemp->{$values[1]}->[$i]->[2]) {
1207 splice(@{$atemp->{$values[1]}}, $i, 0,
1208 [$values[0], $values[2], undef, $name]);
1209 return;
1213 else {
1214 $atemp->{$values[1]} = [];
1217 ## If the variable name is not scoped, we need to look through existing
1218 ## scoped variables that match the base. If we find one, we need to
1219 ## propagate this value into the scoped settings.
1220 if (index($values[1], '::') == -1) {
1221 $name = $values[1] if (!defined $name);
1222 foreach my $key (keys %$atemp) {
1223 if ($key ne $name) {
1224 foreach my $entry (@{$atemp->{$key}}) {
1225 if (defined $$entry[3] && $$entry[3] eq $name) {
1226 push(@{$atemp->{$key}}, [$values[0], $values[2], undef, $name]);
1227 last;
1234 ## 0: (0 set, 1 add, -1 subtract)
1235 ## 1: The text value
1236 ## 2: (true set on command line, false set in project)
1237 ## 3: The original variable name if it's scoped or mapped
1238 push(@{$atemp->{$values[1]}}, [$values[0], $values[2], undef, $name]);
1242 sub handle_unknown_assignment {
1243 my $self = shift;
1244 my $type = shift;
1245 my @values = @_;
1247 ## Unknown assignments within a 'specific' section are handled as
1248 ## template value modifications. These are handled exactly as the
1249 ## -value_template option in Options.pm.
1251 ## If $type is not defined, then we are skipping this section
1252 $self->update_template_variable(1, @values) if (defined $type);
1254 return 1, undef;
1258 sub handle_scoped_unknown {
1259 my($self, $fh, $type, $flags, $line) = @_;
1261 if (defined $type && $self->{'parsing_expand'}) {
1262 if ($type eq $self->get_default_component_name()) {
1263 return 0, 'Can not set expansion in this context';
1265 else {
1266 if (!defined $self->{'expanded'}->{$type}) {
1267 my $undef = $self->replace_env_vars(\$line);
1268 if (!$undef) {
1269 ## This is a special concession for Windows. It will not allow
1270 ## you to set an empty environment variable. If an empty
1271 ## double quoted string is found, we will assume that the user
1272 ## wanted an empty string.
1273 $line = '' if ($line eq '""');
1275 $self->{'expanded'}->{$type} = $line;
1278 return 1, undef;
1282 ## If the type is not defined, then this is something other than an
1283 ## assignment in a 'specific' section and should be flagged as an error
1284 return 0, "Unrecognized line: $line";
1287 sub add_custom_depend {
1288 my($self, $tag, $key, $aref) = @_;
1290 my @deps = @$aref;
1291 if ($self->{'convert_slashes'}) {
1292 foreach my $dep (@deps) {
1293 $dep =~ s/\//\\/g;
1297 $self->{'custom_special_depend'}->{$tag}->{$key} = []
1298 unless defined $self->{'custom_special_depend'}->{$tag}->{$key};
1299 StringProcessor::merge($self->{'custom_special_depend'}->{$tag}->{$key},
1300 \@deps);
1303 sub process_component_line {
1304 my($self, $tag, $line, $fh, $flags,
1305 $grname, $current, $excarr, $comps, $count) = @_;
1306 my $status = 1;
1307 my $error;
1308 my %exclude;
1309 my @values;
1311 ## If this returns true, then we've found an assignment
1312 if ($self->parse_assignment($line, \@values, $fh)) {
1313 $status = $self->parse_scoped_assignment($tag, @values, $flags);
1314 if (!$status) {
1315 $error = 'Unknown keyword: ' . $values[1];
1318 else {
1319 ## If we successfully remove a '!' from the front, then
1320 ## the file(s) listed are to be excluded
1321 my $rem = ($line =~ s/^\^\s*//);
1322 my $exc = $rem || ($line =~ s/^!\s*//);
1324 ## Convert any $(...) in this line before we process any
1325 ## wild card characters. If we do not, scoped assignments will
1326 ## not work nor will we get the correct wild carded file list.
1327 ## We also need to make sure that any back slashes are converted to
1328 ## slashes to ensure that later flag_overrides checks will happen
1329 ## correctly.
1330 $line = $self->relative($line);
1331 $line =~ s/\\/\//g if ($self->{'convert_slashes'});
1333 ## Now look for specially listed files.
1334 ## Regular expressions are very slow. Searching the line twice with
1335 ## index() is 328 times faster than searching with just the regular
1336 ## expression when it doesn't match (which is likely to be the case).
1337 if ((index($line, '>>') >= 0 || index($line, '<<') >= 0) &&
1338 $line =~ /(.*)\s+(>>|<<)\s+(.*)/) {
1339 $line = $1;
1340 my $oop = $2;
1341 my $iop = ($oop eq '>>' ? '<<' : '>>');
1342 my $out = ($oop eq '>>' ? $3 : undef);
1343 my $dep = ($oop eq '<<' ? $3 : undef);
1345 $line =~ s/\s+$//;
1346 if (index($line, $iop) >= 0 && $line =~ /(.*)\s+$iop\s+(.*)/) {
1347 $line = $1;
1348 $out = $2 if ($iop eq '>>');
1349 $dep = $2 if ($iop eq '<<');
1350 $line =~ s/\s+$//;
1353 ## Check for both possible error conditions
1354 if (index($line, $oop) >= 0) {
1355 $status = 0;
1356 $error = "Duplicate $oop used";
1358 elsif (index($line, $iop) >= 0) {
1359 $status = 0;
1360 $error = "Duplicate $iop used";
1363 ## Keys used internally to MPC need to be in forward slash format.
1364 my $key = $line;
1365 $key =~ s/\\/\//g if ($self->{'convert_slashes'});
1366 if (defined $out) {
1367 if (!defined $self->{'custom_special_output'}->{$tag}) {
1368 $self->{'custom_special_output'}->{$tag} = {};
1370 ## We can not convert slashes here as we do for dependencies
1371 ## (below). The files specified here need to retain the forward
1372 ## slashes as they are used elsewhere.
1373 $self->{'custom_special_output'}->{$tag}->{$key} = $self->create_array($out);
1375 if (defined $dep) {
1376 $self->add_custom_depend($tag, $key, $self->create_array($dep));
1380 ## If there is a command helper, we need to add the output files
1381 ## here. It is possible that helper determined output files are
1382 ## the only files added by this component type.
1383 my $cmdHelper = $self->find_command_helper($tag);
1384 if (defined $cmdHelper) {
1385 my $key = $line;
1386 $key =~ s/\\/\//g if ($self->{'convert_slashes'});
1387 my $cmdflags = $$flags{'commandflags'};
1388 my($add_out, $deps) = $cmdHelper->get_output($key, $cmdflags);
1390 push(@{$self->{'custom_special_output'}->{$tag}->{$key}}, @$add_out);
1391 foreach my $depTag (keys %$deps) {
1392 foreach my $depFile (keys %{$deps->{$depTag}}) {
1393 $self->add_custom_depend($depTag, $depFile,
1394 $deps->{$depTag}->{$depFile});
1399 ## Set up the files array. If the line contains a wild card
1400 ## character use CORE::glob() to get the files specified.
1401 my @files;
1402 if ($line =~ /^"([^"]+)"$/) {
1403 push(@files, $1);
1405 ## Don't glob the line if we're wanting to remove the file. Wait
1406 ## until later to do the wildcard expansion (in remove_excluded).
1407 elsif (!$rem && $line =~ /[\?\*\[\]]/) {
1408 @files = $self->mpc_glob($line);
1410 else {
1411 push(@files, $line);
1414 ## If we want to remove these files at the end too, then
1415 ## add them to our remove_files hash array.
1416 if ($rem) {
1417 if (!defined $self->{'remove_files'}->{$tag}) {
1418 $self->{'remove_files'}->{$tag} = {};
1420 foreach my $file (@files) {
1421 $self->{'remove_files'}->{$tag}->{$file} = 1;
1425 ## If we're excluding these files, then put them in the hash
1426 if ($exc) {
1427 $$grname = $current;
1428 @exclude{@files} = (@files);
1429 push(@$excarr, @files);
1431 else {
1432 ## Set the flag overrides for each file
1433 my $over = $self->{'flag_overrides'}->{$tag};
1434 if (defined $over) {
1435 foreach my $file (@files) {
1436 ## We are giving these flag overrides to multiple files. We must
1437 ## do so because these files are all in the same group.
1438 $$over{$file} = $flags;
1442 foreach my $file (@files) {
1443 ## Add the file if we're not excluding it
1444 push(@{$$comps{$current}}, $file) if (!defined $exclude{$file});
1446 ## The user listed a file explicitly, whether we
1447 ## excluded it or not.
1448 ++$$count;
1453 return $status, $error;
1457 sub parse_conditional {
1458 my($self, $fh, $types, $tag, $flags,
1459 $grname, $current, $exclude, $comps, $count) = @_;
1460 my $status = 1;
1461 my $error;
1462 my $type = $self->matches_specific_scope($types);
1463 my $add = (defined $type ? 1 : 0);
1465 while(<$fh>) {
1466 my $line = $self->preprocess_line($fh, $_);
1468 if ($line eq '') {
1470 elsif ($line =~ /^}\s*else\s*{$/) {
1471 $add ^= 1;
1473 elsif ($line =~ /^}$/) {
1474 last;
1476 elsif ($add) {
1477 ($status, $error) = $self->process_component_line(
1478 $tag, $line, $fh, $flags,
1479 $grname, $current,
1480 $exclude, $comps, $count);
1481 last if (!$status);
1485 return $status, $error;
1488 sub parse_components {
1489 my($self, $fh, $tag, $name) = @_;
1490 my $current = $defgroup;
1491 my $status = 1;
1492 my $error;
1493 my $names = {};
1494 my $comps = {};
1495 my $set;
1496 my %flags;
1497 my @exclude;
1498 my $custom = defined $self->{'generated_exts'}->{$tag};
1499 my $grtag = $grouped_key . $tag;
1500 my $grname;
1502 if ($custom) {
1503 ## For the custom scoped assignments, we want to put a copy of
1504 ## the original custom defined values in our flags associative array.
1505 foreach my $key (keys %custom) {
1506 if (defined $self->{'generated_exts'}->{$tag}->{$key}) {
1507 $flags{$key} = $self->{'generated_exts'}->{$tag}->{$key};
1512 if (defined $self->{$tag}) {
1513 $names = $self->{$tag};
1515 else {
1516 $self->{$tag} = $names;
1518 if (defined $$names{$name}) {
1519 $comps = $$names{$name};
1521 else {
1522 $$names{$name} = $comps;
1524 $$comps{$current} = [] if (!defined $$comps{$current});
1526 # preserve order
1527 #tie %$names, "Tie::IxHash";
1528 #tie %$comps, "Tie::IxHash";
1530 my $count = 0;
1531 while(<$fh>) {
1532 my $line = $self->preprocess_line($fh, $_);
1534 if ($line eq '') {
1536 elsif ($line =~ /^(\w+)\s*{$/) {
1537 if (!$set) {
1538 $current = $1;
1539 $set = 1;
1540 $$comps{$current} = [] if (!defined $$comps{$current});
1542 else {
1543 $status = 0;
1544 $error = 'Can not nest groups';
1545 last;
1548 elsif ($line =~ /^conditional\s*(\(([^\)]+)\))\s*{$/) {
1549 ($status, $error) = $self->parse_conditional(
1550 $fh, $2, $tag, \%flags, \$grname,
1551 $current, \@exclude, $comps,
1552 \$count);
1553 last if (!$status);
1555 elsif ($line =~ /^}$/) {
1556 if (!defined $$comps{$current}->[0] && !defined $exclude[0]) {
1557 ## The default components name was never used
1558 ## so we remove it from the components
1559 delete $$comps{$current};
1561 ## For custom_only projects, an empty section is functionally
1562 ## equivalent to not defining it at all.
1563 $self->{'defaulted'}->{$tag} = 1
1564 if (!defined $self->{'defaulted'}->{$tag} &&
1565 $self->get_assignment('custom_only'));
1567 else {
1568 ## It was used, so we need to add that name to
1569 ## the set of group names unless it's already been added.
1570 $self->process_assignment_add($grtag, $current);
1572 ## Define the defaulted section value so that if a following
1573 ## empty section of the same type is found, it will not cause the
1574 ## defaulted value to be overwritten.
1575 $self->{'defaulted'}->{$tag} = 0;
1577 if ($set) {
1578 $current = $defgroup;
1579 $set = undef;
1581 else {
1582 ## We are at the end of a component. If the only group
1583 ## we added was the default group, then we need to remove
1584 ## the group setting altogether.
1585 my $groups = $self->get_assignment($grtag);
1586 if (defined $groups) {
1587 my $grarray = $self->create_array($groups);
1588 if (scalar(@$grarray) == 1 && $$grarray[0] eq $defgroup) {
1589 $self->process_assignment($grtag, undef);
1593 ## This is not an error,
1594 ## this is the end of the components
1595 last;
1598 else {
1599 ($status, $error) = $self->process_component_line($tag, $line, $fh, \%flags,
1600 \$grname, $current,
1601 \@exclude, $comps,
1602 \$count);
1603 last if (!$status);
1607 ## If this is a "special" component, we need to see if the
1608 ## user provided all directories. If they have, then we need to
1609 ## store an array of directories that the user supplied. Otherwise,
1610 ## we just store a 1.
1611 if (defined $specialComponents{$tag}) {
1612 my @dirs;
1613 foreach my $name (keys %$names) {
1614 my $comps = $$names{$name};
1615 foreach my $comp (keys %$comps) {
1616 foreach my $item (@{$$comps{$comp}}) {
1617 if (-d $item) {
1618 push(@dirs, $item);
1620 else {
1621 @dirs = ();
1622 last;
1627 if (defined $dirs[0]) {
1628 $self->{'special_supplied'}->{$tag} = \@dirs;
1630 else {
1631 $self->{'special_supplied'}->{$tag} = 1;
1635 ## If we didn't encounter an error, didn't have any files explicitly
1636 ## listed and we attempted to exclude files, then we need to find the
1637 ## set of files that don't match the excluded files and add them.
1638 if ($status && defined $exclude[0] && defined $grname) {
1639 my $alldir = $self->get_assignment('recurse') || $flags{'recurse'};
1640 my %checked;
1641 my @files;
1642 foreach my $exc (@exclude) {
1643 my $dname = $self->mpc_dirname($exc);
1644 if (!defined $checked{$dname}) {
1645 $checked{$dname} = 1;
1646 push(@files, $self->generate_default_file_list($dname,
1647 \@exclude,
1648 undef, $alldir));
1652 $self->sift_files(\@files,
1653 $self->{'valid_components'}->{$tag},
1654 $self->get_assignment('pch_header'),
1655 $self->get_assignment('pch_source'),
1656 $tag,
1657 $$comps{$grname});
1660 return $status, $error;
1664 sub parse_verbatim {
1665 my($self, $fh, $type, $loc, $add) = @_;
1667 if (!defined $loc) {
1668 return 0, 'You must provide a location parameter to verbatim';
1671 ## All types are lower case
1672 $type = lc($type);
1674 if (!defined $self->{'verbatim'}->{$type}) {
1675 $self->{'verbatim'}->{$type} = {};
1678 ## Instead of always creating a new array for a particular type and
1679 ## location, create a new array if there isn't one already or the user
1680 ## does not want to add to the existing verbatim settings.
1681 $self->{'verbatim'}->{$type}->{$loc} = []
1682 if (!$add || !defined $self->{'verbatim'}->{$type}->{$loc});
1683 my $array = $self->{'verbatim'}->{$type}->{$loc};
1685 while(<$fh>) {
1686 my $line = $self->preprocess_line($fh, $_);
1688 ## This is not an error,
1689 ## this is the end of the verbatim
1690 last if ($line =~ /^}$/);
1691 push(@$array, $line);
1694 return 1, undef;
1698 sub process_feature {
1699 my($self, $fh, $names, $parents) = @_;
1700 my $status = 1;
1701 my $error;
1703 my $requires = '';
1704 my $avoids = '';
1705 foreach my $name (@$names) {
1706 if ($name =~ /^!\s*(.*)$/) {
1707 $avoids .= ' ' if ($avoids ne '');
1708 $avoids .= $1;
1710 else {
1711 $requires .= ' ' if ($requires ne '');
1712 $requires .= $name;
1716 if ($self->check_features($requires, $avoids)) {
1717 ## The required features are enabled, so we say that
1718 ## a project has been defined and we allow the parser to
1719 ## find the data held within the feature.
1720 ($status, $error) = $self->begin_project($parents);
1721 if ($status) {
1722 $self->{'feature_defined'} = 0;
1723 $self->{$self->{'type_check'}} = 1;
1726 else {
1727 ## Otherwise, we read in all the lines until we find the
1728 ## closing brace for the feature and it appears to the parser
1729 ## that nothing was defined.
1730 my $curly = 1;
1731 while(<$fh>) {
1732 my $line = $self->preprocess_line($fh, $_);
1734 ## This is a very simplistic way of finding the end of
1735 ## the feature definition. It will work as long as no spurious
1736 ## open curly braces are counted.
1737 ++$curly if ($line =~ /{$/);
1738 --$curly if ($line =~ /^}/);
1740 if ($curly == 0) {
1741 $self->{'feature_defined'} = 0;
1742 last;
1747 return $status, $error;
1751 sub process_array_assignment {
1752 my($self, $aref, $type, $array) = @_;
1754 if (!defined $$aref || $type == 0) {
1755 if ($type != -1) {
1756 $$aref = $array;
1759 else {
1760 if ($type == 1) {
1761 push(@{$$aref}, @$array);
1763 elsif ($type == -1) {
1764 my $count = scalar(@{$$aref});
1765 for(my $i = 0; $i < $count; ++$i) {
1766 if (StringProcessor::fgrep($$aref->[$i], $array)) {
1767 splice(@{$$aref}, $i, 1);
1768 --$i;
1769 --$count;
1777 sub parse_define_custom {
1778 my($self, $fh, $tag, $modify, $parentsRef) = @_;
1780 ## Make the tag something _files
1781 $tag = lc($tag) . '_files';
1783 ## We can not have a custom type named "generic"
1784 return 0, "$tag is reserved" if ($tag eq $generic_key);
1786 if (defined $self->{'valid_components'}->{$tag}) {
1787 if (!$modify) {
1788 return 0, "$tag has already been defined";
1791 elsif ($modify) {
1792 return 0, "$tag has not yet been defined and can not be modified";
1795 if (defined $parentsRef && @$parentsRef > 0) {
1796 if (@$parentsRef > 1) {
1797 return 0, "$tag: multiple inheritance is not allowed";
1799 my $parent = lc($$parentsRef[0]) . '_files';
1800 if (!defined $self->{'valid_components'}->{$parent}) {
1801 return 0, "$parent is not a valid custom file type";
1803 for my $k ('matching_assignments', 'generated_exts', 'valid_components') {
1804 $self->{$k}->{$tag} = $self->clone($self->{$k}->{$parent});
1806 $self->{'define_custom_parent'}->{$tag} = $parent;
1809 my $status = 0;
1810 my $errorString = "Unable to process $tag";
1812 ## Update the custom_types assignment
1813 $self->process_assignment_add('custom_types', $tag) if (!$modify);
1815 if (!defined $self->{'matching_assignments'}->{$tag}) {
1816 my @keys = keys %custom;
1817 push(@keys, @default_matching_assignments);
1818 $self->{'matching_assignments'}->{$tag} = \@keys;
1821 my $optname;
1822 my $inscope = 0;
1823 while(<$fh>) {
1824 my $line = $self->preprocess_line($fh, $_);
1826 if ($line eq '') {
1828 elsif ($line =~ /optional\s*\(([^\)]+)\)\s*{/) {
1829 $optname = $1;
1830 $optname =~ s/^\s+//;
1831 $optname =~ s/\s+$//;
1832 if (defined $customDefined{$optname} &&
1833 ($customDefined{$optname} & 0x08) != 0) {
1834 ++$inscope;
1835 if ($inscope != 1) {
1836 $status = 0;
1837 $errorString = 'Can not nest \'optional\' sections';
1838 last;
1841 else {
1842 $status = 0;
1843 $errorString = "Invalid optional name: $optname";
1844 last;
1847 elsif ($inscope) {
1848 if ($line =~ /^}$/) {
1849 $optname = undef;
1850 --$inscope;
1852 else {
1853 if ($line =~ /(\w+)\s*\(([^\)]+)\)\s*(\+)?=\s*(.*)/) {
1854 my $name = lc($1);
1855 my $opt = $2;
1856 my $add = $3;
1857 my @val = split(/\s*,\s*/, $4);
1859 ## Fix $opt spacing
1860 $opt =~ s/(\&\&|\|\|)/ $1 /g;
1861 $opt =~ s/!\s+/!/g;
1863 ## Set up the 'optional' hash table
1864 if (!$add || !defined $self->{'generated_exts'}->{$tag}->
1865 {'optional'}->{$optname}->{$name}->{$opt}) {
1866 $self->{'generated_exts'}->{$tag}->
1867 {'optional'}->{$optname}->{$name}->{$opt} = \@val;
1869 else {
1870 push(@{$self->{'generated_exts'}->{$tag}->{'optional'}->
1871 {$optname}->{$name}->{$opt}}, @val);
1874 else {
1875 $status = 0;
1876 $errorString = "Unrecognized optional line: $line";
1877 last;
1881 elsif ($line =~ /^}$/) {
1882 $status = 1;
1883 $errorString = undef;
1885 ## Propagate the custom defined values into the mapped values
1886 foreach my $key (keys %{$self->{'valid_names'}}) {
1887 if (UNIVERSAL::isa($self->{'valid_names'}->{$key}, 'ARRAY')) {
1888 my $value = $self->{'generated_exts'}->{$tag}->{
1889 $self->{'valid_names'}->{$key}->[1]};
1891 ## Bypass the process_assignment() defined in this class
1892 ## to avoid unwanted keyword mapping.
1893 $self->SUPER::process_assignment($key, $value) if (defined $value);
1897 ## Set some defaults (if they haven't already been set)
1898 if (!defined $self->{'generated_exts'}->{$tag}->{'pre_filename'}) {
1899 $self->{'generated_exts'}->{$tag}->{'pre_filename'} = [ '' ];
1901 if (!defined $self->{'generated_exts'}->{$tag}->{'pre_dirname'}) {
1902 $self->{'generated_exts'}->{$tag}->{'pre_dirname'} = [ '' ];
1904 if (!defined $self->{'generated_exts'}->{$tag}->{'pre_extension'}) {
1905 $self->{'generated_exts'}->{$tag}->{'pre_extension'} = [ '' ];
1907 if (!defined $self->{'generated_exts'}->{$tag}->{'automatic_in'}) {
1908 $self->{'generated_exts'}->{$tag}->{'automatic_in'} = 1;
1910 if (!defined $self->{'generated_exts'}->{$tag}->{'automatic_out'}) {
1911 $self->{'generated_exts'}->{$tag}->{'automatic_out'} = 1;
1913 if (!defined $self->{'generated_exts'}->{$tag}->{'output_follows_input'}) {
1914 $self->{'generated_exts'}->{$tag}->{'output_follows_input'} = 1;
1916 if (!defined $self->{'valid_components'}->{$tag}) {
1917 $self->{'valid_components'}->{$tag} = [];
1919 last;
1921 else {
1922 my @values;
1923 ## If this returns true, then we've found an assignment
1924 if ($self->parse_assignment($line, \@values, $fh)) {
1925 my($type, $name, $value) = @values;
1926 ## The 'automatic' keyword has always contained two distinct
1927 ## functions. The first is to automatically add input files of
1928 ## the specified extension. And the second is to automatically
1929 ## add generated files to the right components. It has now been
1930 ## split into separate functionality and we map the 'automatic'
1931 ## keyword to the two new ones here.
1932 my $ok = 1;
1933 my @names = $name eq 'automatic' ?
1934 ('automatic_in', 'automatic_out') : $name;
1935 foreach $name (@names) {
1936 if (defined $customDefined{$name}) {
1937 if (($customDefined{$name} & 0x01) != 0) {
1938 $value = $self->escape_regex_special($value);
1939 my @array = split(/\s*,\s*/, $value);
1940 $self->process_array_assignment(
1941 \$self->{'valid_components'}->{$tag}, $type, \@array);
1943 else {
1944 if (!defined $self->{'generated_exts'}->{$tag}) {
1945 $self->{'generated_exts'}->{$tag} = {};
1947 ## Try to convert the value into a relative path
1948 $value = $self->relative($value);
1950 if (($customDefined{$name} & 0x04) != 0) {
1951 if ($type == 0) {
1952 $self->process_assignment(
1953 $name, $value,
1954 $self->{'generated_exts'}->{$tag});
1956 elsif ($type == 1) {
1957 $self->process_assignment_add(
1958 $name, $value,
1959 $self->{'generated_exts'}->{$tag});
1961 elsif ($type == -1) {
1962 $self->process_assignment_sub(
1963 $name, $value,
1964 $self->{'generated_exts'}->{$tag});
1967 else {
1968 if (($customDefined{$name} & 0x02) != 0) {
1969 ## Transform the name from something outputext to
1970 ## something files. We expect this to match the
1971 ## names of valid_assignments.
1972 $name =~ s/outputext/files/g;
1975 ## Get it ready for regular expressions
1976 $value = $self->escape_regex_special($value);
1978 ## Split the value into an array using a comma as the
1979 ## separator. If there are no elements in the array we're
1980 ## going to add an empty element to the array. This way,
1981 ## assignments of blank values are useful.
1982 my @array = split(/\s*,\s*/, $value);
1983 push(@array, '') if ($#array == -1);
1985 ## Process the array assignment after adjusting the values
1986 $self->process_array_assignment(
1987 \$self->{'generated_exts'}->{$tag}->{$name},
1988 $type, \@array);
1992 else {
1993 $ok = 0;
1994 $status = 0;
1995 $errorString = "Invalid assignment name: '$name'";
1996 last;
2000 ## $status is zero until the end of the define custom block, so
2001 ## we can't use it for this check.
2002 last if (!$ok);
2004 elsif ($line =~ /^keyword\s+(\w+)(?:\s*=\s*(\w+)?)?/) {
2005 ## Check for keyword mapping here
2006 my $newkey = $1;
2007 my $mapkey = $2;
2008 if (defined $self->{'valid_names'}->{$newkey}) {
2009 $status = 0;
2010 $errorString = "Cannot map $newkey onto an " .
2011 "existing keyword";
2012 last;
2014 elsif (!defined $mapkey) {
2015 $self->{'valid_names'}->{$newkey} = 1;
2017 elsif ($newkey ne $mapkey) {
2018 if (defined $customDefined{$mapkey}) {
2019 $self->{'valid_names'}->{$newkey} = [ $tag, $mapkey ];
2021 else {
2022 $status = 0;
2023 $errorString = "Cannot map $newkey to an " .
2024 "undefined custom keyword: $mapkey";
2025 last;
2028 else {
2029 $status = 0;
2030 $errorString = "Cannot map $newkey to $mapkey";
2031 last;
2034 else {
2035 $status = 0;
2036 $errorString = "Unrecognized line: $line";
2037 last;
2042 return $status, $errorString;
2046 sub back_to_variable {
2047 my($self, $values) = @_;
2048 my $cwd = $self->getcwd();
2049 my $case_tolerant = $self->case_insensitive();
2050 my @values = ();
2052 ## Get both of the relative value hash maps and put them in an array
2053 my @rels = ();
2054 my($rel, $how) = $self->get_initial_relative_values();
2055 push(@rels, $rel);
2056 ($rel, $how) = $self->get_secondary_relative_values();
2057 push(@rels, $rel);
2059 ## Go through each value and try to convert it to a variable setting
2060 foreach my $ovalue (@$values) {
2061 ## Fix up the value, replacing '.' with the current working
2062 ## directory.
2063 my $value = $ovalue;
2064 $value =~ s/\\/\//g;
2065 if ($value eq '.') {
2066 $value = $cwd;
2068 else {
2069 $value =~ s/^.\//$cwd\//;
2071 my $valuelen = length($value);
2073 ## Go through each relative value hash map and see if any of the
2074 ## values match the value that we're currently inspecting.
2075 my $found = undef;
2076 foreach my $rel (@rels) {
2077 foreach my $key (keys %$rel) {
2078 ## Get the relative replacement value and convert back-slashes
2079 my $val = $$rel{$key};
2080 $val =~ s/\\/\//g;
2082 ## We only need to check for reverse replacement if the length
2083 ## of the value is greater than or equal to the length of our
2084 ## replacement value.
2085 my $vlen = length($val);
2086 if ($valuelen >= $vlen) {
2087 ## Cut the string down by the length of the replacement value
2088 my $lval = substr($value, 0, $vlen);
2090 ## Check for equivalence, taking into account file system
2091 ## case-insenitivity.
2092 if ($case_tolerant) {
2093 $found = (lc($lval) eq lc($val));
2095 else {
2096 $found = ($lval eq $val);
2099 ## If they match, replace the value and save it in our array.
2100 if ($found) {
2101 substr($value, 0, length($val)) = "\$($key)";
2102 push(@values, $value);
2103 last;
2108 ## Once it's been found, there's no reason to continue on through
2109 ## the relative hash maps.
2110 last if ($found);
2113 push(@values, $ovalue) if (!$found);
2116 return @values;
2120 sub remove_duplicate_addition {
2121 my($self, $name, $value, $nval) = @_;
2123 if (defined $nval) {
2124 ## If we are modifying the libs, libpaths, macros or includes
2125 ## assignment with either addition or subtraction, we are going to
2126 ## perform a little fix on the value to avoid multiple
2127 ## libraries and to try to insure the correct linking order
2128 if ($name eq 'macros' || $name eq 'libpaths' ||
2129 $name eq 'includes' || $name =~ /libs$/ ||
2130 index($name, $grouped_key) == 0) {
2131 my $allowed = '';
2132 my %parts;
2134 ## Convert the array into keys for a hash table
2135 @parts{@{$self->create_array($nval)}} = ();
2137 ## In order to ensure that duplicates are correctly removed, we
2138 ## need to get the modified assignment value before we attempt to
2139 ## do so.
2140 $value = $self->modify_assignment_value($name, $value);
2141 foreach my $val (@{$self->create_array($value)}) {
2142 if (!exists $parts{$val}) {
2143 ## We need to supply quotes if there is a space in the value or
2144 ## a variable. The variable may contain spaces.
2145 if ($val =~ /\s/ || $val =~ /\$\(.+\)/) {
2146 ## If we're going to add quotes around this item and the
2147 ## value ends in a backslash we need to append another
2148 ## backslash so that when it's used with
2149 ## StringProcessor::create_array() the function will not think
2150 ## that the trailing quote is escaped.
2151 $val .= '\\' if ($val =~ /\\$/);
2152 $allowed .= '"' . $val . '" ';
2154 else {
2155 $allowed .= $val . ' ';
2159 $allowed =~ s/\s+$//;
2160 return $allowed;
2164 return $value;
2168 sub read_template_input {
2169 my($self, $tkey) = @_;
2170 my $status = 1;
2171 my $errorString;
2172 my $file;
2173 my $tag;
2174 my $ti = $self->get_ti_override();
2175 my $lang = $self->get_language();
2176 my $override;
2178 if ($self->exe_target()) {
2179 if ($self->get_static() == 1) {
2180 $tag = 'lib_exe_template_input';
2181 ## Check for the TemplateInputReader for the template key provided.
2182 if (!defined $self->{$tag}->{$lang}->{$tkey}) {
2183 if (defined $$ti{'lib_exe'}) {
2184 $file = $$ti{'lib_exe'};
2185 $override = 1;
2187 else {
2188 $file = $self->get_lib_exe_template_input_file($tkey);
2192 else {
2193 $tag = 'dll_exe_template_input';
2194 ## Check for the TemplateInputReader for the template key provided.
2195 if (!defined $self->{$tag}->{$lang}->{$tkey}) {
2196 if (defined $$ti{'dll_exe'}) {
2197 $file = $$ti{'dll_exe'};
2198 $override = 1;
2200 else {
2201 $file = $self->get_dll_exe_template_input_file($tkey);
2206 else {
2207 if ($self->get_static() == 1) {
2208 $tag = 'lib_template_input';
2209 ## Check for the TemplateInputReader for the template key provided.
2210 if (!defined $self->{$tag}->{$lang}->{$tkey}) {
2211 if (defined $$ti{'lib'}) {
2212 $file = $$ti{'lib'};
2213 $override = 1;
2215 else {
2216 $file = $self->get_lib_template_input_file($tkey);
2220 else {
2221 $tag = 'dll_template_input';
2222 ## Check for the TemplateInputReader for the template key provided.
2223 if (!defined $self->{$tag}->{$lang}->{$tkey}) {
2224 if (defined $$ti{'dll'}) {
2225 $file = $$ti{'dll'};
2226 $override = 1;
2228 else {
2229 $file = $self->get_dll_template_input_file($tkey);
2235 if (defined $self->{$tag}->{$lang}->{$tkey}) {
2236 ## We have a TemplateInputReader for this template key, so we need
2237 ## to set the entry corresponding to $tikey to it for use in the
2238 ## get_template_input() method.
2239 $self->{$tag}->{$lang}->{$tikey} = $self->{$tag}->{$lang}->{$tkey};
2241 else {
2242 ## We haven't read this file yet, so we will create the template
2243 ## input reader and store it in the entry for the template key
2244 ## ($tkey) and the template input key ($tikey).
2245 my $ti = new TemplateInputReader($self->get_include_path());
2246 $self->{$tag}->{$lang}->{$tkey} = $ti;
2247 $self->{$tag}->{$lang}->{$tikey} = $ti;
2249 ## Process the template input file
2250 if (defined $file) {
2251 my $tfile = $self->search_include_path("$file.$TemplateInputExtension");
2252 if (defined $tfile) {
2253 ($status, $errorString) = $ti->read_file($tfile);
2255 else {
2256 ## Not finding a template input file is only an error if the user
2257 ## specifically provided a template input file override.
2258 if ($override) {
2259 $status = 0;
2260 $errorString = "Unable to locate template input file: $file";
2265 ## Now that we've read in the template input file, set up our
2266 ## automatic template variables.
2267 if ($self->{'make_coexistence'}) {
2268 $ti->parse_line(undef,
2269 "make_coexistence = $self->{'make_coexistence'}");
2273 ## We do this regardless of whether or not this parser is cached or
2274 ## not. If the features have changed (through a workspace cmdline
2275 ## setting), we need to reflect it.
2276 if ($status) {
2277 ## Put the features into the template input set
2278 my $features = $self->{'feature_parser'}->get_names();
2279 $self->{$tag}->{$lang}->{$tikey}->parse_line(undef,
2280 "features = @$features");
2283 return $status, $errorString;
2287 sub already_added {
2288 my($self, $array, $name) = @_;
2289 my $case_tolerant = $self->case_insensitive();
2291 ## This method expects that the file name will be unix style
2292 $name =~ s/\\/\//g if ($self->{'convert_slashes'});
2294 ## Remove the leading ./
2295 $name =~ s/^\.\///;
2296 my $dsname = "./$name";
2298 ## Take into account file system case-insenitivity.
2299 if ($case_tolerant) {
2300 $name = lc($name);
2301 $dsname = lc($dsname);
2304 foreach my $file (@$array) {
2305 my $my_file = ($case_tolerant ? lc($file) : $file);
2307 return 1 if ($my_file eq $name || $my_file eq $dsname);
2310 return 0;
2314 sub get_applied_custom_keyword {
2315 my($self, $name, $type, $file) = @_;
2317 if (defined $self->{'flag_overrides'}->{$type} &&
2318 defined $self->{'flag_overrides'}->{$type}->{$file} &&
2319 defined $self->{'flag_overrides'}->{$type}->{$file}->{$name}) {
2320 return $self->relative(
2321 $self->{'flag_overrides'}->{$type}->{$file}->{$name}, 1);
2324 return $self->relative($self->get_assignment(
2325 $name,
2326 $self->{'generated_exts'}->{$type}), 1);
2330 sub evaluate_optional_option {
2331 my($self, $opt, $value) = @_;
2333 if ($opt =~ /^!\s*(.*)/) {
2334 return (!exists $$value{$1} ? 1 : 0);
2336 else {
2337 return (exists $$value{$opt} ? 1 : 0);
2342 sub process_optional_option {
2343 my($self, $opt, $value) = @_;
2344 my $status;
2345 my @parts = grep(!/^$/, split(/\s+/, $opt));
2346 my $pcount = scalar(@parts);
2348 for(my $i = 0; $i < $pcount; $i++) {
2349 if ($parts[$i] eq '&&' || $parts[$i] eq '||') {
2350 if (defined $status) {
2351 if (defined $parts[$i + 1]) {
2352 if ($parts[$i] eq '&&') {
2353 $status &&= $self->evaluate_optional_option($parts[$i + 1],
2354 $value);
2356 else {
2357 ## We are coming into an '||', if status is already true
2358 ## then we can leave immediately
2359 last if ($status);
2361 $status ||= $self->evaluate_optional_option($parts[$i + 1],
2362 $value);
2365 else {
2366 $self->warning("Expected token in optional after $parts[$i]");
2369 else {
2370 $self->warning("Unexpected token in optional: $parts[$i]");
2372 ++$i;
2374 else {
2375 if (!defined $status) {
2376 $status = $self->evaluate_optional_option($parts[$i], $value);
2378 else {
2379 $self->warning("Unexpected token in optional: $parts[$i]");
2384 return $status;
2388 sub add_optional_filename_portion {
2389 my($self, $gentype, $tag, $file, $array) = @_;
2391 if (defined $self->{'generated_exts'}->{$gentype}->{'optional'}->{$tag}) {
2392 foreach my $name (keys %{$self->{'generated_exts'}->{$gentype}->{'optional'}->{$tag}}) {
2393 foreach my $opt (keys %{$self->{'generated_exts'}->{$gentype}->{'optional'}->{$tag}->{$name}}) {
2394 ## Get the name value
2395 my $value = $self->get_applied_custom_keyword($name,
2396 $gentype, $file);
2398 ## Convert the value into a hash map for easy lookup
2399 my %values;
2400 @values{split(/\s+/, $value)} = () if (defined $value);
2402 ## See if the option or options are contained in the value. We
2403 ## need to call this even if $value is not defined due to the
2404 ## ability to negate optional parameters.
2405 if ($self->process_optional_option($opt, \%values)) {
2406 ## Add the optional portion
2407 push(@$array, @{$self->{'generated_exts'}->{$gentype}->{'optional'}->{$tag}->{$name}->{$opt}});
2415 sub get_pre_keyword_array {
2416 my($self, $keyword, $gentype, $tag, $file) = @_;
2418 ## Get the general pre extension array.
2419 ## $self->{'generated_exts'}->{$gentype}->{$keyword} is guaranteed to
2420 ## be defined due to the defaulting that is done in
2421 ## parse_define_custom() and the only three calls to this method use
2422 ## valid $keyword values.
2423 my @array = @{$self->{'generated_exts'}->{$gentype}->{$keyword}};
2425 ## Add the component specific pre extension array
2426 my @additional;
2427 $tag =~ s/files$/$keyword/;
2428 if (defined $self->{'generated_exts'}->{$gentype}->{$tag}) {
2429 push(@additional, @{$self->{'generated_exts'}->{$gentype}->{$tag}});
2432 ## Add in any optional portion to the array
2433 foreach my $itag ($keyword, $tag) {
2434 $self->add_optional_filename_portion($gentype, $itag,
2435 $file, \@additional);
2438 ## If the current array only has the default,
2439 ## then we need to remove it
2440 if (defined $additional[0]) {
2441 if ($#array == 0 && $array[0] eq '') {
2442 pop(@array);
2444 push(@array, @additional);
2447 return @array;
2451 sub add_explicit_output {
2452 my($self, $file, $type, $tag, $array, $arrs) = @_;
2454 if (defined $self->{'custom_special_output'}->{$type} &&
2455 defined $self->{'custom_special_output'}->{$type}->{$file}) {
2456 if (defined $self->{'valid_components'}->{$tag}) {
2457 my @files;
2458 foreach my $check (@{$self->{'custom_special_output'}->{$type}->{$file}}) {
2459 foreach my $regext (@{$self->{'valid_components'}->{$tag}}) {
2460 if ($check =~ /$regext$/) {
2461 my $add = 1;
2462 if ($tag eq 'source_files') {
2463 foreach my $tregext (@{$self->{'valid_components'}->{'template_files'}}) {
2464 if ($check =~ /$tregext$/) {
2465 $add = undef;
2466 last;
2470 if ($add) {
2471 ## If gendir was specified, then we need to account for that
2472 my $dir = '';
2473 if (defined $self->{'flag_overrides'}->{$type} &&
2474 defined $self->{'flag_overrides'}->{$type}->{$file} &&
2475 defined $self->{'flag_overrides'}->{$type}->{$file}->{'gendir'} &&
2476 $self->{'flag_overrides'}->{$type}->{$file}->{'gendir'} ne '.') {
2477 $dir = $self->{'flag_overrides'}->{$type}->{$file}->{'gendir'} . '/';
2478 $dir =~ s/\\/\//g if ($self->{'convert_slashes'});
2481 push(@files, "$dir$check");
2482 last;
2487 if (defined $files[0]) {
2488 if ($arrs) {
2489 push(@$array, \@files);
2491 else {
2492 push(@$array, @files);
2499 sub generated_filenames {
2500 my($self, $part, $type, $tag, $file, $noext, $arrs) = @_;
2501 ## $part - The full path of the input file minus the extension
2502 ## $type - The input file type (e.g., 'java_files')
2503 ## $file - The full path of the input file
2504 ## $noext - bool indicating an inverse need for an extension
2505 ## $arrs - bool indicating that the return array should be made of arrays
2507 ## A custom type is not allowed to generate it's own input files
2508 return () if ($type eq $tag);
2510 ## See if the type for which we are generating ($tag) is also a custom
2511 ## file type. If it is, we need to do some massaging.
2512 my $otag = $tag;
2513 if (defined $self->{'generated_exts'}->{$tag}) {
2514 ## If the custom type ($type) doesn't specify that it generates
2515 ## generic files, we need to see if there is a command helper for
2516 ## this type and see what sort of output it knows about.
2517 my $inputexts = $self->{'generated_exts'}->{$type}->{$generic_key};
2518 if (!defined $inputexts) {
2519 my $cmdHelper = $self->find_command_helper($type);
2520 $inputexts = $cmdHelper->get_outputexts() if (defined $cmdHelper);
2523 ## We will need to use 'generic_files' instead of $tag if $tag is
2524 ## defined in 'generated_exts', but only for the type that will
2525 ## actually generate the right type of generic file.
2526 my $good;
2527 if (defined $inputexts) {
2528 foreach my $inputext (@$inputexts) {
2529 my $ext = $inputext;
2530 $ext =~ s/\\//g;
2531 foreach my $extreg (@{$self->{'valid_components'}->{$tag}}) {
2532 if ($ext =~ /$extreg$/) {
2533 $tag = $generic_key;
2534 $good = 1;
2535 last;
2538 last if ($good);
2542 ## If we were not able to find the right file type, then we can get
2543 ## out early. However, if the type for which we are generating
2544 ## ($tag) is a built-in type, we need to continue on as there is a
2545 ## possibility that the input type ($type) will generate files for
2546 ## the generating type.
2547 return () if (!$good &&
2548 !defined $language{$self->get_language()}->[0]->{$tag});
2551 my @pearr = $self->get_pre_keyword_array('pre_extension',
2552 $type, $tag, $file);
2553 my @pfarr = $self->get_pre_keyword_array('pre_filename',
2554 $type, $tag, $file);
2555 my @pdarr = $self->get_pre_keyword_array('pre_dirname',
2556 $type, $tag, $file);
2557 my @exts = (defined $self->{'generated_exts'}->{$type}->{$tag} ?
2558 @{$self->{'generated_exts'}->{$type}->{$tag}} : ());
2560 if (!defined $exts[0]) {
2561 my $backtag = $tag;
2562 if ($backtag =~ s/files$/outputext/) {
2563 $self->add_optional_filename_portion($type, $backtag,
2564 $file, \@exts);
2568 my @array;
2569 if (!defined $exts[0] && $#pearr == 0 && $#pfarr == 0 && $#pdarr == 0 &&
2570 $pearr[0] eq '' && $pfarr[0] eq '' && $pdarr[0] eq '') {
2571 ## If both arrays are defined to be the defaults, then there
2572 ## is nothing for us to do.
2574 else {
2575 my $dir = '';
2576 my $base;
2578 ## Correctly deal with pre filename and directories
2579 if ($part =~ /(.*[\/\\])([^\/\\]+)$/) {
2580 ## Split the directory and base name of the file. Only set the
2581 ## directory if the output follows the input directory.
2582 $dir = $1
2583 if ($self->{'generated_exts'}->{$type}->{'output_follows_input'});
2584 $base = $2;
2586 else {
2587 $base = $part;
2590 ## If gendir was specified, then we need to account for that
2591 if (defined $self->{'flag_overrides'}->{$type} &&
2592 defined $self->{'flag_overrides'}->{$type}->{$file} &&
2593 defined $self->{'flag_overrides'}->{$type}->{$file}->{'gendir'}) {
2594 if ($self->{'flag_overrides'}->{$type}->{$file}->{'gendir'} eq '.') {
2595 $dir = '';
2597 else {
2598 $dir = $self->{'flag_overrides'}->{$type}->{$file}->{'gendir'} . '/';
2599 $dir =~ s/\\/\//g if ($self->{'convert_slashes'});
2603 ## Loop through creating all of the possible file names
2604 foreach my $pe (@pearr) {
2605 my @genfile;
2606 $pe =~ s/\\\././g;
2607 foreach my $pf (@pfarr) {
2608 $pf =~ s/\\\././g;
2609 foreach my $pd (@pdarr) {
2610 if ($noext) {
2611 push(@genfile, "$pd$dir$pf$base$pe");
2613 else {
2614 foreach my $ext (@exts) {
2615 $ext =~ s/\\\././g;
2616 push(@genfile, "$pd$dir$pf$base$pe$ext");
2621 if ($arrs) {
2622 push(@array, \@genfile);
2624 else {
2625 push(@array, @genfile);
2630 ## Now add the explicit output. We need to use the original tag value
2631 ## ($otag) so that we can find the custom output files.
2632 $self->add_explicit_output($file, $type, $otag, \@array, $arrs);
2633 return @array;
2637 sub add_generated_files {
2638 my($self, $gentype, $tag, $group, $arr) = @_;
2640 ## This method is called by list_default_generated. It performs the
2641 ## actual file insertion and grouping.
2642 ## Get the generated filenames
2643 my @added;
2644 foreach my $file (keys %$arr) {
2645 foreach my $gen ($self->generated_filenames($$arr{$file}, $gentype,
2646 $tag, $file, 1)) {
2647 $self->list_generated_file($gentype, $tag, \@added, $gen, $$arr{$file});
2651 if (defined $added[0]) {
2652 my $names = $self->{$tag};
2654 ## Get all files in one list and save the directory
2655 ## and component group in a hashed array.
2656 my @all;
2657 my %dircomp;
2658 foreach my $name (keys %$names) {
2659 foreach my $key (keys %{$$names{$name}}) {
2660 push(@all, @{$$names{$name}->{$key}});
2661 foreach my $file (@{$$names{$name}->{$key}}) {
2662 $dircomp{$self->mpc_dirname($file)} = $key;
2667 ## Create a small array of only the files we want to add.
2668 ## We put them all together so we can keep them in order when
2669 ## we put them at the front of the main file list.
2670 my @oktoadd;
2671 foreach my $file (@added) {
2672 push(@oktoadd, $file) if (!$self->already_added(\@all, $file));
2675 ## If we have files to add, make sure we add them to a group
2676 ## that has the same directory location as the files we're adding.
2677 if (defined $oktoadd[0]) {
2678 my $key = (defined $group ? $group :
2679 $dircomp{$self->mpc_dirname($oktoadd[0])});
2680 if (!defined $key) {
2681 my $check = $oktoadd[0];
2682 foreach my $regext (@{$self->{'valid_components'}->{$tag}}) {
2683 last if ($check =~ s/$regext$//);
2685 foreach my $vc (keys %{$self->{'valid_components'}}) {
2686 ## If this component name does not match the component name for
2687 ## which we are adding files and there are components defined
2688 ## for it, we will look to see if we can find a matching group
2689 ## name. We have to make sure that we do not use the hash map
2690 ## ($self->{$vc}) unless it's defined. Doing so will
2691 ## automatically create the map and that will cause MPC to
2692 ## think that the user provided the empty setting (when it
2693 ## wasn't).
2694 if ($vc ne $tag && defined $self->{$vc}) {
2695 foreach my $name (keys %{$self->{$vc}}) {
2696 foreach my $ckey (keys %{$self->{$vc}->{$name}}) {
2697 if ($ckey ne $defgroup) {
2698 foreach my $ofile (@{$self->{$vc}->{$name}->{$ckey}}) {
2699 my $file = $ofile;
2700 foreach my $regext (@{$self->{'valid_components'}->{$vc}}) {
2701 last if ($file =~ s/$regext$//);
2703 if ($file eq $check) {
2704 $key = $ckey;
2705 last;
2709 last if (defined $key);
2712 last if (defined $key);
2715 $key = $defgroup if (!defined $key);
2717 foreach my $name (keys %$names) {
2718 if (!defined $$names{$name}->{$key}) {
2719 if ($key ne $defgroup &&
2720 defined $$names{$name}->{$defgroup} &&
2721 defined $$names{$name}->{$defgroup}->[0]) {
2722 $self->process_assignment_add($grouped_key . $tag, $defgroup);
2724 $$names{$name}->{$key} = [];
2725 $self->process_assignment_add($grouped_key . $tag, $key);
2727 unshift(@{$$names{$name}->{$key}}, @oktoadd);
2734 sub search_for_entry {
2735 my($self, $file, $marray, $preproc) = @_;
2736 my $name;
2737 my $fh = new FileHandle();
2739 if (open($fh, $file)) {
2740 my $poundifed = 0;
2741 my $commented = 0;
2743 while(<$fh>) {
2744 ## Remove c++ style comments
2745 $_ =~ s/\/\/.*// if (!$commented);
2747 ## Remove one line c style comments
2748 $_ =~ s/\/\*.*\*\///g;
2750 if ($commented) {
2751 if (/\*\//) {
2752 ## Found the end of a multi-line c style comment
2753 --$commented;
2756 else {
2757 if (/\/\*/) {
2758 ## Found the beginning of a multi-line c style comment
2759 ++$commented;
2761 elsif ($preproc) {
2762 ## If the current language supports a c preprocessor, we
2763 ## will perform a minimal check for #if 0
2764 if (/#\s*if\s+0/) {
2765 ## Found the beginning of a #if 0
2766 ++$poundifed;
2768 elsif ($poundifed) {
2769 if (/#\s*if/) {
2770 ## We need to keep track of any other #if directives
2771 ## to be sure that when we see an #endif we don't
2772 ## count the wrong one.
2773 ++$poundifed;
2775 elsif (/#\s*endif/) {
2776 ## Found a #endif, so decrement our count
2777 --$poundifed;
2783 ## Check for main; Make sure it's not #if 0'ed and not commented out
2784 if (!$poundifed && !$commented) {
2785 my $found = undef;
2786 foreach my $main (@$marray) {
2787 if (/\s+$main\s*\(/ || /^\s*$main\s*\(/) {
2788 ## If we've found a main, set the exename to the basename
2789 ## of the cpp file with the extension removed
2790 $name = $self->mpc_basename($file);
2791 $name =~ s/\.[^\.]+$//;
2792 $found = 1;
2793 last;
2795 last if ($found);
2799 close($fh);
2801 return $name;
2805 sub find_main_file {
2806 my($self, $sources) = @_;
2807 my $lang = $self->get_language();
2808 my @main = $language{$lang}->[3];
2809 my $preproc = $language{$lang}->[4];
2811 ## If additional main's have been supplied by the user for this
2812 ## language type, then just push them onto the array.
2813 push(@main, @{$mains{$lang}}) if (defined $mains{$lang});
2815 ## Now search each source file until we've found a main function.
2816 foreach my $file (@$sources) {
2817 my $exename = $self->search_for_entry($file, \@main, $preproc);
2818 return $exename if (defined $exename);
2821 return undef;
2825 sub generate_default_target_names {
2826 my $self = shift;
2828 ## If this is a custom_only project, we need not waste time setting the
2829 ## sharedname, staticname or exename. Searching all of the files for a
2830 ## main function is very time consuming and unnecessary.
2831 return undef if ($self->get_assignment('custom_only'));
2833 if (!$self->exe_target()) {
2834 my $sharedname = $self->get_assignment('sharedname');
2835 my $staticname = $self->get_assignment('staticname');
2836 my $shared_empty;
2838 if (defined $sharedname) {
2839 if ($sharedname eq '') {
2840 $shared_empty = 1;
2841 $sharedname = undef;
2842 $self->process_assignment('sharedname', $sharedname);
2844 elsif (!defined $staticname) {
2845 $staticname = $sharedname;
2846 $self->process_assignment('staticname', $staticname);
2849 if (defined $staticname && !$shared_empty && !defined $sharedname) {
2850 $sharedname = $staticname;
2851 $self->process_assignment('sharedname', $sharedname);
2854 ## If it's neither an exe or library target, we will search
2855 ## through the source files for a main()
2856 if (!$self->lib_target()) {
2857 ## Set the exename assignment
2858 my @sources = $self->get_component_list('source_files', 1);
2859 my $exename = $self->find_main_file(\@sources);
2860 $self->process_assignment('exename', $exename) if (defined $exename);
2862 ## If we still don't have a project type, then we will
2863 ## default to a library if there are source or resource files
2864 if (!defined $exename) {
2865 if (!defined $sources[0]) {
2866 @sources = $self->get_component_list($self->get_resource_tag(), 1);
2868 if (defined $sources[0] || $self->default_to_library()) {
2869 if (!$shared_empty) {
2870 $self->process_assignment('sharedname',
2871 $self->{'unmodified_project_name'});
2873 $self->process_assignment('staticname',
2874 $self->{'unmodified_project_name'});
2880 ## If we are generating only static projects, then we need to
2881 ## unset the sharedname, so that we can insure that projects of
2882 ## various types only generate static targets.
2883 if ($self->get_static() == 1) {
2884 my $sharedname = $self->get_assignment('sharedname');
2885 if (defined $sharedname) {
2886 $self->process_assignment('sharedname', undef);
2890 ## Check for the use of an asterisk in the name
2891 foreach my $key ('exename', 'sharedname', 'staticname') {
2892 my $value = $self->get_assignment($key);
2893 if (defined $value && index($value, '*') >= 0) {
2894 $value = $self->fill_type_name($value,
2895 $self->{'unmodified_project_name'});
2896 $self->process_assignment($key, $value);
2902 sub generate_default_pch_filenames {
2903 my($self, $files) = @_;
2904 my $pchhdef = (defined $self->get_assignment('pch_header'));
2905 my $pchcdef = (defined $self->get_assignment('pch_source'));
2907 if (!$pchhdef || !$pchcdef) {
2908 my $pname = $self->get_assignment('project_name');
2909 my $hcount = 0;
2910 my $ccount = 0;
2911 my $hmatching;
2912 my $cmatching;
2913 foreach my $file (@$files) {
2914 ## If the file doesn't even contain _pch, then there's no point
2915 ## in looping through all of the extensions
2916 if (index($file, '_pch') >= 0) {
2917 if (!$pchhdef) {
2918 foreach my $ext (@{$self->{'valid_components'}->{'header_files'}}) {
2919 if ($file =~ /(.*_pch$ext)$/) {
2920 $self->process_assignment('pch_header', $1);
2921 ++$hcount;
2922 $hmatching = $file if (index($file, $pname) >= 0);
2923 last;
2927 if (!$pchcdef) {
2928 foreach my $ext (@{$self->{'valid_components'}->{'source_files'}}) {
2929 if ($file =~ /(.*_pch$ext)$/) {
2930 $self->process_assignment('pch_source', $1);
2931 ++$ccount;
2932 $cmatching = $file if (index($file, $pname) >= 0);
2933 last;
2939 if (!$pchhdef && $hcount > 1 && defined $hmatching) {
2940 $self->process_assignment('pch_header', $hmatching);
2942 if (!$pchcdef && $ccount > 1 && defined $cmatching) {
2943 $self->process_assignment('pch_source', $cmatching);
2949 sub fix_pch_filenames {
2950 my $self = shift;
2952 ## Unset the precompiled header settings if they are set but empty
2953 foreach my $type ('pch_header', 'pch_source') {
2954 my $pch = $self->get_assignment($type);
2955 $self->process_assignment($type, undef) if (defined $pch && $pch eq '');
2960 sub remove_extra_pch_listings {
2961 my $self = shift;
2962 my @pchs = ('pch_header', 'pch_source');
2963 my @tags = ('header_files', 'source_files');
2965 for(my $j = 0; $j < 2; ++$j) {
2966 my $pch = $self->get_assignment($pchs[$j]);
2968 if (defined $pch) {
2969 ## If we are converting slashes, then we need to
2970 ## convert the pch file back to forward slashes
2971 $pch =~ s/\\/\//g if ($self->{'convert_slashes'});
2973 ## Find out which files are duplicated
2974 my $names = $self->{$tags[$j]};
2975 foreach my $name (keys %$names) {
2976 my $comps = $$names{$name};
2977 foreach my $key (keys %$comps) {
2978 my $array = $$comps{$key};
2979 my $count = scalar(@$array);
2980 for(my $i = 0; $i < $count; ++$i) {
2981 if ($pch eq $$array[$i]) {
2982 splice(@$array, $i, 1);
2983 --$count;
2993 sub sift_files {
2994 my($self, $files, $exts, $pchh, $pchc, $tag, $array, $alldir) = @_;
2995 my @saved;
2996 my $havec = (defined $self->{'exclude_components'}->{$tag});
2998 ## The special actions taken based on $saverc only applies to
2999 ## C++ resource files.
3000 my $saverc = (!$alldir && $tag eq $self->get_resource_tag() &&
3001 $self->languageIs(Creator::cplusplus));
3003 foreach my $ext (@$exts) {
3004 foreach my $file (grep(/$ext$/, @$files)) {
3005 ## Always exclude the precompiled header and cpp
3006 if ((!defined $pchh || $file ne $pchh) &&
3007 (!defined $pchc || $file ne $pchc)) {
3008 if ($havec) {
3009 my $exclude = 0;
3010 foreach my $exc (@{$self->{'exclude_components'}->{$tag}}) {
3011 if ($file =~ /$exc$/) {
3012 $exclude = 1;
3013 last;
3016 next if ($exclude);
3018 elsif ($saverc) {
3019 ## Save these files for later. There may
3020 ## be more than one and we want to try and
3021 ## find the one that corresponds to this project
3022 push(@saved, $file);
3023 next;
3026 push(@$array, $file) if (!$self->already_added($array, $file));
3031 ## Now deal with the saved files
3032 if (defined $saved[0]) {
3033 if (!defined $saved[1]) {
3034 ## Theres only one rc file, take it
3035 push(@$array, $saved[0]);
3037 else {
3038 my $pjname = $self->escape_regex_special(
3039 $self->transform_file_name(
3040 $self->get_assignment('project_name')));
3041 ## Use a case insensitive search.
3042 ## After all, this is a Windows specific file type.
3043 foreach my $save (@saved) {
3044 if ($save =~ /$pjname/i) {
3045 if (!$self->already_added($array, $save)) {
3046 push(@$array, $save);
3055 sub sift_default_file_list {
3056 my($self, $tag, $file, $built, $exts, $recurse, $pchh, $pchc) = @_;
3057 my $alldir = $recurse ||
3058 (defined $self->{'flag_overrides'}->{$tag} &&
3059 defined $self->{'flag_overrides'}->{$tag}->{$file} &&
3060 $self->{'flag_overrides'}->{$tag}->{$file}->{'recurse'});
3061 my @gen = $self->generate_default_file_list($file, [], undef, $alldir);
3063 $self->sift_files(\@gen, $exts, $pchh, $pchc, $tag, $built, $alldir);
3067 sub correct_generated_files {
3068 my($self, $defcomp, $exts, $tag, $array) = @_;
3070 if (defined $sourceComponents{$tag}) {
3071 my $grtag = $grouped_key . $tag;
3072 foreach my $gentype (keys %{$self->{'generated_exts'}}) {
3073 ## If we are not automatically adding generated output, then we
3074 ## need to skip this component type.
3075 next if (!$self->{'generated_exts'}->{$gentype}->{'automatic_out'});
3077 ## If we are auto-generating the source_files, then
3078 ## we need to make sure that any generated source
3079 ## files that are added are put at the front of the list.
3080 my $newgroup;
3081 my @input;
3083 ## If I call keys %{$self->{$gentype}} using perl 5.6.1
3084 ## it returns nothing. I have to put it in an
3085 ## intermediate variable to ensure that I get the keys.
3086 my $names = $self->{$gentype};
3087 foreach my $name (keys %$names) {
3088 foreach my $key (keys %{$$names{$name}}) {
3089 push(@input, @{$$names{$name}->{$key}});
3090 $newgroup = $key if ($key ne $defgroup);
3094 if (defined $input[0]) {
3095 my @front;
3096 my @copy = @$array;
3098 @$array = ();
3099 foreach my $input (@input) {
3100 my $part = $self->remove_wanted_extension(
3101 $input,
3102 $self->{'valid_components'}->{$gentype});
3104 my @files = $self->generated_filenames($part, $gentype,
3105 $tag, $input);
3106 if (defined $copy[0]) {
3107 my $found = 0;
3108 foreach my $file (@files) {
3109 for(my $i = 0; $i < scalar(@copy); $i++) {
3110 my $re = $self->escape_regex_special($copy[$i]);
3111 if ($file eq $copy[$i] || $file =~ /[\/\\]$re$/) {
3112 ## No need to check for previously added files
3113 ## here since there are none.
3114 $found = 1;
3115 push(@front, $file);
3116 splice(@copy, $i, 1);
3117 last;
3120 last if ($found);
3122 if (!$found) {
3123 ## The first file listed in @files is the preferred
3124 ## extension for the custom command. Take the first
3125 ## file extension and see if it matches one in the accepted
3126 ## extensions.
3127 if (defined $files[0]) {
3128 my $ext;
3129 if ($files[0] =~ /.*(\.[^\.]+)$/) {
3130 $ext = $self->escape_regex_special($1);
3132 if (defined $ext) {
3133 ## If it doesn't match one of the accepted extensions,
3134 ## then just use the first extension from the type for
3135 ## which we are generating.
3136 $ext = $$exts[0] if (!StringProcessor::fgrep($ext, $exts));
3139 ## Add all the files that match the chosen extension
3140 foreach my $file (@files) {
3141 push(@front, $file) if ($file =~ /$ext$/);
3146 else {
3147 my $ext = $$exts[0];
3148 foreach my $file (@files) {
3149 push(@front, $file) if ($file =~ /$ext$/);
3153 if (defined $copy[0]) {
3154 ## No need to check for previously added files
3155 ## here since there are none.
3156 push(@$array, @copy);
3157 if (defined $self->get_assignment($grtag)) {
3158 $self->process_assignment_add($grtag, $defgroup);
3161 if (defined $front[0]) {
3162 if (defined $newgroup) {
3163 if (defined $copy[0]) {
3164 $self->process_assignment_add($grtag, $defgroup);
3166 if (!defined $self->{$tag}->{$defcomp}->{$newgroup}) {
3167 $self->{$tag}->{$defcomp}->{$newgroup} = \@front;
3169 else {
3170 push(@{$self->{$tag}->{$defcomp}->{$newgroup}}, @front);
3172 $self->process_assignment_add($grtag, $newgroup);
3174 else {
3175 unshift(@$array, @front);
3183 sub generate_default_components {
3184 my($self, $files, $passed) = @_;
3185 my $genext = $self->{'generated_exts'};
3186 my @gc = reverse sort { $self->sort_generated_types($a, $b)
3187 } keys %$genext;
3188 my @tags = (defined $passed ? $passed :
3189 (@gc, keys %{$language{$self->get_language()}->[0]}));
3190 my $pchh = $self->get_assignment('pch_header');
3191 my $pchc = $self->get_assignment('pch_source');
3192 my $recurse = $self->get_assignment('recurse');
3193 my $defcomp = $self->get_default_component_name();
3194 my $flo = $self->{'flag_overrides'};
3195 my $cmdflags = 'commandflags';
3197 ## The order of @tags does make a difference in the way that generated
3198 ## files get added. Hence the sort call on the generate_exts keys to
3199 ## ensure that user defined types come first. They are reverse sorted
3200 ## using the custom sort function to ensure that user defined types
3201 ## that rely on other user defined types for input files are processed
3202 ## first.
3203 foreach my $tag (@tags) {
3204 if (!defined $genext->{$tag} ||
3205 $genext->{$tag}->{'automatic_in'}) {
3206 my $exts = $self->{'valid_components'}->{$tag};
3207 if (defined $$exts[0]) {
3208 if (defined $self->{$tag}) {
3209 ## If the tag is defined, then process directories
3210 my $names = $self->{$tag};
3211 foreach my $name (keys %$names) {
3212 my $comps = $$names{$name};
3213 foreach my $comp (keys %$comps) {
3214 my $array = $$comps{$comp};
3215 if (defined $passed) {
3216 $self->sift_files($files, $exts, $pchh, $pchc, $tag, $array);
3218 else {
3219 my @built;
3220 my $alldirs = 1;
3221 foreach my $file (@$array) {
3222 if (-d $file) {
3223 my @portion;
3224 $self->sift_default_file_list($tag, $file, \@portion,
3225 $exts, $recurse, $pchh, $pchc);
3227 ## Since the file was actually a directory, we will
3228 ## need to propagate the flag overrides (if there are
3229 ## any) to the newly located files.
3230 if (defined $flo->{$tag} &&
3231 defined $flo->{$tag}->{$file}) {
3232 foreach my $built (@portion) {
3233 $flo->{$tag}->{$built} = $flo->{$tag}->{$file};
3237 ## Always push the @portion array onto the back of
3238 ## @built.
3239 push(@built, @portion);
3241 else {
3242 $alldirs = undef;
3243 if (!$self->already_added(\@built, $file)) {
3244 push(@built, $file);
3248 if ($alldirs) {
3249 $self->correct_generated_files($defcomp, $exts,
3250 $tag, \@built);
3252 $$comps{$comp} = \@built;
3257 else {
3258 ## Generate default values for undefined tags
3259 $self->{$tag} = {};
3260 my $comps = {};
3261 $self->{$tag}->{$defcomp} = $comps;
3262 $$comps{$defgroup} = [];
3263 my $array = $$comps{$defgroup};
3265 $self->{'defaulted'}->{$tag} = 1;
3267 if (!defined $specialComponents{$tag}) {
3268 $self->sift_files($files, $exts, $pchh, $pchc, $tag, $array);
3269 $self->correct_generated_files($defcomp, $exts, $tag, $array);
3273 ## If the type that we're generating defaults for ($tag) is a
3274 ## custom type, then we need to see if other custom types
3275 ## ($gentype) will generate files that will be used as input. It
3276 ## has to be done here so that the built-in types will have all
3277 ## of the possible input files that they can.
3278 if (defined $genext->{$tag}) {
3279 foreach my $gentype (keys %{$genext}) {
3280 if ($gentype ne $tag) {
3281 $self->list_default_generated($gentype, [$tag]);
3285 ## Now that we have the files for this type ($tag), we need to
3286 ## locate a command helper for the custom command and see if it
3287 ## knows about any additional output files based on the file
3288 ## name.
3289 my $cmdHelper = $self->find_command_helper($tag);
3290 if (defined $cmdHelper) {
3291 my $names = $self->{$tag};
3292 foreach my $name (keys %$names) {
3293 my $comps = $$names{$name};
3294 foreach my $comp (keys %$comps) {
3295 my $array = $$comps{$comp};
3296 foreach my $file (@$array) {
3297 my $flags = defined $flo->{$tag}->{$file} ?
3298 $flo->{$tag}->{$file}->{$cmdflags} :
3299 $genext->{$tag}->{$cmdflags};
3300 my ($add_out, $deps) = $cmdHelper->get_output($file, $flags);
3301 push(@{$self->{'custom_special_output'}->{$tag}->{$file}},
3302 @$add_out);
3303 foreach my $depTag (keys %$deps) {
3304 foreach my $depFile (keys %{$deps->{$depTag}}) {
3305 $self->add_custom_depend($depTag, $depFile,
3306 $deps->{$depTag}->{$depFile});
3320 sub remove_duplicated_files {
3321 my($self, $dest, $source) = @_;
3322 my @slist = $self->get_component_list($source, 1);
3324 ## There's no point in going on if there's nothing in this component
3325 ## list.
3326 return undef if ($#slist == -1);
3328 ## Convert the array into keys for a hash table
3329 my %shash;
3330 @shash{@slist} = ();
3332 ## Find out which source files are listed
3333 my $names = $self->{$dest};
3334 foreach my $name (keys %$names) {
3335 foreach my $key (keys %{$$names{$name}}) {
3336 my $array = $$names{$name}->{$key};
3337 my $count = scalar(@$array);
3338 for(my $i = 0; $i < $count; ++$i) {
3339 ## Is the source file in the component array?
3340 if (exists $shash{$$array[$i]}) {
3341 ## Remove the element and fix the index and count
3342 splice(@$array, $i, 1);
3343 --$count;
3344 --$i;
3352 sub generated_source_listed {
3353 my($self, $gent, $tag, $arr) = @_;
3354 my $names = $self->{$tag};
3356 ## Find out which generated source files are listed
3357 foreach my $name (keys %$names) {
3358 my $comps = $$names{$name};
3359 foreach my $key (keys %$comps) {
3360 foreach my $val (@{$$comps{$key}}) {
3361 foreach my $i (keys %$arr) {
3362 my @gfiles = $self->generated_filenames($$arr{$i}, $gent, $tag, $i);
3363 foreach my $re (@gfiles) {
3364 $re = $self->escape_regex_special($re);
3365 return 1 if ($val =~ /$re$/);
3372 return 0;
3376 sub list_default_generated {
3377 my($self, $gentype, $tags) = @_;
3379 ## This method is called when the user has custom input files and has
3380 ## provided source files. If the user defaults the component (i.e.
3381 ## source_files, resource_files, etc.) they are filled in by the
3382 ## generate_default_components method.
3384 if (defined $self->{'generated_exts'}->{$gentype} &&
3385 $self->{'generated_exts'}->{$gentype}->{'automatic_out'}) {
3386 ## After all source and headers have been defaulted, see if we
3387 ## need to add the generated files
3388 if (defined $self->{$gentype}) {
3389 ## Build up the list of files
3390 my %arr;
3391 #tie %arr, "Tie::IxHash"; # preserve insertion order.
3393 my $names = $self->{$gentype};
3394 my $group;
3395 foreach my $name (keys %$names) {
3396 foreach my $key (keys %{$$names{$name}}) {
3397 my $array = $$names{$name}->{$key};
3399 ## Take the last group name we encounter
3400 $group = $key if ($key ne $defgroup);
3402 foreach my $val (@$array) {
3403 $arr{$val} = $self->remove_wanted_extension(
3404 $val,
3405 $self->{'valid_components'}->{$gentype});
3410 foreach my $type (@$tags) {
3411 ## Only add generated files if the following is true:
3412 ## 1) The generating type is not the same as the receiving type.
3413 ## 2) The receiving type is not "special" (unless it hasn't been
3414 ## supplied by the user).
3415 ## 3) The receiving type is not user defined or it is user
3416 ## defined and has 'automatic_in' set to true.
3417 if ($gentype ne $type &&
3418 (!$specialComponents{$type} ||
3419 (!$self->{'special_supplied'}->{$type} ||
3420 UNIVERSAL::isa($self->{'special_supplied'}->{$type}, 'ARRAY'))) &&
3421 (!defined $self->{'generated_exts'}->{$type} ||
3422 $self->{'generated_exts'}->{$type}->{'automatic_in'})) {
3423 if (!$self->generated_source_listed($gentype, $type, \%arr)) {
3424 $self->add_generated_files($gentype, $type, $group, \%arr);
3433 sub prepend_gendir {
3434 my($self, $created, $ofile, $gentype) = @_;
3435 my $key;
3437 if (defined $self->{'flag_overrides'}->{$gentype}) {
3438 foreach my $ext (@{$self->{'valid_components'}->{$gentype}}) {
3439 my $e = $ext;
3440 $e =~ s/\\//g;
3441 $key = "$ofile$e";
3443 last if (defined $self->{'flag_overrides'}->{$gentype}->{$key});
3444 $key = undef;
3447 if (defined $key) {
3448 if (StringProcessor::fgrep('gendir',
3449 $self->{'matching_assignments'}->{$gentype})) {
3450 my $dir = $self->{'flag_overrides'}->{$gentype}->{$key}->{'gendir'};
3451 if (defined $dir) {
3452 ## Convert the file to unix style for basename
3453 if ($self->{'convert_slashes'}) {
3454 $created =~ s/\\/\//g;
3455 $dir =~ s/\\/\//g;
3457 return ($dir eq '.' ? '' : "$dir/") . $self->mpc_basename($created);
3463 return $created;
3467 sub list_generated_file {
3468 my($self, $gentype, $tag, $array, $file, $ofile) = @_;
3469 my $count = 0;
3471 ## Go through each file listed in our original type and attempt to find
3472 ## out if it is the generated file we may need to add ($file).
3473 foreach my $gen ($self->get_component_list($gentype, 1)) {
3474 my $input = $gen;
3476 ## Take the file and see if it contains an extension that our
3477 ## generating type ($gentype) knows about. If it does, remove it and
3478 ## stop looking for the extension.
3479 foreach my $ext (@{$self->{'valid_components'}->{$gentype}}) {
3480 ## Remove the extension.
3481 ## If it works, then we can exit this loop.
3482 last if ($gen =~ s/$ext$//);
3485 ## If the user provided file does not match any of the
3486 ## extensions specified by the custom definition, we need
3487 ## to remove the extension or else this file will not be
3488 ## added to the project.
3489 $gen =~ s/\.[^\.]+$// if ($gen eq $input);
3491 ## See if we need to add the file. We always need to check since the
3492 ## output file may have absolutely nothing in common with the input
3493 ## file.
3494 foreach my $created ($self->generated_filenames($gen, $gentype,
3495 $tag, $input)) {
3496 ## $gen is a file that has a custom definition that generates
3497 ## files of the type $tag. The $file passed in is of type
3498 ## $gentype and, as far as I can tell, $created will always be
3499 ## longer or of the same length of $file. It doesn't really
3500 ## matter if $file contains a '.' or not.
3501 if (index($created, $file) != -1) {
3502 if (defined $ofile) {
3503 $created = $self->prepend_gendir($created, $ofile, $gentype);
3505 if (!$self->already_added($array, $created)) {
3506 push(@$array, $created);
3507 ++$count;
3509 last;
3514 return $count;
3518 sub add_corresponding_component_files {
3519 my($self, $filecomp, $tag) = @_;
3520 my $grname = $grouped_key . $tag;
3522 ## Create a hash array keyed off of the existing files of the type
3523 ## that we plan on adding.
3524 my $fexist = 0;
3525 my %scfiles;
3526 my $names = $self->{$tag};
3527 foreach my $name (keys %$names) {
3528 ## Check to see if files exist in the default group
3529 if (defined $$names{$name}->{$defgroup} &&
3530 defined $$names{$name}->{$defgroup}->[0]) {
3531 $fexist = 1;
3533 foreach my $comp (keys %{$$names{$name}}) {
3534 @scfiles{@{$$names{$name}->{$comp}}} = ();
3538 ## Create an array of extensions for the files we want to add
3539 my @exts;
3540 foreach my $ext (@{$self->{'valid_components'}->{$tag}}) {
3541 push(@exts, $ext);
3542 $exts[$#exts] =~ s/\\//g;
3545 ## Check each file against a possible new file addition
3546 my $adddefaultgroup = 0;
3547 my $oktoadddefault = 0;
3548 foreach my $sfile (keys %$filecomp) {
3549 my $found = 0;
3550 foreach my $ext (@exts) {
3551 if (exists $scfiles{"$sfile$ext"}) {
3552 $found = 1;
3553 last;
3557 if (!$found) {
3558 ## Get the array of files for the selected component name
3559 my $array = [];
3560 my $comp = $$filecomp{$sfile};
3561 foreach my $name (keys %$names) {
3562 if (defined $$names{$name}->{$comp}) {
3563 $array = $$names{$name}->{$comp};
3567 ## First, see if it will be generated so that we can correctly
3568 ## deal with 'gendir' settings.
3569 foreach my $gentype (keys %{$self->{'generated_exts'}}) {
3570 $found += $self->list_generated_file($gentype, $tag, $array, $sfile);
3573 ## Next check to see if the file exists
3574 if (!$found) {
3575 foreach my $ext (@exts) {
3576 if (-r "$sfile$ext") {
3577 my $file = "$sfile$ext";
3578 if (!$self->already_added($array, $file)) {
3579 push(@$array, $file);
3580 ++$found;
3582 last;
3587 ## If we have any files at all in the component array, check
3588 ## to see if we need to add a new group name
3589 if (defined $$array[0]) {
3590 if ($comp eq $defgroup) {
3591 $adddefaultgroup = 1;
3593 else {
3594 my $grval = $self->get_assignment($grname);
3595 if (!defined $grval ||
3596 !StringProcessor::fgrep($comp, $self->create_array($grval))) {
3597 $self->process_assignment_add($grname, $comp);
3599 $oktoadddefault = 1;
3600 $adddefaultgroup |= $fexist;
3603 ## Put the array back into the component list
3604 if ($found) {
3605 foreach my $name (keys %$names) {
3606 $$names{$name}->{$comp} = $array;
3613 ## We only need to add the default group name if we wanted to
3614 ## add the default group when adding new files and we added a group
3615 ## by some other name. Otherwise, defaulted files would always be
3616 ## in a group, which is not what we want.
3617 if ($adddefaultgroup && $oktoadddefault) {
3618 $self->process_assignment_add($grname, $defgroup);
3623 sub get_default_project_name {
3624 my $self = shift;
3625 my $name = $self->{'current_input'};
3627 if ($name eq '') {
3628 $name = $self->transform_file_name($self->base_directory());
3630 else {
3631 ## Since files on UNIX can have back slashes, we transform them
3632 ## into underscores.
3633 $name =~ s/\\/_/g;
3635 ## Convert the name to a usable name
3636 $name = $self->transform_file_name($name);
3638 ## Take off the extension
3639 $name =~ s/\.[^\.]+$//;
3642 return $name;
3646 sub remove_excluded {
3647 my $self = shift;
3648 my @tags = @_;
3650 ## Process each file type and remove the excluded files
3651 foreach my $tag (@tags) {
3652 my $names = $self->{$tag};
3653 foreach my $name (keys %$names) {
3654 foreach my $comp (keys %{$$names{$name}}) {
3655 my $count = scalar(@{$$names{$name}->{$comp}});
3656 for(my $i = 0; $i < $count; ++$i) {
3657 my $file = $$names{$name}->{$comp}->[$i];
3658 if (defined $self->{'remove_files'}->{$tag}->{$file}) {
3659 splice(@{$$names{$name}->{$comp}}, $i, 1);
3660 --$i;
3661 --$count;
3663 else {
3664 ## The file does not match exactly with one of the files to
3665 ## remove. Look for wildcard specifications in the files to
3666 ## be removed and perform the removal if one of them matches
3667 ## the current file.
3668 foreach my $key (keys %{$self->{'remove_files'}->{$tag}}) {
3669 if ($key =~ /[\*\?\[\]]/) {
3670 my $regex = $key;
3671 $regex =~ s/\./\\./g;
3672 $regex =~ s/\*/\.\*/g;
3673 $regex =~ s/\?/\./g;
3674 if ($file =~ /^$regex$/) {
3675 splice(@{$$names{$name}->{$comp}}, $i, 1);
3676 --$i;
3677 --$count;
3678 last;
3686 delete $self->{'remove_files'}->{$tag};
3691 sub sort_generated_types {
3692 ## We need to sort the custom component types such that a custom type
3693 ## that generates input for another custom type comes first in the
3694 ## list.
3695 my($self, $left, $right, $norecurse) = @_;
3696 foreach my $key (keys %{$self->{'generated_exts'}->{$left}}) {
3697 if ($key =~ /_files$/) {
3698 foreach my $regex (@{$self->{'generated_exts'}->{$left}->{$key}}) {
3699 my $ext = $regex;
3700 $ext =~ s/\\//g;
3701 foreach my $vreg (@{$self->{'valid_components'}->{$right}}) {
3702 return -1 if ($ext =~ /$vreg$/);
3707 if (!$norecurse && $self->sort_generated_types($right, $left, 1) == -1) {
3708 return 1;
3711 return 0;
3714 sub generate_defaults {
3715 my $self = shift;
3717 ## Generate default project name
3718 if (!defined $self->get_assignment('project_name')) {
3719 $self->set_project_name($self->get_default_project_name());
3722 ## Generate the default pch file names (if needed)
3723 my @files = $self->generate_default_file_list(
3724 '.', [],
3725 undef, $self->get_assignment('recurse'));
3726 $self->generate_default_pch_filenames(\@files);
3728 ## If the pch file names are empty strings then we need to fix that
3729 $self->fix_pch_filenames();
3731 ## Generate default components, but %specialComponents
3732 ## are skipped in the initial default components generation
3733 $self->generate_default_components(\@files);
3735 ## Remove source files that are also listed in the template files
3736 ## If we do not do this, then generated projects can be invalid.
3737 $self->remove_duplicated_files('source_files', 'template_files');
3739 ## If pch files are listed in header_files or source_files more than
3740 ## once, we need to remove the extras
3741 $self->remove_extra_pch_listings();
3743 ## Generate the default generated list of files only if we defaulted
3744 ## the generated file list. I want to ensure that source_files comes
3745 ## first in the list to pick up group information (since source_files
3746 ## are most likely going to be grouped than anything else).
3747 my @vc = sort { return -1 if $a eq 'source_files';
3748 return 1 if $b eq 'source_files';
3749 return $b cmp $a; } keys %{$self->{'valid_components'}};
3750 my @gvc = sort { $self->sort_generated_types($a, $b)
3751 } keys %{$self->{'generated_exts'}};
3752 foreach my $gentype (@gvc) {
3753 $self->list_default_generated($gentype, \@vc);
3756 ## Now that all of the source files have been added
3757 ## we need to remove those that have need to be removed
3758 $self->remove_excluded('source_files');
3760 ## Collect up all of the source files that have already been listed
3761 ## with the extension removed for use directly below.
3762 my %sourcecomp;
3763 foreach my $sourcetag (keys %sourceComponents) {
3764 my $names = $self->{$sourcetag};
3765 foreach my $name (keys %$names) {
3766 foreach my $comp (keys %{$$names{$name}}) {
3767 foreach my $sfile (@{$$names{$name}->{$comp}}) {
3768 my $mod = $sfile;
3769 $mod =~ s/\.[^\.]+$//;
3770 $sourcecomp{$mod} = $comp;
3776 ## Add %specialComponents files based on the
3777 ## source_components (i.e. .h and .i or .inl based on .cpp)
3778 foreach my $tag (keys %specialComponents) {
3779 $self->add_corresponding_component_files(\%sourcecomp, $tag);
3782 ## Now, if the %specialComponents are still empty
3783 ## then take any file that matches the components extension
3784 foreach my $tag (keys %specialComponents) {
3785 if (!$self->{'special_supplied'}->{$tag} ||
3786 UNIVERSAL::isa($self->{'special_supplied'}->{$tag}, 'ARRAY')) {
3787 my $names = $self->{$tag};
3788 if (defined $names) {
3789 ## We only want to generate default components if we have
3790 ## defaulted the source files or we have no files listed
3791 ## in the current special component.
3792 my $ok = $self->{'defaulted'}->{'source_files'};
3793 if (!$ok) {
3794 my @all;
3795 foreach my $name (keys %$names) {
3796 foreach my $key (keys %{$$names{$name}}) {
3797 push(@all, @{$$names{$name}->{$key}});
3800 $ok = (!defined $all[0]);
3802 if ($ok) {
3803 ## If the "special" type was supplied and it was all
3804 ## directories, we need to use those directories to generate
3805 ## the default components instead of the current directory.
3806 my $fileref = \@files;
3807 if (defined $self->{'special_supplied'}->{$tag} &&
3808 UNIVERSAL::isa($self->{'special_supplied'}->{$tag}, 'ARRAY')) {
3809 my @special;
3810 foreach my $dir (@{$self->{'special_supplied'}->{$tag}}) {
3811 push(@special, $self->generate_default_file_list(
3812 $dir, [], undef,
3813 $self->get_assignment('recurse')));
3815 $fileref = \@special;
3817 $self->generate_default_components($fileref, $tag);
3823 ## The code to add template files automatically when it is left
3824 ## defaulted by the user may add source files that happen to end in _t
3825 ## (minus the extension). If we do not remove template files that are
3826 ## also listed as source files, the generated projects can be invalid.
3827 $self->remove_duplicated_files('template_files', 'source_files');
3829 ## Now that all of the other files have been added
3830 ## we need to remove those that have need to be removed
3831 my @rmkeys = keys %{$self->{'remove_files'}};
3832 $self->remove_excluded(@rmkeys) if (defined $rmkeys[0]);
3834 ## Tie custom files together if need be. This currently only applies
3835 ## to types with command helpers. At some point, if it is found to be
3836 ## desirous, we could extend the MPC syntax somehow to support this
3837 ## sort of thing manually.
3838 my $dep = 'dependent';
3839 foreach my $gentype (@gvc) {
3840 my $cmdHelper = $self->find_command_helper($gentype);
3841 if (defined $cmdHelper) {
3842 ## There has to be at least two files files in order for
3843 ## something to be tied together.
3844 my @files = $self->get_component_list($gentype, 1);
3845 if ($#files >= 1) {
3846 foreach my $file (@files) {
3847 my $part = $self->remove_wanted_extension(
3848 $file, $self->{'valid_components'}->{$gentype});
3849 my($tied, $vc) = $cmdHelper->get_tied($file, \@files);
3850 foreach my $tie (@$tied) {
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 my @gen;
3856 if (!defined $vc) {
3857 foreach $vc (@vc) {
3858 @gen = $self->generated_filenames($part, $gentype,
3859 $vc, $file);
3860 last if ($#gen >= 0);
3863 @gen = $self->generated_filenames($part, $gentype,
3864 $vc, $file) if (!$gen[0]);
3866 ## We have found a set of files that are generated
3867 ## based on the component type of the original file
3868 ## ($gentype), so we just add the first one and
3869 ## we're done.
3870 my $first = $gen[0];
3871 my $needcopy = 1;
3872 if (!defined $self->{'flag_overrides'}->{$gentype}->{$tie}->{$dep}) {
3873 ## We are about to modify the flag overrides for a tied file.
3874 ## We need to make a copy so that we do not affect the
3875 ## overrides of grouped, but no longer affiliated files.
3876 my %copy = %{$self->{'flag_overrides'}->{$gentype}->{$tie}};
3877 $self->{'flag_overrides'}->{$gentype}->{$tie} = \%copy;
3878 $needcopy = undef;
3880 ## Start a new dependent setting based on the original
3881 ## custom build settings.
3882 $self->{'flag_overrides'}->{$gentype}->{$tie}->{$dep} =
3883 $self->{'generated_exts'}->{$gentype}->{$dep};
3886 if (!defined $self->{'flag_overrides'}->{$gentype}->{$tie}->{$dep} ||
3887 $self->{'flag_overrides'}->{$gentype}->{$tie}->{$dep} !~ /\b$first\b/) {
3888 if ($needcopy) {
3889 ## We are about to modify the flag overrides for a tied file.
3890 ## We need to make a copy so that we do not affect the
3891 ## overrides of grouped, but no longer affiliated files.
3892 my %copy = %{$self->{'flag_overrides'}->{$gentype}->{$tie}};
3893 $self->{'flag_overrides'}->{$gentype}->{$tie} = \%copy;
3894 $needcopy = undef;
3897 ## Update the dependent value for this tied file.
3898 $self->{'flag_overrides'}->{$gentype}->{$tie}->{$dep} .= " $first";
3908 sub set_project_name {
3909 my($self, $name) = @_;
3911 ## Save the unmodified project name so that when we
3912 ## need to determine the default target name, we can use
3913 ## what is expected by the user.
3914 $self->{'unmodified_project_name'} = $name;
3916 ## If we are applying the name modifier to the project
3917 ## then we will modify the project name
3918 if ($self->get_apply_project()) {
3919 my $nmod = $self->get_name_modifier();
3921 if (defined $nmod) {
3922 $nmod =~ s/\*/$name/g;
3923 $name = $nmod;
3927 ## Set the project_name assignment so that the TemplateParser
3928 ## can get the project name.
3929 $self->process_assignment('project_name', $name);
3933 sub project_name {
3934 return $_[0]->get_assignment('project_name');
3938 sub lib_target {
3939 my $self = shift;
3940 return (defined $self->get_assignment('sharedname') ||
3941 defined $self->get_assignment('staticname'));
3945 sub exe_target {
3946 return (defined $_[0]->get_assignment('exename'));
3950 sub get_component_list {
3951 my($self, $tag, $noconvert) = @_;
3952 my $names = $self->{$tag};
3953 my @list;
3955 foreach my $name (keys %$names) {
3956 foreach my $key (keys %{$$names{$name}}) {
3957 push(@list, @{$$names{$name}->{$key}});
3961 ## By default, if 'convert_slashes' is true, then we convert slashes
3962 ## to backslashes. There are cases where we do not want to convert
3963 ## the slashes, in that case get_component_list() was called with
3964 ## an additional parameter indicating this.
3965 if (!$noconvert && $self->{'convert_slashes'}) {
3966 foreach my $item (@list) {
3967 $item =~ s/\//\\/g;
3971 if ($self->{'sort_files'}) {
3972 @list = sort { $self->file_sorter($a, $b) } @list;
3975 return @list;
3979 sub check_custom_output {
3980 my($self, $based, $cinput, $ainput, $type, $comps) = @_;
3981 my @outputs;
3983 foreach my $array ($self->generated_filenames($cinput, $based,
3984 $type, $ainput, 0, 1)) {
3985 foreach my $built (@$array) {
3986 if (@$comps == 0) {
3987 push(@outputs, $built);
3988 last;
3990 elsif (defined $specialComponents{$type} &&
3991 (!$self->{'special_supplied'}->{$type} ||
3992 UNIVERSAL::isa($self->{'special_supplied'}->{$type}, 'ARRAY'))) {
3993 push(@outputs, $built);
3994 last;
3996 else {
3997 my $base = $built;
3998 $base =~ s/\\/\//g if ($self->{'convert_slashes'});
3999 my $re = $self->escape_regex_special($self->mpc_basename($base));
4000 foreach my $c (@$comps) {
4001 ## We only match if the built file name matches from
4002 ## beginning to end or from a slash to the end.
4003 if ($c =~ /^$re$/ || $c =~ /[\/\\]$re$/) {
4004 push(@outputs, $built);
4005 last;
4012 return @outputs;
4016 sub get_special_value {
4017 my $self = shift;
4018 my $type = shift;
4019 my $cmd = shift;
4020 my $based = shift;
4021 my @params = @_;
4023 ## These names (held in $type) are variables that contain various
4024 ## commands that will be used in templates within the context of a
4025 ## foreach (e.g., <%custom_type->input_files%> or <%feature->value%>).
4026 if ($type eq 'feature') {
4027 return $self->get_feature_value($cmd, $based);
4029 elsif (index($type, 'custom_type') == 0) {
4030 return $self->get_custom_value($cmd, $based, @params);
4032 elsif (index($type, $grouped_key) == 0) {
4033 return $self->get_grouped_value($type, $cmd, $based);
4035 elsif (defined $self->get_addtemp()->{$type . 's'}) {
4036 if ($cmd eq '_default') {
4037 $based =~ /^([^:]+):/;
4038 return defined $1 ? $1 : $based;
4040 else {
4041 if ($based =~ /:(.*)/) {
4042 my %attr = map { split('=', $_) } split(',', $1);
4043 return $attr{$cmd};
4047 else {
4048 my $language = $self->get_language();
4050 ## If the passed in type is not a builtin type, try the type with an
4051 ## 's' on the end.
4052 $type .= 's' if (!defined $language{$language}->[0]->{$type});
4054 ## This is a hack for dealing with the fact that built-in types
4055 ## (e.g., Source_Files, Header_Files, etc.) are not real custom
4056 ## definitions. However, we can "modify" them to some extent.
4057 return $self->get_builtin_value($type, $cmd, $based)
4058 if (defined $language{$language}->[0]->{$type});
4061 return undef;
4065 sub get_feature_value {
4066 my($self, $cmd, $based) = @_;
4068 if ($cmd eq 'value') {
4069 my $val = $self->{'feature_parser'}->get_value($based);
4070 if (defined $val && $val != 0) {
4071 return 1;
4075 return undef;
4079 sub get_grouped_value {
4080 my($self, $type, $cmd, $based) = @_;
4081 my $value;
4083 ## Make it all lower case
4084 $type = lc($type);
4086 ## Remove the grouped_ part
4087 $type =~ s/^$grouped_key//;
4089 ## Add the s if it isn't there
4090 $type .= 's' if ($type !~ /s$/);
4092 my $names = $self->{$type};
4093 if ($cmd eq 'files') {
4094 foreach my $name (keys %$names) {
4095 my $comps = $$names{$name};
4096 my @keys = keys %$comps;
4097 if (StringProcessor::fgrep($based, \@keys)) {
4098 if ($self->{'convert_slashes'}) {
4099 my @converted;
4100 foreach my $file (@{$$comps{$based}}) {
4101 push(@converted, $self->slash_to_backslash($file));
4103 $value = \@converted;
4105 else {
4106 $value = $$comps{$based};
4108 if ($self->{'sort_files'}) {
4109 my @sorted = sort { $self->file_sorter($a, $b) } @$value;
4110 $value = \@sorted;
4115 elsif ($cmd eq 'component_name') {
4116 ## If there is more than one name, then we will need
4117 ## to deal with that at a later time.
4118 foreach my $name (keys %$names) {
4119 $value = $name;
4123 return $value;
4127 sub get_builtin_value {
4128 my($self, $type, $cmd, $based) = @_;
4130 ## If the passed in type does not have a generated_exts definition,
4131 ## then try the type with an 's' on the end.
4132 $type .= 's' if (!defined $self->{'generated_exts'}->{$type});
4134 ## If we have a builtin type that has the variable ($cmd) that we are
4135 ## looking for, process the value through command parameter conversion.
4136 if (defined $self->{'generated_exts'}->{$type} &&
4137 defined $self->{'generated_exts'}->{$type}->{$cmd}) {
4138 return $self->convert_command_parameters(
4139 $type, $self->{'generated_exts'}->{$type}->{$cmd},
4140 $based, $self->get_builtin_output($based));
4143 ## Otherwise, there's nothing here.
4144 return undef;
4147 sub get_command_subs {
4148 my $self = shift;
4149 my %valid;
4151 ## Add the built-in OS compatibility commands
4152 if (UNIVERSAL::isa($self, 'WinProjectBase') ||
4153 $self->use_win_compatibility_commands()) {
4154 $valid{'cat'} = 'type';
4155 $valid{'cmp'} = 'fc /b';
4156 $valid{'cp'} = 'copy /y';
4157 $valid{'mkdir'} = 'mkdir';
4158 $valid{'mv'} = 'move /y';
4159 $valid{'os'} = 'win32';
4160 $valid{'rm'} = 'del /f/s/q';
4161 $valid{'rmdir'} = 'rmdir /s/q';
4162 $valid{'nul'} = 'nul';
4163 $valid{'slash'} = '\\';
4164 $valid{'bat'} = '.bat';
4165 $valid{'cmd'} = '.cmd';
4166 $valid{'exe'} = '.exe';
4167 $valid{'pathsep'} = ';';
4169 else {
4170 $valid{'cat'} = 'cat';
4171 $valid{'cmp'} = 'cmp';
4172 $valid{'cp'} = 'cp -f';
4173 $valid{'mkdir'} = 'mkdir -p';
4174 $valid{'mv'} = 'mv -f';
4175 $valid{'os'} = 'unix';
4176 $valid{'rm'} = 'rm -rf';
4177 $valid{'rmdir'} = 'rm -rf';
4178 $valid{'nul'} = '/dev/null';
4179 $valid{'slash'} = '/';
4180 $valid{'bat'} = '';
4181 $valid{'cmd'} = '';
4182 $valid{'exe'} = '';
4183 $valid{'pathsep'} = ':';
4186 ## Add the project specific compatibility commands
4187 $valid{'gt'} = $self->get_gt_symbol();
4188 $valid{'lt'} = $self->get_lt_symbol();
4189 $valid{'and'} = $self->get_and_symbol();
4190 $valid{'or'} = $self->get_or_symbol();
4191 $valid{'quote'} = $self->get_quote_symbol();
4192 $valid{'equote'} = $self->get_escaped_quote_symbol();
4193 $valid{'crlf'} = $self->crlf();
4194 $valid{'cmdsep'} = $self->get_cmdsep_symbol();
4195 $valid{'temporary'} = 'temp.$$$$.' . int(rand(0xffffffff));
4196 $valid{'prj_type'} = $self->{'pctype'};
4198 return \%valid;
4202 sub replace_parameters {
4203 my($self, $str, $valid, $nowarn, $input, $output, $always_clear) = @_;
4205 my %saved;
4206 my $count = 0;
4207 while ($str =~ /<%(\w+)(\(\w+\))?%>/) {
4208 my $name = $1;
4209 my $modifier = $2;
4210 if (defined $modifier) {
4211 my $tmp = $name;
4212 $name = $modifier;
4213 $name =~ s/[\(\)]//g;
4214 $modifier = $tmp;
4217 ## Support both pseudo variables and project settings
4218 if (defined $$valid{$name} || $self->is_keyword($name)) {
4219 ## If the pseudo variable is defined or the project setting has a
4220 ## value, then we'll need to do the replacement. However, if it's
4221 ## a project keyword and it's not defined, we will need to delay
4222 ## the replacement until later (unless $always_clear is true).
4223 my $replace;
4224 my $clear = $always_clear;
4225 if (defined $$valid{$name}) {
4226 $replace = $$valid{$name};
4228 elsif ($self->is_keyword($name)) {
4229 $replace = $self->get_assignment($name);
4232 ## Perform the modification and replacement here
4233 if (defined $replace) {
4234 if (defined $modifier) {
4235 if ($modifier eq 'noextension') {
4236 $replace =~ s/\.[^\.]+$//;
4238 else {
4239 $self->warning("Unknown parameter modifier $modifier.");
4242 $str =~ s/<%\w+(\(\w+\))?%>/$replace/;
4244 elsif ($clear) {
4245 ## We need to clear out this variable usage.
4246 $str =~ s/<%\w+(\(\w+\))?%>//;
4248 else {
4249 ## Save this variable usage to be put back after we're done
4250 ## processing the string.
4251 my $key = "\1" . $count++ . "\1";
4252 if ($str =~ s/(<%\w+(\(\w+\))?%>)/$key/) {
4253 $saved{$key} = $1;
4257 else {
4258 $str =~ s/<%\w+(\(\w+\))?%>//;
4260 ## We only want to warn the user that we did not recognize the
4261 ## pseudo template parameter if there was an input and an output
4262 ## file passed to this function. If this variable was used
4263 ## without the parenthesis (as in an if statement), then we don't
4264 ## want to warn the user.
4265 if (defined $input && defined $output) {
4266 if (!defined $$nowarn{$name}) {
4267 $self->warning("<%$name%> was not recognized.");
4270 ## If we didn't recognize the pseudo template parameter then
4271 ## we don't want to return anything back.
4272 return undef;
4277 ## Replace the saved variables so that they may be replaced (or
4278 ## removed) later on.
4279 foreach my $key (keys %saved) {
4280 $str =~ s/$key/$saved{$key}/;
4282 return $str;
4286 sub convert_command_parameters {
4287 my($self, $ktype, $str, $input, $output) = @_;
4288 my %nowarn;
4289 my %valid = %{$self->{'command_subs'}};
4291 ## Add in the values that change for every call to this function
4292 $valid{'temporary'} = 'temp.$$$$.' . int(rand(0xffffffff));
4294 if (defined $input) {
4295 $valid{'input'} = $input;
4296 $valid{'input_basename'} = $self->mpc_basename($input);
4297 $valid{'input_dirname'} = $self->mpc_dirname($input);
4298 $valid{'input_noext'} = $input;
4300 ## An input file doesn't always have an extension. If there isn't
4301 ## one, then we need to set the 'input_ext' field to an empty string
4302 ## ($1 will not necessarily have a valid value).
4303 if ($valid{'input_noext'} =~ s/(\.[^\.]+)$//) {
4304 $valid{'input_ext'} = $1;
4306 else {
4307 $valid{'input_ext'} = '';
4310 ## Check for the gendir setting associated with this input file. We
4311 ## have to check at so many levels so we don't inadvertently create
4312 ## intermediate hash tables.
4313 if (defined $self->{'flag_overrides'}->{$ktype} &&
4314 defined $self->{'flag_overrides'}->{$ktype}->{$input} &&
4315 $self->{'flag_overrides'}->{$ktype}->{$input}->{'gendir'}) {
4316 $valid{'gendir'} = $self->{'flag_overrides'}->{$ktype}->{$input}->{'gendir'};
4320 ## If there is no gendir setting, just set it to the current directory.
4321 $valid{'gendir'} = '.' if (!defined $valid{'gendir'});
4323 if (defined $output) {
4324 my $first = 1;
4325 $valid{'output'} = "@$output";
4326 foreach my $out (@$output) {
4327 ## An output file doesn't always have an extension. If there isn't
4328 ## one, then we need to set the 'output_ext' field to an empty
4329 ## string ($1 will not necessarily have a valid value).
4330 my $noext = $out;
4331 if ($noext =~ s/(\.[^\.]+)$//) {
4332 $valid{'output_ext'} = $1;
4334 else {
4335 $valid{'output_ext'} = '';
4337 $valid{'output_noext'} .= (!$first ? ' ' : '') . $noext;
4339 ## In order to call basename or dirname, we must make sure that the
4340 ## directory separators are forward slashes.
4341 my $file = $out;
4342 $file =~ s/\\/\//g if ($self->{'convert_slashes'});
4343 $valid{'output_basename'} .= (!$first ? ' ' : '') .
4344 $self->mpc_basename($file);
4345 $valid{'output_dirname'} .= (!$first ? ' ' : '') .
4346 $self->mpc_dirname($file);
4347 $first = 0;
4351 ## Add in the specific types of output files
4352 if (defined $output) {
4353 foreach my $type (keys %{$self->{'valid_components'}}) {
4354 my $key = $type;
4355 $key =~ s/s$//gi;
4356 $nowarn{$key} = 1;
4357 $nowarn{$key . '_noext'} = 1;
4358 foreach my $ext (@{$self->{'valid_components'}->{$type}}) {
4359 foreach my $out (@$output) {
4360 if ($out =~ /$ext$/) {
4361 $valid{$key} = $out;
4362 $valid{$key . '_noext'} = $out;
4363 $valid{$key . '_noext'} =~ s/$ext$//;
4364 last;
4371 return $self->replace_parameters($str, \%valid, \%nowarn, $input, $output, 1);
4375 sub get_custom_special_output {
4376 my $self = shift;
4377 my $tag = shift;
4378 my $input = shift;
4379 if (defined $self->{'custom_special_output'}->{$tag} &&
4380 defined $self->{'custom_special_output'}->{$tag}->{$input} &&
4381 (!defined $self->{'flag_overrides'}->{$tag} ||
4382 !defined $self->{'flag_overrides'}->{$tag}->{$input} ||
4383 !defined $self->{'flag_overrides'}->{$tag}->{$input}->{'gendir'}
4384 || $self->{'flag_overrides'}->{$tag}->{$input}->{'gendir'} eq '.')) {
4385 return $self->{'custom_special_output'}->{$tag}->{$input};
4387 return [];
4391 sub get_first_custom_output {
4392 my $self = shift;
4393 my $input = shift;
4394 my $tag = shift;
4395 my %vcomps;
4396 foreach my $vc (keys %{$self->{'valid_components'}}) {
4397 my @comps = $self->get_component_list($vc);
4398 $vcomps{$vc} = \@comps;
4400 $vcomps{$generic_key} = [];
4401 my $ainput = $input;
4402 my $cinput = $input;
4404 ## Remove the extension
4405 $cinput =~ s/\.[^\.]+$//;
4407 ## If we are converting slashes,
4408 ## change them back for this parameter
4409 $ainput =~ s/\\/\//g if ($self->{'convert_slashes'});
4411 foreach my $vc (keys %{$self->{'valid_components'}}) {
4412 my @cout = $self->check_custom_output($tag, $cinput, $ainput, $vc,
4413 $vcomps{$vc});
4414 return $cout[0] if @cout;
4416 my @cout = $self->check_custom_output($tag, $cinput, $ainput, $generic_key,
4417 $vcomps{$generic_key});
4418 return $cout[0] if @cout;
4419 my $aref = $self->get_custom_special_output($tag, $ainput);
4420 return $$aref[0] if @$aref;
4421 return '';
4425 sub get_custom_assign_or_override {
4426 my $self = shift;
4427 my $var = shift; # which variable? (command, commandflags, etc.)
4428 my $tag = shift; # custom_files
4429 my $input = shift; # input file name which may override
4430 my @params = @_;
4432 my $key = undef;
4433 if (defined $self->{'flag_overrides'}->{$tag}) {
4434 my $ustyle = $input;
4435 $ustyle =~ s/\\/\//g if ($self->{'convert_slashes'});
4436 my $dir = $self->mpc_dirname($ustyle);
4437 if (defined $self->{'flag_overrides'}->{$tag}->{$ustyle}) {
4438 $key = $ustyle;
4440 elsif (defined $self->{'flag_overrides'}->{$tag}->{$dir}) {
4441 $key = $dir;
4444 my $value = undef;
4445 if (defined $key) {
4446 $value = $self->{'flag_overrides'}->{$tag}->{$key}->{$var};
4448 if (!defined $value) {
4449 $value = $self->get_assignment($var, $self->{'generated_exts'}->{$tag});
4451 return undef if !defined $value;
4452 if (defined $customDefined{$var} && ($customDefined{$var} & 0x14)) {
4453 return $self->convert_command_parameters($tag, $value, $input, undef, @params);
4455 return $value;
4459 sub get_custom_value {
4460 my $self = shift;
4461 my $cmd = shift;
4462 my $based = shift;
4463 my @params = @_;
4464 my $value;
4466 if ($cmd eq 'input_files') {
4467 ## Get the component list for the component type
4468 my @array = $self->get_component_list($based);
4470 ## Check for directories in the component list. If the component
4471 ## type is not automatic, we may have directories here and will need
4472 ## to get the file list for that type.
4473 my $once;
4474 for(my $i = 0; $i < scalar(@array); ++$i) {
4475 if (-d $array[$i]) {
4476 if (!defined $once) {
4477 $once = {'recurse' => $self->get_assignment('recurse'),
4478 'pchh' => $self->get_assignment('pch_header'),
4479 'pchc' => $self->get_assignment('pch_source'),
4482 my @built;
4483 $self->sift_default_file_list($based, $array[$i], \@built,
4484 $self->{'valid_components'}->{$based},
4485 $$once{'recurse'},
4486 $$once{'pchh'}, $$once{'pchc'});
4487 splice(@array, $i, 1, @built);
4488 $i += $#built;
4492 $value = \@array;
4494 $self->{'custom_output_files'} = {};
4495 $self->{'custom_dependency_files'} = {};
4496 $self->{'custom_multi_cmd'} = {};
4497 my %vcomps;
4498 foreach my $vc (keys %{$self->{'valid_components'}}) {
4499 my @comps = $self->get_component_list($vc);
4500 $vcomps{$vc} = \@comps;
4502 $vcomps{$generic_key} = [];
4504 foreach my $input (@array) {
4505 my @outputs;
4506 my $ainput = $input;
4507 my $cinput = $input;
4509 ## Remove the extension
4510 $cinput =~ s/\.[^\.]+$//;
4512 ## If we are converting slashes,
4513 ## change them back for this parameter
4514 $ainput =~ s/\\/\//g if ($self->{'convert_slashes'});
4516 if (defined $self->{'combined_custom'}->{$based}) {
4517 $self->{'custom_multi_cmd'}->{$input} =
4518 $self->{'combined_custom'}->{$based};
4520 my $cdf = $self->{'custom_dependency_files'};
4521 my $csd = $self->{'custom_special_depend'};
4522 foreach my $tag (@{$self->{'combined_custom'}->{$based}}) {
4523 if (defined $csd->{$tag} && defined $csd->{$tag}->{$ainput}) {
4524 $cdf->{$input} = [] if (!defined $cdf->{$input});
4525 StringProcessor::merge($cdf->{$input}, $csd->{$tag}->{$ainput});
4529 else {
4530 $self->{'custom_dependency_files'}->{$input} =
4531 $self->{'custom_special_depend'}->{$based}->{$ainput};
4534 ## Add all of the output files. We can not add $generic_key to the
4535 ## list here (as it used to be). It may have been handled by
4536 ## generated_filenames.
4537 foreach my $vc (keys %{$self->{'valid_components'}}) {
4538 ## The output of multiple components could be input for the
4539 ## current component type ($based). We need to avoid adding
4540 ## duplicates here.
4541 if (defined $self->{'combined_custom'}->{$based}) {
4542 foreach my $tag (@{$self->{'combined_custom'}->{$based}}) {
4543 my @cout = $self->check_custom_output($tag, $cinput, $ainput, $vc,
4544 $vcomps{$vc});
4545 StringProcessor::merge(\@outputs, \@cout);
4548 else {
4549 my @cout = $self->check_custom_output($based, $cinput, $ainput, $vc,
4550 $vcomps{$vc});
4551 StringProcessor::merge(\@outputs, \@cout);
4554 if (defined $self->{'combined_custom'}->{$based}) {
4555 foreach my $tag (@{$self->{'combined_custom'}->{$based}}) {
4556 my @cout = $self->check_custom_output($tag, $cinput, $ainput,
4557 $generic_key,
4558 $vcomps{$generic_key});
4559 StringProcessor::merge(\@outputs, \@cout);
4562 else {
4563 my @cout = $self->check_custom_output($based, $cinput, $ainput,
4564 $generic_key,
4565 $vcomps{$generic_key});
4566 StringProcessor::merge(\@outputs, \@cout);
4569 ## Add specially listed files avoiding duplicates. We don't want
4570 ## to add these files if gendir is set to something besides .
4571 if (defined $self->{'combined_custom'}->{$based}) {
4572 foreach my $tag (@{$self->{'combined_custom'}->{$based}}) {
4573 StringProcessor::merge(\@outputs,
4574 $self->get_custom_special_output($tag,
4575 $ainput));
4578 else {
4579 StringProcessor::merge(\@outputs,
4580 $self->get_custom_special_output($based,
4581 $ainput));
4584 if ($self->{'convert_slashes'}) {
4585 foreach my $output (@outputs) {
4586 $output =~ s/\//\\/g;
4589 if ($self->{'sort_files'}) {
4590 @outputs = sort { $self->file_sorter($a, $b) } @outputs;
4592 $self->{'custom_output_files'}->{$input} = \@outputs;
4595 elsif ($cmd eq 'output_files') {
4596 # Generate output files based on $based
4597 if (defined $self->{'custom_output_files'}) {
4598 $value = $self->{'custom_output_files'}->{$based};
4601 elsif ($cmd eq 'source_output_files') {
4602 # Generate source output files based on $based
4603 if (defined $self->{'custom_output_files'}) {
4604 $value = [];
4605 foreach my $file (@{$self->{'custom_output_files'}->{$based}}) {
4606 foreach my $ext (@{$self->{'valid_components'}->{'source_files'}}) {
4607 if ($file =~ /$ext$/) {
4608 ## We've found a file that matches one of the source file
4609 ## extensions. Now we have to make sure that it doesn't
4610 ## match a template file extension.
4611 my $matched = 0;
4612 foreach my $text (@{$self->{'valid_components'}->{'template_files'}}) {
4613 if ($file =~ /$text$/) {
4614 $matched = 1;
4615 last;
4618 push(@$value, $file) if (!$matched);
4619 last;
4625 elsif ($cmd eq 'non_source_output_files') {
4626 # Generate non source output files based on $based
4627 if (defined $self->{'custom_output_files'}) {
4628 $value = [];
4629 foreach my $file (@{$self->{'custom_output_files'}->{$based}}) {
4630 my $source = 0;
4631 foreach my $ext (@{$self->{'valid_components'}->{'source_files'}}) {
4632 if ($file =~ /$ext$/) {
4633 $source = 1;
4634 ## We've found a file that matches one of the source file
4635 ## extensions. Now we have to make sure that it doesn't
4636 ## match a template file extension.
4637 foreach my $text (@{$self->{'valid_components'}->{'template_files'}}) {
4638 if ($file =~ /$text$/) {
4639 $source = 0;
4640 last;
4643 last if ($source);
4646 push(@$value, $file) if (!$source);
4650 elsif ($cmd eq 'non_template_output_files') {
4651 # Generate non-template output files based on $based
4652 if (defined $self->{'custom_output_files'}) {
4653 $value = [];
4654 foreach my $file (@{$self->{'custom_output_files'}->{$based}}) {
4655 my $template = 0;
4656 foreach my $ext (@{$self->{'valid_components'}->{'template_files'}}) {
4657 if ($file =~ /$ext$/) {
4658 $template = 1;
4659 last;
4662 push(@$value, $file) if (!$template);
4666 elsif ($cmd eq 'inputexts') {
4667 my @array = @{$self->{'valid_components'}->{$based}};
4668 foreach my $val (@array) {
4669 $val =~ s/\\\.//g;
4671 $value = \@array;
4673 elsif ($cmd eq 'dependencies') {
4674 $value = $self->{'custom_dependency_files'}->{$based};
4676 elsif ($cmd eq 'commands') { # only used with 'combined_custom'
4677 $value = [];
4679 ## Clear out the previous custom_multi_details hash map so that we don't
4680 ## have extraneous data associated with commands from previous iterations.
4681 $self->{'custom_multi_details'} = {};
4683 my %details = ('flags' => 'commandflags',
4684 'outopt' => 'output_option',
4685 'gdir' => 'gendir');
4686 for my $tag (@{$self->{'custom_multi_cmd'}->{$based}}) {
4687 my $command = $self->get_custom_assign_or_override('command', $tag,
4688 $based, @params);
4690 ## Use $tag as the key for custom_multi_details and store the command as
4691 ## a data member that we can access later. $command shouldn't be used
4692 ## as the key because it is not guaranteed to be unique.
4693 my $det = $self->{'custom_multi_details'}->{$tag} = {'_cmd' => $command,
4694 'type' => $tag,
4695 'outfile' => ''};
4696 for my $k (keys %details) {
4697 $det->{$k} = $self->get_custom_assign_or_override($details{$k}, $tag,
4698 $based, @params);
4700 if ($det->{'outopt'} && $self->{'custom_output_files'}->{$based}) {
4701 # only 1 output file is supported with output_option
4702 $det->{'outfile'} = $self->get_first_custom_output($based, $tag);
4703 $det->{'outfile'} =~ s/\//\\/g if $self->{'convert_slashes'};
4704 if (defined $det->{'gdir'}) {
4705 my $basename = $det->{'outfile'};
4706 if ($self->{'convert_slashes'}) {
4707 $basename =~ s/.*[\/\\]//;
4709 else {
4710 $basename =~ s/.*\///;
4712 $det->{'outfile'} =
4713 $det->{'gdir'} . $self->{'command_subs'}->{'slash'} . $basename;
4718 ## Sort the list of types so that generated projects are reproducable.
4719 ## Additionally, we need them to be ordered (and numbered) so that we can
4720 ## match the command with the right tag when iterating in the template.
4721 my $det = $self->{'custom_multi_details'};
4722 my $i = 0;
4723 foreach my $key (sort { $a cmp $b } keys %$det) {
4724 $det->{$key}->{'_order'} = $i++;
4725 push(@$value, $det->{$key}->{'_cmd'});
4728 elsif (defined $customDefined{$cmd}) {
4729 $value = $self->get_assignment($cmd,
4730 $self->{'generated_exts'}->{$based});
4731 if (defined $value && ($customDefined{$cmd} & 0x14) != 0) {
4732 $value = $self->convert_command_parameters($based, $value, @params);
4735 else {
4736 ## This is only used with 'combined_custom'.
4738 ## $based - The command for the original define custom.
4739 ## $cmd - The member after the arrow operator.
4741 ## We cannot use a direct lookup because the command is no longer the
4742 ## key for custom_multi_details. It is possible to have two or more custom
4743 ## types that use the same command. Therefore, we have to use the custom
4744 ## type name ($tag) as the key. Since this code can only be called within
4745 ## a foreach, we have to rely on the fact that the values created above
4746 ## (during the processing of 'commands') are sorted to correlate the
4747 ## command, stored in $base, with the correct tag in order to get the
4748 ## correct command flags and other associated values.
4749 foreach my $tag (keys %{$self->{'custom_multi_details'}}) {
4750 my $det = $self->{'custom_multi_details'}->{$tag};
4751 if ($det->{'_cmd'} eq $based && $det->{'_order'} == $self->{'forcount'}) {
4752 if (exists $det->{$cmd}) {
4753 $value = $det->{$cmd};
4755 last;
4760 return $value;
4764 sub check_features {
4765 my($self, $requires, $avoids, $info) = @_;
4766 my $status = 1;
4767 my $why;
4769 if (defined $requires) {
4770 foreach my $require (split(/\s+/, $requires)) {
4771 my $fval = $self->{'feature_parser'}->get_value($require);
4773 ## By default, if the feature is not listed, then it is enabled.
4774 if (defined $fval && !$fval) {
4775 $why = "requires $require";
4776 $status = 0;
4777 last;
4780 ## For automakes sake, if we're to this point the feature is
4781 ## enabled and we will set it in the feature parser explicitly
4782 if (!defined $fval) {
4783 $self->{'feature_parser'}->parse_line(undef, "$require = 1");
4788 ## If it passes the requires, then check the avoids
4789 if ($status) {
4790 if (defined $avoids) {
4791 foreach my $avoid (split(/\s+/, $avoids)) {
4792 my $fval = $self->{'feature_parser'}->get_value($avoid);
4794 ## By default, if the feature is not listed, then it is enabled.
4795 if (!defined $fval || $fval) {
4796 $why = "avoids $avoid";
4797 $status = 0;
4798 last;
4804 if ($info && !$status) {
4805 $self->details("Skipping " . $self->get_assignment('project_name') .
4806 " ($self->{'current_input'}); it $why.");
4809 return $status;
4813 sub need_to_write_project {
4814 my $self = shift;
4815 my $count = 0;
4817 ## We always write a project if the user has provided a verbatim.
4818 ## We have no idea what that verbatim clause does, so we need to just
4819 ## do what the user tells us to do.
4820 return 1 if (defined $self->{'verbatim'}->{$self->{'pctype'}});
4822 ## The order here is important, we must check for source or resource
4823 ## files first and then for custom input files.
4824 foreach my $key ('source_files', $self->get_resource_tag(),
4825 keys %{$self->{'generated_exts'}}) {
4826 ## For implicitly-discovered projects, just having a resource file without
4827 ## source or generated file is not enough to write a project.
4828 next if $self->{'current_input'} eq '' && $key eq $self->get_resource_tag();
4829 my $names = $self->{$key};
4830 foreach my $name (keys %$names) {
4831 foreach my $key (keys %{$names->{$name}}) {
4832 ## See if the project contains a file that corresponds to this
4833 ## component name.
4834 if (defined $names->{$name}->{$key}->[0]) {
4835 if ($count >= 2) {
4836 ## Return 2 if we have found a custom input file (and thus no
4837 ## source or resource files due to the foreach order).
4838 return 2;
4840 ## We have either source files or resource files, we need to
4841 ## see if this project creator supports the current language.
4842 ## If it doesn't then we don't need to create the project.
4843 elsif ($self->languageSupported()) {
4844 ## Return 1 if we have found a source file or a resource file.
4845 return 1;
4850 $count++;
4853 ## Indicate that there is no need to write the project
4854 return 0;
4858 sub write_output_file {
4859 my($self, $webapp) = @_;
4860 my $status = 0;
4861 my $error;
4862 my $tover = $self->get_template_override();
4863 my @templates = $self->get_template();
4865 ## The template override will override all templates
4866 @templates = ($tover) if (defined $tover);
4868 foreach my $template (@templates) {
4869 ## Save the template name for use as a key for various function calls
4870 $self->{'current_template'} = $template;
4872 ## Create the output file name based on the project name and the
4873 ## template that we're currently using.
4874 my $name = $self->transform_file_name(
4875 $self->project_file_name(undef,
4876 $self->{'current_template'}));
4878 ## If the template files does not end in the template extension
4879 ## then we will add it on.
4880 if ($template !~ /$TemplateExtension$/) {
4881 $template .= '.' . $TemplateExtension;
4884 ## If the template file does not contain a path, then we
4885 ## will search through the include paths for it.
4886 my $tfile;
4887 if ($template =~ /[\/\\]/i) {
4888 $tfile = $template;
4890 else {
4891 $tfile = $self->search_include_path($template);
4894 if (defined $tfile) {
4895 ## Read in the template values for the specific target and project
4896 ## type. The template input file we get may depend upon the
4897 ## current template that we're using.
4898 ($status, $error) = $self->read_template_input(
4899 $self->{'current_template'});
4900 last if (!$status);
4902 my $tp = new TemplateParser($self);
4904 ## Set the project_file assignment for the template parser
4905 $self->process_assignment('project_file', $name);
4907 ($status, $error) = $tp->parse_file($tfile);
4908 last if (!$status);
4910 if (defined $self->{'source_callback'} &&
4911 $self->file_visible($self->{'current_template'})) {
4912 my $cb = $self->{'source_callback'};
4913 my $pjname = $self->get_assignment('project_name');
4914 my @list = $self->get_component_list('source_files');
4915 if (UNIVERSAL::isa($cb, 'ARRAY')) {
4916 my @copy = @$cb;
4917 my $s = shift(@copy);
4918 &$s(@copy, $name, $pjname, \@list);
4920 elsif (UNIVERSAL::isa($cb, 'CODE')) {
4921 &$cb($name, $pjname, \@list);
4923 else {
4924 $self->warning("Ignoring callback: $cb.");
4928 if ($self->get_toplevel()) {
4929 my $outdir = $self->get_outdir();
4930 my $oname = $name;
4932 $name = "$outdir/$name";
4934 my $fh = new FileHandle();
4935 my $dir = $self->mpc_dirname($name);
4937 mkpath($dir, 0, 0777) if ($dir ne '.');
4939 if ($webapp) {
4940 ## At this point in time, webapps do not get a project file,
4941 ## but they do appear in the workspace
4943 elsif ($self->compare_output()) {
4944 ## First write the output to a temporary file
4945 my $tmp = "$outdir/MPC$>.$$";
4946 my $different = 1;
4947 if (open($fh, ">$tmp")) {
4948 my $lines = $tp->get_lines();
4949 foreach my $line (@$lines) {
4950 print $fh $line;
4952 close($fh);
4954 $different = 0 if (!$self->files_are_different($name, $tmp));
4956 else {
4957 $error = "Unable to open $tmp for output: $!";
4958 $status = 0;
4959 last;
4962 ## If they are different, then rename the temporary file
4963 if ($different) {
4964 unlink($name);
4965 if (rename($tmp, $name)) {
4966 $error = $self->post_file_creation($name);
4967 if (defined $error) {
4968 $status = 0;
4969 last;
4972 else {
4973 $error = "Unable to open $name for output: $!";
4974 $status = 0;
4975 last;
4978 else {
4979 ## We will pretend that we wrote the file
4980 unlink($tmp);
4983 else {
4984 if (open($fh, ">$name")) {
4985 my $lines = $tp->get_lines();
4986 foreach my $line (@$lines) {
4987 print $fh $line;
4989 close($fh);
4990 $error = $self->post_file_creation($name);
4991 if (defined $error) {
4992 $status = 0;
4993 last;
4996 else {
4997 $error = "Unable to open $name for output: $!";
4998 $status = 0;
4999 last;
5003 ## There may be more than one template associated with this
5004 ## project creator. If there is, we can only add one generated
5005 ## file and we rely on the project creator to tell us which
5006 ## template generates the file that we need to track.
5007 $self->add_file_written($oname)
5008 if ($self->file_visible($self->{'current_template'}));
5011 else {
5012 $error = "Unable to locate the template file: $template.";
5013 $status = 0;
5014 last;
5017 return $status, $error;
5021 sub write_install_file {
5022 my $self = shift;
5023 my $fh = new FileHandle();
5024 my $insfile = $self->transform_file_name(
5025 $self->get_assignment('project_name')) .
5026 '.ins';
5027 my $outdir = $self->get_outdir();
5029 $insfile = "$outdir/$insfile";
5031 unlink($insfile);
5032 if (open($fh, ">$insfile")) {
5033 $self->get_install_info(sub {print $fh $_[0]});
5034 close $fh;
5035 return 1, undef;
5037 return 0, 'Unable write to ' . $insfile;
5041 sub get_install_info {
5042 my $self = shift;
5043 my $callback = shift;
5044 foreach my $vc (keys %{$self->{'valid_components'}}) {
5045 my $names = $self->{$vc};
5046 foreach my $name (keys %$names) {
5047 foreach my $key (keys %{$$names{$name}}) {
5048 my $array = $$names{$name}->{$key};
5049 if (defined $$array[0]) {
5050 &$callback("$vc:\n");
5051 foreach my $file (@$array) {
5052 if (defined $self->{'flag_overrides'}->{$vc} &&
5053 defined $self->{'flag_overrides'}->{$vc}->{$file} &&
5054 defined $self->{'flag_overrides'}->{$vc}->{$file}->{'gendir'}) {
5055 &$callback(join(' ', map {/ / ? "\"$_\"" : $_} ($file,
5056 $self->{'flag_overrides'}->{$vc}->{$file}->{'gendir'})) . "\n");
5058 else {
5059 &$callback("$file\n");
5062 &$callback("\n");
5067 if ($self->exe_target()) {
5068 my $exeout = $self->get_assignment('exeout');
5069 &$callback("exe_output:\n");
5070 &$callback((defined $exeout ? $self->relative($exeout) : '') .
5071 ' ' . $self->get_assignment('exename') . "\n");
5073 elsif ($self->lib_target()) {
5074 my $shared = $self->get_assignment('sharedname');
5075 my $static = $self->get_assignment('staticname');
5076 my $dllout = $self->relative($self->get_assignment('dllout'));
5077 my $libout = $self->relative($self->get_assignment('libout'));
5079 &$callback("lib_output:\n");
5081 if (defined $shared && $shared ne '') {
5082 &$callback((defined $dllout ? $dllout : $libout) . " $shared\n");
5084 if ((defined $static && $static ne '') &&
5085 (defined $dllout || !defined $shared ||
5086 (defined $shared && $shared ne $static))) {
5087 &$callback("$libout $static\n");
5093 sub write_project {
5094 my $self = shift;
5095 my $status = 2;
5096 my $error;
5097 my $progress = $self->get_progress_callback();
5099 &$progress() if (defined $progress);
5101 if ($self->check_features($self->get_assignment('requires'),
5102 $self->get_assignment('avoids'),
5103 1)) {
5104 my $webapp = $self->get_assignment('webapp');
5105 my $ntwp = $self->need_to_write_project();
5106 if ($webapp || $ntwp) {
5107 if ($webapp && !$self->webapp_supported()) {
5108 $self->warning("Web Applications are not supported by this type.");
5110 else {
5111 ## A return value of 2 from need_to_write_project() indicates
5112 ## that the only reason that we need to write the project is that
5113 ## there are custom input files (i.e., no source or resource
5114 ## files).
5115 $self->process_assignment('custom_only', '1') if ($ntwp == 2);
5117 if ($self->get_assignment('custom_only')) {
5118 $self->remove_non_custom_settings();
5121 if ($self->{'escape_spaces'}) {
5122 foreach my $name ('exename', 'sharedname', 'staticname',
5123 'exeout', 'dllout', 'libout') {
5124 my $value = $self->get_assignment($name);
5125 if (defined $value && $value =~ s/(\s)/\\$1/g) {
5126 $self->process_assignment($name, $value);
5129 foreach my $key (keys %{$self->{'valid_components'}}) {
5130 my $names = $self->{$key};
5131 foreach my $name (keys %$names) {
5132 foreach my $key (keys %{$$names{$name}}) {
5133 foreach my $file (@{$$names{$name}->{$key}}) {
5134 $file =~ s/(\s)/\\$1/g;
5141 ## Hook for implementing type-specific behavior.
5142 ($status, $error) = $self->pre_write_output_file($webapp);
5143 if (!$status) {
5144 return $status, $error;
5146 ## We don't need to pass a file name here. write_output_file()
5147 ## will determine the file name for itself.
5148 ($status, $error) = $self->write_output_file($webapp);
5150 ## Write the .ins file if the user requested it and we were
5151 ## successful.
5152 if ($self->{'generate_ins'} && $status) {
5153 ($status, $error) = $self->write_install_file();
5157 elsif ($self->warn_useless_project()) {
5158 my $msg = $self->transform_file_name($self->project_file_name()) .
5159 " has no useful targets.";
5161 if ($self->{'current_input'} eq '') {
5162 $self->information($msg);
5164 else {
5165 $self->warning($msg);
5170 return $status, $error;
5174 sub get_project_info {
5175 return $_[0]->{'project_info'};
5179 sub get_lib_locations {
5180 if ($_[0]->{'pid'} eq 'child') {
5181 my $lib_locs;
5182 for my $k (sort { substr($a, 0 , index ($a, '|')) <=>
5183 substr ($b, 0, index ($b, '|')) } keys %{$_[0]->{'lib_locations'}}) {
5185 # if we are a worker, we need to strip leading 'number|'
5186 my $x = $_[0]->{'lib_locations'}->{$k};
5187 $x =~ s/\d+\|//;
5189 $lib_locs->{substr ($k, index ($k, '|') + 1)} = $x;
5191 return $lib_locs
5193 else {
5194 return $_[0]->{'lib_locations'};
5199 sub get_inheritance_tree {
5200 return $_[0]->{'inheritance_tree'};
5204 sub set_component_extensions {
5205 my $self = shift;
5206 my $vc = $self->{'valid_components'};
5207 my $ec = $self->{'exclude_components'};
5209 foreach my $key (keys %$vc) {
5210 my $ov = $self->override_valid_component_extensions($key,
5211 @{$$vc{$key}});
5212 $$vc{$key} = $ov if (defined $ov);
5215 foreach my $key (keys %$ec) {
5216 my $ov = $self->override_exclude_component_extensions($key,
5217 @{$$ec{$key}});
5218 $$ec{$key} = $ov if (defined $ov);
5223 sub get_component_extensions {
5224 my($self, $comp) = @_;
5225 my @ext;
5226 if (defined $self->{'valid_components'}->{$comp}) {
5227 ## Build up an array of extensions. Since they are stored as regular
5228 ## expressions, we need to remove the escaped period to provide the
5229 ## minimal amount of text for each extension to provide maximum
5230 ## flexibility within the project template.
5231 foreach my $re (@{$self->{'valid_components'}->{$comp}}) {
5232 push(@ext, $re);
5233 $ext[$#ext] =~ s/\\\.//;
5236 return @ext;
5240 sub set_source_listing_callback {
5241 my($self, $cb) = @_;
5242 $self->{'source_callback'} = $cb;
5246 sub reset_values {
5247 my $self = shift;
5249 ## Only put data structures that need to be cleared
5250 ## out when the mpc file is done being read, not at the
5251 ## end of each project within the mpc file. Those go in
5252 ## the closing curly brace section of parse_line().
5253 $self->{'project_info'} = [];
5254 $self->{'lib_locations'} = {};
5255 $self->reset_generating_types();
5259 sub add_default_matching_assignments {
5260 my $self = shift;
5261 my $lang = $self->get_language();
5263 foreach my $key (keys %{$language{$lang}->[0]}) {
5264 push(@{$language{$lang}->[2]->{$key}}, @default_matching_assignments)
5265 if (!StringProcessor::fgrep($default_matching_assignments[0],
5266 $language{$lang}->[2]->{$key}));
5271 sub reset_generating_types {
5272 my $self = shift;
5273 my $lang = $self->get_language();
5274 my %reset = ('valid_components' => $language{$lang}->[0],
5275 'custom_only_removed' => $language{$lang}->[0],
5276 'exclude_components' => $language{$lang}->[1],
5277 'matching_assignments' => $language{$lang}->[2],
5278 'generated_exts' => {},
5279 'combined_custom' => {},
5280 'valid_names' => \%validNames,
5283 foreach my $r (keys %reset) {
5284 $self->{$r} = {};
5285 foreach my $key (keys %{$reset{$r}}) {
5286 $self->{$r}->{$key} = $reset{$r}->{$key};
5290 $self->{'custom_types'} = {};
5291 $self->{'define_custom_parent'} = {};
5293 ## Allow subclasses to override the default extensions
5294 $self->set_component_extensions();
5298 sub get_template_input {
5299 my $self = shift;
5300 my $lang = $self->get_language();
5302 ## This follows along the same logic as read_template_input() by
5303 ## checking for exe target and then defaulting to a lib target
5304 if ($self->exe_target()) {
5305 if ($self->get_static() == 1) {
5306 return $self->{'lib_exe_template_input'}->{$lang}->{$tikey};
5308 else {
5309 return $self->{'dll_exe_template_input'}->{$lang}->{$tikey};
5313 if ($self->get_static() == 1) {
5314 return $self->{'lib_template_input'}->{$lang}->{$tikey};
5317 return $self->{'dll_template_input'}->{$lang}->{$tikey};
5321 sub update_project_info {
5322 my($self, $tparser, $append, $names, $sep) = @_;
5323 my $value = '';
5324 $sep = '' if (!defined $sep);
5326 ## Append the values of all names into one string
5327 my $ncount = scalar(@$names) - 1;
5328 for(my $i = 0; $i <= $ncount; $i++) {
5329 $value .= $self->translate_value(
5330 $$names[$i],
5331 $tparser->get_value_with_default($$names[$i]));
5332 $value .= $sep if ($i != $ncount);
5335 ## There may be more than one template associated with this project
5336 ## creator. If there is, we can only add one generated file and we
5337 ## rely on the project creator to tell us which template generates the
5338 ## file that we need to track.
5339 if ($self->file_visible($self->{'current_template'})) {
5340 ## If we already have an array, take the one off the top. Otherwise,
5341 ## create a new one which will be added below.
5342 my $arr = ($append && defined $self->{'project_info'}->[0] ?
5343 pop(@{$self->{'project_info'}}) : []);
5345 ## Set up the hash table when we are starting a new project_info
5346 $self->{'project_info_hash_table'} = {} if (!$append);
5348 ## If we haven't seen this value yet, put it on the array
5349 if (!defined $self->{'project_info_hash_table'}->{"@$names $value"}) {
5350 $self->{'project_info_hash_table'}->{"@$names $value"} = 1;
5351 push(@$arr, $value);
5354 ## Always push the array back onto the project_info
5355 push(@{$self->{'project_info'}}, $arr);
5358 return $value;
5362 sub access_pi_values {
5363 my $self = shift;
5364 my $pjs = shift;
5365 my $proj = shift;
5367 ## This will use the keys left in @_ as indices into the project
5368 ## info array. But, if the user wants configurations, we need to
5369 ## pop that key off and access it along with all the rest of the
5370 ## elements in the array. The CONFIGURATIONS key should always
5371 ## be last if it's included at all. If it's not, the caller will
5372 ## only receive the first configuration instead of all of them.
5373 if ($_[$#_] == CONFIGURATIONS) {
5374 my $last = scalar(@{$$pjs{$proj}}) - 1;
5375 pop(@_);
5376 return @{$$pjs{$proj}}[@_], @{$$pjs{$proj}}[CONFIGURATIONS..$last];
5379 return @{$$pjs{$proj}}[@_];
5383 sub adjust_value {
5384 my($self, $names, $value, $tp) = @_;
5385 my $atemp = $self->get_addtemp();
5387 ## Perform any additions, subtractions
5388 ## or overrides for the template values.
5389 foreach my $name (@$names) {
5390 if (defined $name && defined $atemp->{lc($name)}) {
5391 my $lname = lc($name);
5392 my $base = $lname;
5393 $base =~ s/.*:://;
5395 ## If the template variable is a complex name, then we need to make
5396 ## sure that the mapped value belongs to the correct type based on
5397 ## the base of the complex name. The $tp (TemplateParser) variable
5398 ## will, in the majority of all calls to this method, be defined so
5399 ## it is checked second to avoid checking it if the name isn't
5400 ## complex.
5401 if ($base =~ /(.+)\->/ && defined $tp) {
5402 my $v = $tp->get_value($1);
5403 if (defined $v) {
5404 my $found = undef;
5405 foreach my $val (@{$atemp->{$lname}}) {
5406 if (defined $$val[3]) {
5407 my $mapped = $self->{'valid_names'}->{$$val[3]};
5408 if (defined $mapped && UNIVERSAL::isa($mapped, 'ARRAY')) {
5409 $found = 1 if ($v ne $$mapped[0]);
5411 last;
5414 next if ($found);
5418 my $replace = (defined $self->{'valid_names'}->{$base} &&
5419 ($self->{'valid_names'}->{$base} & 0x04) == 0);
5420 foreach my $val (@{$atemp->{$lname}}) {
5421 if ($replace && index($$val[1], '<%') >= 0) {
5422 $$val[1] = $self->replace_parameters($$val[1],
5423 $self->{'command_subs'});
5425 my $arr = $self->create_array($$val[1]);
5426 if ($$val[0] > 0) {
5427 if (!defined $value) {
5428 $value = '';
5430 if (UNIVERSAL::isa($value, 'ARRAY')) {
5431 ## Avoid adding duplicates. If the existing array contains
5432 ## the value already, remove it from the newly created array.
5433 for(my $i = 0; $i < scalar(@$value); $i++) {
5434 if (StringProcessor::fgrep($$value[$i], $arr)) {
5435 splice(@$value, $i, 1);
5436 $i--;
5440 ## We need to make $value a new array reference ($arr)
5441 ## to avoid modifying the array reference pointed to by $value
5442 unshift(@$arr, @$value);
5443 $value = $arr;
5445 else {
5446 $value .= " $$val[1]";
5449 elsif ($$val[0] < 0) {
5450 if (defined $value) {
5451 my $parts;
5452 if (UNIVERSAL::isa($value, 'ARRAY')) {
5453 $parts = $value;
5455 else {
5456 $parts = $self->create_array($value);
5459 $value = [];
5460 foreach my $part (@$parts) {
5461 if ($part ne '') {
5462 push(@$value, $part) if (!StringProcessor::fgrep($part, $arr));
5467 else {
5468 ## If the user set the variable to empty, then we need to
5469 ## set the value to undef
5470 $value = (defined $$arr[0] ? $arr : undef);
5473 last;
5477 return $value;
5481 sub get_verbatim {
5482 my($self, $marker) = @_;
5483 my $str;
5484 my $thash = $self->{'verbatim'}->{$self->{'pctype'}};
5486 if (defined $thash) {
5487 if (defined $thash->{$marker}) {
5488 my $crlf = $self->crlf();
5489 foreach my $line (@{$thash->{$marker}}) {
5490 $str = '' if (!defined $str);
5491 $str .= $self->process_special($line) . $crlf;
5493 if (defined $str) {
5494 $str .= $crlf;
5495 $self->{'verbatim_accessed'}->{$self->{'pctype'}}->{$marker} = 1;
5500 return $str;
5504 sub generate_recursive_input_list {
5505 my($self, $dir, $exclude) = @_;
5506 return $self->extension_recursive_input_list($dir,
5507 $exclude,
5508 $ProjectCreatorExtension);
5512 sub get_modified_project_file_name {
5513 my($self, $name, $ext) = @_;
5514 my $nmod = $self->get_name_modifier();
5516 ## We don't apply the name modifier to the project file
5517 ## name if we have already applied it to the project name
5518 ## since the project file name comes from the project name.
5519 if (defined $nmod && !$self->get_apply_project()) {
5520 $nmod =~ s/\*/$name/g;
5521 $name = $nmod;
5523 return "$name$ext";
5527 sub get_valid_names {
5528 return $_[0]->{'valid_names'};
5532 sub get_feature_parser {
5533 return $_[0]->{'feature_parser'};
5537 sub preserve_assignment_order {
5538 my($self, $name) = @_;
5539 my $mapped = $self->{'valid_names'}->{$name};
5541 ## Only return the value stored in the valid_names hash map if it's
5542 ## defined and it's not an array reference. The array reference is
5543 ## a keyword mapping and all mapped keywords should have preserved
5544 ## assignment order.
5545 if (defined $mapped && !UNIVERSAL::isa($mapped, 'ARRAY')) {
5546 return ($mapped & 1);
5549 return 1;
5553 sub add_to_template_input_value {
5554 my($self, $name) = @_;
5555 my $mapped = $self->{'valid_names'}->{$name};
5557 ## Only return the value stored in the valid_names hash map if it's
5558 ## defined and it's not an array reference. The array reference is
5559 ## a keyword mapping and no mapped keywords should be added to
5560 ## template input variables.
5561 if (defined $mapped && !UNIVERSAL::isa($mapped, 'ARRAY')) {
5562 return ($mapped & 2);
5565 return 0;
5569 sub dependency_combined_static_library {
5570 #my $self = shift;
5571 return defined $ENV{MPC_DEPENDENCY_COMBINED_STATIC_LIBRARY};
5575 sub translate_value {
5576 my($self, $key, $val) = @_;
5578 if ($key eq 'after' && $val ne '') {
5579 my $arr = $self->create_array($val);
5580 $val = '';
5582 if ($self->require_dependencies()) {
5583 foreach my $entry (@$arr) {
5584 if ($self->get_apply_project()) {
5585 my $nmod = $self->get_name_modifier();
5586 if (defined $nmod) {
5587 $nmod =~ s/\*/$entry/g;
5588 $entry = $nmod;
5591 $val .= '"' . ($self->dependency_is_filename() ?
5592 $self->project_file_name($entry) : $entry) . '" ';
5594 $val =~ s/\s+$//;
5597 return $val;
5601 sub requires_parameters {
5602 #my $self = shift;
5603 #my $name = shift;
5604 return $custom{$_[1]};
5608 sub project_file_name {
5609 my($self, $name, $template) = @_;
5611 ## Fill in the name if one wasn't provided
5612 $name = $self->get_assignment('project_name') if (!defined $name);
5614 ## Apply the transformation so that any name modifiers are utilized.
5615 return $self->get_modified_project_file_name(
5616 $self->project_file_prefix() .
5617 $self->transform_file_name($name),
5618 $self->project_file_extension());
5622 sub remove_non_custom_settings {
5623 my $self = shift;
5625 ## Remove any files that may have automatically been added
5626 ## to this project. If they were explicitly added, then we
5627 ## will leave them in the project.
5628 foreach my $key (keys %{$self->{'custom_only_removed'}}) {
5629 if ($self->{'defaulted'}->{$key}) {
5630 $self->{$key} = {};
5634 ## Unset the exename, sharedname and staticname
5635 $self->process_assignment('exename', undef);
5636 $self->process_assignment('sharedname', undef);
5637 $self->process_assignment('staticname', undef);
5641 sub remove_wanted_extension {
5642 my($self, $name, $array) = @_;
5644 foreach my $wanted (@$array) {
5645 return $name if ($name =~ s/$wanted$//);
5648 ## If the user provided file does not match any of the
5649 ## extensions specified by the custom definition, we need
5650 ## to remove the extension or else this file will not be
5651 ## added to the project.
5652 $name =~ s/\.[^\.]+$//;
5653 return $name;
5657 sub resolve_alias {
5658 if (index($_[1], 'install') >= 0) {
5659 my $resolved = $_[1];
5660 if ($resolved =~ s/(.*::)install$/$1exeout/) {
5662 elsif ($resolved eq 'install') {
5663 $resolved = 'exeout';
5665 return $resolved;
5667 return $_[1];
5671 sub create_feature_parser {
5672 my($self, $features, $feature) = @_;
5673 my $gfeature = $self->{'gfeature_file'};
5674 my $typefeaturef = (defined $gfeature ?
5675 $self->mpc_dirname($gfeature) . '/' : '') .
5676 $self->{'pctype'} . '.features';
5677 $typefeaturef = undef if (! -r $typefeaturef);
5678 if (defined $feature && $feature !~ /[\/\\]/i) {
5679 my $searched = $self->search_include_path($feature);
5680 $feature = $searched if (defined $searched);
5682 my $fp = new FeatureParser($features,
5683 $gfeature,
5684 $typefeaturef,
5685 $feature);
5687 my $slo = $fp->get_value($static_libs_feature);
5688 if (!defined $slo) {
5689 my $sval = $self->get_static() || 0;
5690 $fp->parse_line(undef,
5691 $static_libs_feature . ' = ' . $sval);
5694 return $fp;
5698 sub restore_state_helper {
5699 my($self, $skey, $old, $new) = @_;
5701 if ($skey eq 'feature_file') {
5702 if ($self->{'features_changed'} ||
5703 !(!defined $old && !defined $new ||
5704 (defined $old && defined $new && $old eq $new))) {
5705 ## Create a new feature parser. This relies on the fact that
5706 ## 'features' is restored first in restore_state().
5707 $self->{'feature_parser'} = $self->create_feature_parser(
5708 $self->get_features(), $new);
5709 $self->{'features_changed'} = undef;
5712 elsif ($skey eq 'ti') {
5713 my $lang = $self->get_language();
5714 my @keys = keys %$old;
5715 @keys = keys %$new if (!defined $keys[0]);
5716 foreach my $key (@keys) {
5717 if (!defined $$old{$key} || !defined $$new{$key} ||
5718 $$old{$key} ne $$new{$key}) {
5719 ## Clear out the template input reader that we're currently set
5720 ## to use.
5721 $self->{$key . '_template_input'}->{$lang}->{$tikey} = undef;
5725 elsif ($skey eq 'features') {
5726 ## If the user has changed the 'features' setting, then we need to
5727 ## make sure that we create a new feature parser regardless of
5728 ## whether or not the feature file has changed.
5729 $self->{'features_changed'} = ("@$old" ne "@$new");
5731 elsif ($skey eq 'language') {
5732 if ($old ne $new) {
5733 $self->add_default_matching_assignments();
5739 sub get_initial_relative_values {
5740 return $_[0]->{'expanded'}, 1;
5743 sub add_main_function {
5744 my $langmain = shift;
5746 ## See if a language was supplied.
5747 if ($langmain =~ /([^:]+):(.+)/) {
5748 ## If the language supplied is not one that we know about, return an
5749 ## error message.
5750 return 'Invalid language: ' . $1 if (!defined $language{$1});
5752 ## Otherwise, add it to the list for the language.
5753 push(@{$mains{$1}}, $2);
5755 else {
5756 ## No language was supplied, so add the main to all of the languages
5757 ## that we support.
5758 foreach my $lang (keys %language) {
5759 push(@{$mains{$lang}}, $langmain);
5763 ## Return no error message.
5764 return undef;
5767 sub get_resource_tag {
5768 my $self = shift;
5769 my $lang = $self->get_language();
5771 ## Not all entries in the %language map have a resource tag.
5772 ## For this, we will just return the tag for C++ since it probably
5773 ## doesn't really matter anyway.
5774 return defined $language{$lang}->[5] ? $language{$lang}->[5] : $cppresource;
5777 sub find_command_helper {
5778 my($self, $tag) = @_;
5780 ## No tag results in no command helper
5781 return undef if (!defined $tag);
5783 ## See if we have a command helper for this tag
5784 my $ch = CommandHelper::get($tag);
5785 if (defined $ch) {
5786 ## Give the command helper a reference to the creator. The helper
5787 ## can benefit from many of the infrastructure functions available.
5788 $ch->set_creator($self);
5789 return $ch;
5792 ## None for the base define custom, try again with the parent
5793 return $self->find_command_helper($self->{'define_custom_parent'}->{$tag});
5796 sub get_dependency_attribute {
5797 ## Return the dependency attribute specified as the first parameter to
5798 ## this method (not counting the ProjectCreator object).
5799 return $_[0]->{'dependency_attributes'}->{$_[1]};
5802 sub valid_project_name {
5803 #my($self, $name) = @_;
5804 return $_[1] !~ /[\/\\=\?:&"<>|#%]/;
5808 sub append_flag_override {
5809 ## Append $value to the flag_overrides for <$tag, $input, $key>
5810 my $self = shift;
5811 my $tag = shift;
5812 my $key = shift;
5813 my $input = shift;
5814 my $value = shift;
5815 return if !defined $value || $value eq '';
5816 my %join = ('postcommand' => ' ' . $self->{'command_subs'}->{'and'} . ' ');
5817 my $sep = ($join{$key}) ? $join{$key} : ' ';
5818 my $fo = $self->{'flag_overrides'}->{$tag};
5819 $fo->{$input}->{$key} .= ($fo->{$input}->{$key} ? $sep : '') . $value;
5823 # Some project types can't represent the same input file being used by
5824 # more than one custom type. This function will look for such cases and
5825 # combine them into a single invocation of a synthetic custom type that
5826 # inherits properties from both of them.
5827 # Project types needing this transformation should call this function from
5828 # their overridden pre_write_output_file() method.
5829 sub combine_custom_types {
5830 my $self = shift;
5831 my %input; # (input_file_name => [custom1_files, custom2_files], ...)
5832 my $fo = $self->{'flag_overrides'};
5833 my %gendir; # (input_file_name => {directory => count}, ...)
5835 # Build the %input data structure as an index of how each input file is used.
5836 foreach my $tag (keys %{$self->{'generated_exts'}}) {
5837 foreach my $complist (values %{$self->{$tag}}) {
5838 foreach my $group (keys %$complist) {
5839 foreach my $in (@{$complist->{$group}}) {
5840 # only add to %input if some command would be run for this type
5841 my $ustyle = $in;
5842 $ustyle =~ s/\\/\//g if $self->{'convert_slashes'};
5843 my $dir = $self->mpc_dirname($ustyle);
5844 my $of = (!defined $fo->{$tag} ? undef :
5845 (defined $fo->{$tag}->{$ustyle} ? $ustyle :
5846 (defined $fo->{$tag}->{$dir} ? $dir : undef)));
5847 if ($self->{'generated_exts'}->{$tag}->{'command'} ||
5848 (defined $of && $fo->{$tag}->{$of}->{'command'})) {
5849 push(@{$input{$in}}, $tag);
5850 if (defined $fo->{$tag}->{$of}->{'gendir'}) {
5851 $gendir{$in}->{$fo->{$tag}->{$of}->{'gendir'}}++;
5859 # For each input file used in multiple custom types, move it into the new
5860 # synthetic type.
5861 foreach my $in (keys %input) {
5862 next if scalar @{$input{$in}} < 2;
5863 my $combo_tag = join('_and_', map {/(.+)_files$/; $1} sort(@{$input{$in}}))
5864 . '_files';
5865 if (!$self->{'combined_custom'}->{$combo_tag}) {
5866 $self->{'combined_custom'}->{$combo_tag} = $input{$in};
5867 $self->process_assignment_add('custom_types', $combo_tag);
5868 my $ge = $self->{'generated_exts'}->{$combo_tag} = {};
5870 my $combo_vc = $self->{'valid_components'}->{$combo_tag} = [];
5871 foreach my $tag (@{$input{$in}}) {
5872 StringProcessor::merge($combo_vc, $self->{'valid_components'}->{$tag});
5873 if ($self->{'generated_exts'}->{$tag}->{'libpath'}) {
5874 $ge->{'libpath'} .= ($ge->{'libpath'} ?
5875 $self->{'command_subs'}->{'pathsep'} : '') .
5876 $self->{'generated_exts'}->{$tag}->{'libpath'};
5879 $fo->{$combo_tag} = {};
5880 my @keys = keys %custom;
5881 push(@keys, @default_matching_assignments);
5882 $self->{'matching_assignments'}->{$combo_tag} = \@keys;
5885 my @gendir_keys = keys %{$gendir{$in}};
5886 if ($#gendir_keys == 0) {
5887 $fo->{$combo_tag}->{$in}->{'gendir'} = $gendir_keys[0];
5890 # Add to new type -- groups aren't relevant here, so just use the default
5891 push(@{$self->{$combo_tag}->{'default'}->{'default_group'}}, $in);
5893 # Remove from existing types
5894 my $override_recurse = 0;
5895 foreach my $tag (@{$input{$in}}) {
5896 foreach my $complist (values %{$self->{$tag}}) {
5897 foreach my $group (keys %$complist) {
5898 foreach my $idx (0 .. $#{$complist->{$group}}) {
5899 if ($complist->{$group}->[$idx] eq $in) {
5900 splice(@{$complist->{$group}}, $idx, 1);
5905 if (defined $fo->{$tag} && defined $fo->{$tag}->{$in} &&
5906 defined $fo->{$tag}->{$in} && $fo->{$tag}->{$in}->{'recurse'}) {
5907 ++$override_recurse;
5909 foreach my $k ('dependent', 'dependent_libs', 'postcommand') {
5910 $self->append_flag_override($combo_tag, $k, $in,
5911 (defined $fo && defined $fo->{$k})
5912 ? $fo->{$k}
5913 : $self->{'generated_exts'}->{$tag}->{$k});
5917 # If all existing uses agree to recurse, the new type should recurse too
5918 if ($override_recurse == scalar @{$input{$in}}) {
5919 $fo->{$combo_tag}->{$in}->{'recurse'} = 1;
5924 return 1;
5927 sub set_forcount {
5928 my($self, $count) = @_;
5929 $self->{'forcount'} = $count;
5932 # ************************************************************
5933 # Accessors used by support scripts
5934 # ************************************************************
5936 sub getKeywords {
5937 return \%validNames;
5940 sub getValidComponents {
5941 my $language = shift;
5942 return (defined $language{$language} ? $language{$language}->[0] : undef);
5945 # ************************************************************
5946 # Virtual Methods To Be Overridden
5947 # ************************************************************
5949 sub get_builtin_output {
5950 #my($self, $input) = @_;
5951 return [];
5954 sub languageSupported {
5955 #my $self = shift;
5956 return $_[0]->get_language() eq Creator::cplusplus;
5959 sub file_visible {
5960 #my($self, $template) = @_;
5961 return 1;
5964 sub webapp_supported {
5965 #my $self = shift;
5966 return 0;
5970 sub use_win_compatibility_commands {
5971 #my $self = shift;
5972 return $ENV{MPC_USE_WIN_COMMANDS};
5976 sub post_file_creation {
5977 #my $self = shift;
5978 #my $file = shift;
5979 return undef;
5983 sub escape_spaces {
5984 #my $self = shift;
5985 return 0;
5989 sub validated_directory {
5990 my($self, $dir) = @_;
5991 return $dir;
5994 sub get_quote_symbol {
5995 #my $self = shift;
5996 return '"';
5999 sub get_escaped_quote_symbol {
6000 #my $self = shift;
6001 return '\\\"';
6004 sub get_gt_symbol {
6005 #my $self = shift;
6006 return '>';
6010 sub get_lt_symbol {
6011 #my $self = shift;
6012 return '<';
6016 sub get_and_symbol {
6017 #my $self = shift;
6018 return '&&';
6022 sub get_or_symbol {
6023 #my $self = shift;
6024 return '||';
6028 sub get_cmdsep_symbol {
6029 #my $self = shift;
6030 return ';';
6034 sub dollar_special {
6035 #my $self = shift;
6036 return 0;
6040 sub expand_variables_from_template_values {
6041 #my $self = shift;
6042 return 1;
6046 sub require_dependencies {
6047 #my $self = shift;
6048 return 1;
6052 sub dependency_is_filename {
6053 #my $self = shift;
6054 return 1;
6058 sub fill_value {
6059 #my $self = shift;
6060 #my $name = shift;
6061 return undef;
6065 sub project_file_prefix {
6066 #my $self = shift;
6067 return '';
6071 sub project_file_extension {
6072 #my $self = shift;
6073 return '';
6077 sub override_valid_component_extensions {
6078 #my $self = shift;
6079 #my $comp = shift;
6080 return undef;
6084 sub override_exclude_component_extensions {
6085 #my $self = shift;
6086 #my $comp = shift;
6087 return undef;
6091 sub get_dll_exe_template_input_file {
6092 #my($self, $tkey) = @_;
6093 return undef;
6097 sub get_lib_exe_template_input_file {
6098 my($self, $tkey) = @_;
6099 return $self->get_dll_exe_template_input_file($tkey);
6103 sub get_lib_template_input_file {
6104 my($self, $tkey) = @_;
6105 return $self->get_dll_template_input_file($tkey);
6109 sub get_dll_template_input_file {
6110 #my($self, $tkey) = @_;
6111 return undef;
6115 sub get_template {
6116 return $_[0]->{'pctype'};
6119 sub requires_forward_slashes {
6120 return 0;
6123 sub warn_useless_project {
6124 return 1;
6127 sub pre_write_output_file {
6128 return 1;
6131 sub pre_generation {
6132 #my $self = shift;
6135 sub default_to_library {
6136 return 0;