package TemplateParser; # ************************************************************ # Description : Parses the template and fills in missing values # Author : Chad Elliott # Create Date : 5/17/2002 # ************************************************************ # ************************************************************ # Pragmas # ************************************************************ use strict; use File::Path; use Parser; use WinVersionTranslator; use vars qw(@ISA); @ISA = qw(Parser); # ************************************************************ # Data Section # ************************************************************ # Valid keywords for use in template files. Each has a handle_ # method available, but some have other methods too. # Bit Meaning # 0 means there is a get_ method available (used by if and nested functions) # 1 means there is a perform_ method available (used by foreach and nested) # 2 means there is a doif_ method available (used by if) # 3 means that parameters to perform_ should not be evaluated # 4 means there is a post_ method available (called after the results of # calling perform_ for a nested function are written to the output) # 5 means that the get_ method performs the get_ and doif_ functionality # # Perl Function Parameter Type Return Type # get_ string string or array # perform_ array reference array # doif_ array reference boolean # my $get_type = 1 << 0; my $perform_type = 1 << 1; my $doif_type = 1 << 2; my $perform_no_eval_type = 1 << 3; my $post_type = 1 << 4; my $get_combined_type = 1 << 5; my %keywords = ('if' => 0, 'else' => 0, 'endif' => 0, 'noextension' => $get_type|$perform_type, 'dirname' => $get_type|$perform_type|$doif_type, 'basename' => $get_type|$perform_type|$doif_type, 'basenoextension' => 0, 'foreach' => 0, 'forfirst' => 0, 'fornotfirst' => 0, 'fornotlast' => 0, 'forlast' => 0, 'endfor' => 0, 'eval' => 0, 'comment' => 0, 'marker' => 0, 'uc' => $get_type|$perform_type, 'lc' => $get_type|$perform_type, 'ucw' => 0, 'normalize' => $get_type|$perform_type, 'flag_overrides' => $get_type, 'reverse' => $get_type|$perform_type, 'sort' => $get_type|$perform_type, 'uniq' => $get_type|$perform_type, 'cmake_macro' => $get_type|$perform_type|$doif_type, 'multiple' => $get_type|$doif_type|$get_combined_type, 'starts_with' => $get_type|$doif_type|$get_combined_type, 'ends_with' => $get_type|$doif_type|$get_combined_type, 'contains' => $get_type|$doif_type|$get_combined_type, 'subst' => $get_type|$doif_type|$get_combined_type, 'remove_from' => $get_type|$perform_type|$doif_type|$perform_no_eval_type|$get_combined_type, 'compares' => $get_type|$doif_type|$get_combined_type, 'vars_equal' => $get_type|$perform_type, 'duplicate_index' => $get_type|$doif_type|$get_combined_type, 'transdir' => $get_type|$doif_type, 'has_extension' => $get_type|$doif_type|$get_combined_type, 'keyname_used' => 0, 'scope' => 0, 'full_path' => $get_type|$perform_type, 'extensions' => $perform_type|$perform_no_eval_type, 'create_aux_file' => $perform_type|$post_type, 'end_aux_file' => 0, 'translate_vars' => $get_type|$perform_type, 'convert_slashes' => $perform_type, 'new_guid' => 0, 'deref' => 0, 'set' => 0, 'is_relative' => $get_type|$doif_type|$get_combined_type, 'extension' => $get_type, 'is_custom_input' => $get_type|$doif_type|$get_combined_type, ); my %target_type_vars = ('type_is_static' => 1, 'need_staticflags' => 1, 'type_is_dynamic' => 1, 'type_is_binary' => 1, ); my %arrow_op_ref = ('custom_type' => 'custom types', 'grouped_.*_file' => 'grouped files', 'feature' => 'features', ); # optmized regex my $parse_line_re1 = qr/^[ ]*<%(\w+)(?:\((?:(?:\w+\s*,\s*)*[!]?\w+\(.+\)|[^\)]+)\))?%>$/; my $process_name_re1 = qr/([^%\(]+)(\(([^%]+)\))?%>/; # ************************************************************ # Subroutine Section # ************************************************************ sub new { my($class, $prjc) = @_; my $self = $class->SUPER::new(); $self->{'prjc'} = $prjc; $self->{'ti'} = $prjc->get_template_input(); $self->{'cslashes'} = $prjc->convert_slashes(); $self->{'crlf'} = $prjc->crlf(); $self->{'cmds'} = $prjc->get_command_subs(); $self->{'vnames'} = $prjc->get_valid_names(); $self->{'values'} = {}; $self->{'defaults'} = {}; $self->{'lines'} = []; $self->{'built'} = ''; $self->{'sstack'} = []; $self->{'lstack'} = []; $self->{'if_skip'} = 0; $self->{'eval'} = 0; $self->{'eval_str'} = ''; $self->{'dupfiles'} = {}; $self->{'override_target_type'} = undef; $self->{'keyname_used'} = {}; $self->{'scopes'} = {}; $self->{'aux_file'} = undef; $self->{'custom_input_cache'} = {}; $self->{'foreach'} = {}; $self->{'foreach'}->{'count'} = -1; $self->{'foreach'}->{'nested'} = 0; $self->{'foreach'}->{'name'} = []; $self->{'foreach'}->{'vars'} = []; $self->{'foreach'}->{'text'} = []; $self->{'foreach'}->{'scope'} = []; $self->{'foreach'}->{'scope_name'} = []; $self->{'foreach'}->{'temp_scope'} = []; $self->{'foreach'}->{'processing'} = 0; return $self; } sub tp_basename { my($self, $file) = @_; if ($self->{'cslashes'}) { $file =~ s/.*[\/\\]//; } else { $file =~ s/.*\///; } return $file; } sub validated_dirname { my($self, $file) = @_; my $index = rindex($file, ($self->{'cslashes'} ? '\\' : '/')); if ($index >= 0) { return $self->{'prjc'}->validated_directory(substr($file, 0, $index)); } else { return '.'; } } sub tp_dirname { my($self, $file) = @_; my $index = rindex($file, ($self->{'cslashes'} ? '\\' : '/')); if ($index >= 0) { return substr($file, 0, $index); } else { return '.'; } } sub strip_line { #my $self = shift; #my $line = shift; ## Override strip_line() from Parser. ## We need to preserve leading space and ## there is no comment string in templates. ++$_[0]->{'line_number'}; $_[1] =~ s/\s+$//; return $_[1]; } ## Append the current value to the line that is being ## built. This line may be a foreach line or a general ## line without a foreach. sub append_current { my $value = $_[1]; my $scope = $_[0]->{'scopes'}; while(defined $$scope{'scope'}) { $scope = $$scope{'scope'}; if (defined $$scope{'escape'}) { if ($$scope{'escape'}->[1] < 0 && $_[0]->{'foreach'}->{'count'} >= 0) { ## This scope was created outside of a foreach. If we are ## processing a foreach, we need to skip this at this point as it ## will be handled once the foreach has been completed and is ## appended to the main project body. last; } else { my $key = $$scope{'escape'}->[0]; if ($key eq '\\') { $value =~ s/\\/\\\\/g; } else { $value =~ s/($key)/\\$1/g; } } } else { foreach my $key (keys %$scope) { $_[0]->warning("Unrecognized scope function: $key."); } } } my $foreach_count = $_[0]->{'foreach'}->{'count'}; if ($_[0]->{'aux_file'} && $foreach_count == $_[0]->{'aux_file'}->{'foreach_baseline'}) { $_[0]->{'aux_file'}->{'text'} .= $value; } elsif ($foreach_count >= 0) { $_[0]->{'foreach'}->{'text'}->[$foreach_count] .= $value; } elsif ($_[0]->{'eval'}) { $_[0]->{'eval_str'} .= $value; } else { $_[0]->{'built'} .= $value; } } sub split_parameters { my($self, $str) = @_; my @params; while($str =~ /^(\w+\([^\)]+\))(.*)/ || $str =~ /^([^,]+)(.*)/) { push(@params, $1); $str = $2; $str =~ s/^\s*,\s*//; } ## Return the parameters (which includes whatever is left in the ## string). Just return it instead of pushing it onto @params. return $str eq '' ? @params : (@params, $str); } sub set_current_values { my($self, $name) = @_; my $set = 0; ## If any value within a foreach matches the name ## of a hash table within the template input we will ## set the values of that hash table in the current scope if (defined $self->{'ti'}) { my $counter = $self->{'foreach'}->{'count'}; if ($counter >= 0) { ## Variable names are case-insensitive in MPC, however this can ## cause problems when dealing with template variable values that ## happen to match HASH names only by case-insensitivity. So, we ## now make HASH names match with case-sensitivity. my $value = $self->{'ti'}->get_value($name); if (defined $value && UNIVERSAL::isa($value, 'HASH') && $self->{'ti'}->get_realname($name) eq $name) { $self->{'foreach'}->{'scope_name'}->[$counter] = $name; my %copy; foreach my $key (keys %$value) { $copy{$key} = $self->{'prjc'}->adjust_value( [$name . '::' . $key, $name], $$value{$key}, $self); } $self->{'foreach'}->{'temp_scope'}->[$counter] = \%copy; $set = 1; } else { ## Since we're not creating a temporary scope for this level, we ## need to empty out the scope that may have been held here from ## a previous foreach. $self->{'foreach'}->{'temp_scope'}->[$counter] = {}; } } } return $set; } sub get_value { my($self, $name) = @_; my $value; my $counter = $self->{'foreach'}->{'count'}; my $fromprj; my @scopes; my @snames; my $adjust = 1; ## $name should always be all lower-case $name = lc($name); ## First, check the temporary scope (set inside a foreach) if ($counter >= 0) { ## Create a list of possible scoped names @scopes = reverse @{$self->{'foreach'}->{'scope_name'}}; @snames = map { (defined $_ ? $_ : '') . '::' . $name } @scopes; push(@snames, $name); while(!defined $value && $counter >= 0) { $value = $self->{'foreach'}->{'temp_scope'}->[$counter]->{$name}; --$counter; } $counter = $self->{'foreach'}->{'count'}; if ($self->{'override_target_type'} && defined $value && defined $target_type_vars{$name}) { $value = $self->{'values'}->{$name}; } } else { @snames = ($name); } if (!defined $value) { if ($name =~ /^flag_overrides\((.*)\)$/) { $value = $self->get_flag_overrides($1); } if (!defined $value) { ## Next, check for a template value if (defined $self->{'ti'}) { $value = $self->{'ti'}->get_value($name); } if (!defined $value) { ## Calling adjust_value here allows us to pick up template ## overrides before getting values elsewhere. my $uvalue = $self->{'prjc'}->adjust_value(\@snames, [], $self); if (defined $$uvalue[0]) { $value = $uvalue; $adjust = 0; $fromprj = 1; } if (!defined $value) { ## Next, check the inner to outer foreach ## scopes for overriding values while(!defined $value && $counter >= 0) { $value = $self->{'foreach'}->{'scope'}->[$counter]->{$name}; --$counter; } ## Then get the value from the project creator if (!defined $value) { $fromprj = 1; $value = $self->{'prjc'}->get_assignment($name); ## Then get it from our known values if (!defined $value) { $value = $self->{'values'}->{$name}; if (!defined $value) { ## Call back onto the project creator to allow ## it to fill in the value before defaulting to undef. $value = $self->{'prjc'}->fill_value($name); if (!defined $value && $name =~ /^(.*)\->(\w+)/) { my $pre = $1; my $post = $2; my $base = $self->get_value($pre); if (defined $base) { $value = $self->{'prjc'}->get_special_value( $pre, $post, $base, ($self->{'prjc'}->requires_parameters($post) ? $self->prepare_parameters($pre) : undef)); } } } } } } } } } ## Adjust the value even if we haven't obtained one from an outside ## source. if ($adjust && defined $value) { $value = $self->{'prjc'}->adjust_value(\@snames, $value, $self); } ## If the value did not come from the project creator, we ## check the variable name. If it is a project keyword we then ## check to see if we need to add the project value to the template ## variable value. If so, we make a copy of the value array and ## push the project value onto that (to avoid modifying the original). if (!$fromprj && defined $self->{'vnames'}->{$name} && $self->{'prjc'}->add_to_template_input_value($name)) { my $pjval = $self->{'prjc'}->get_assignment($name); if (defined $pjval) { my @copy = @$value; if (!UNIVERSAL::isa($pjval, 'ARRAY')) { $pjval = $self->create_array($pjval); } push(@copy, @$pjval); $value = \@copy; } } return (defined $value ? $self->{'prjc'}->relative($value, undef, \@scopes) : undef); } sub get_value_with_default { my $self = shift; my $name = lc(shift); my $value = $self->get_value($name); if (!defined $value) { $value = $self->{'defaults'}->{$name}; if (defined $value) { my $counter = $self->{'foreach'}->{'count'}; my $sname; if ($counter >= 0) { ## Find the outer most scope for our variable name for(my $index = $counter; $index >= 0; --$index) { if (defined $self->{'foreach'}->{'scope_name'}->[$index]) { $sname = $self->{'foreach'}->{'scope_name'}->[$index] . '::' . $name; last; } } } $value = $self->{'prjc'}->relative( $self->{'prjc'}->adjust_value( [$sname, $name], $value, $self)); ## If the user set the variable to empty, we will go ahead and use ## the default value (since we know we have one at this point). $value = $self->{'defaults'}->{$name} if (!defined $value); } else { #$self->warning("$name defaulting to empty string."); $value = ''; } } return (UNIVERSAL::isa($value, 'ARRAY') ? "@$value" : $value); } sub get_match_pattern { my ($tp, $patarg) = @_; my $patval = $tp->get_value($patarg); if (defined $patval) { return $patval; } else { return $patarg; } } sub process_foreach { my $self = shift; my $index = $self->{'foreach'}->{'count'}; my $text = $self->{'foreach'}->{'text'}->[$index]; my @values; my $name = $self->{'foreach'}->{'name'}->[$index]; my @cmds; my $val = $self->{'foreach'}->{'vars'}->[$index]; my $check_for_mixed; if ($val =~ /^((\w+),\s*)?flag_overrides\((.*)\)$/) { ## If the user did not provide a name we have to pick one otherwise ## there would be no way to access the foreach values. $name = (defined $2 ? $2 : '__unnamed__'); ## Now check to see if there were overrides for this value. If there ## were, convert them into an array (if necessary) and continue ## processing. $val = $self->get_flag_overrides($3); if (defined $val) { $val = $self->create_array($val) if (!UNIVERSAL::isa($val, 'ARRAY')); @values = @$val; } } else { ## Pull out modifying commands first while($val =~ /(\w+)\((.+)\)/) { my $cmd = $1; $val = $2; if (($keywords{$cmd} & $perform_type) != 0) { push(@cmds, 'perform_' . $cmd); if (($keywords{$cmd} & $perform_no_eval_type) != 0) { my @params = $self->split_parameters($val); $val = \@params; last; } } else { $self->warning("Unable to use $cmd in foreach (no perform_ method)."); } } ## Get the values for all of the variable names ## contained within the foreach if (UNIVERSAL::isa($val, 'ARRAY')) { @values = @$val; } else { my $names = $self->create_array($val); foreach my $n (@$names) { my $vals = $self->get_value($n); if (defined $vals && $vals ne '') { if (!UNIVERSAL::isa($vals, 'ARRAY')) { $vals = $self->create_array($vals); } push(@values, @$vals); } if (!defined $name) { $name = $n; $name =~ s/s$//; } ## We only want to check for the mixing of scalar and hash ## variables if the variable name is not a keyword (or the ## special 'features' template variable). if (!$check_for_mixed && !$self->{'prjc'}->is_keyword($n) && $n ne 'features') { $check_for_mixed = 1; } } } } ## Perform the commands on the built up @values foreach my $cmd (reverse @cmds) { @values = $self->$cmd(\@values); } ## Reset the text (it will be regenerated by calling parse_line $self->{'foreach'}->{'text'}->[$index] = ''; if (defined $values[0]) { my $scope = $self->{'foreach'}->{'scope'}->[$index]; my $base = $self->{'foreach'}->{'base'}->[$index]; $$scope{'forlast'} = ''; $$scope{'fornotlast'} = 1; $$scope{'forfirst'} = 1; $$scope{'fornotfirst'} = ''; ## If the foreach values are mixed (HASH and SCALAR), then ## remove the SCALAR values. if ($check_for_mixed) { my %mixed; my $mixed = 0; foreach my $mval (@values) { $mixed{$mval} = $self->set_current_values($mval); $mixed |= $mixed{$mval}; } if ($mixed) { my @nvalues; foreach my $key (sort keys %mixed) { push(@nvalues, $key) if ($mixed{$key}); } ## Set the new values only if they are different ## from the original (except for order). my @sorted = sort(@values); @values = @nvalues if (@sorted != @nvalues); } } for(my $i = 0; $i <= $#values; ++$i) { my $value = $values[$i]; ## Set the corresponding values in the temporary scope $self->set_current_values($value); ## Set the special values that only exist ## within a foreach if ($i != 0) { $$scope{'forfirst'} = ''; $$scope{'fornotfirst'} = 1; } if ($i == $#values) { $$scope{'forlast'} = 1; $$scope{'fornotlast'} = ''; } $$scope{'forcount'} = $i + $base; ## We don't use adjust_value here because these names ## are generated from a foreach and should not be adjusted. $$scope{$name} = $value; ## A tiny hack for VC7 if ($name eq 'configuration' && $self->get_value_with_default('platform') ne '') { $self->{'prjc'}->update_project_info($self, 1, ['configuration', 'platform'], '|'); } ## Now parse the line of text, each time ## with different values ++$self->{'foreach'}->{'processing'}; $self->{'prjc'}->set_forcount($i); my($status, $error) = $self->parse_line(undef, $text); --$self->{'foreach'}->{'processing'}; return $error if (defined $error); } } return undef; } sub generic_handle { my($self, $func, $str) = @_; if (defined $str) { my $val = $self->$func([$str]); if (defined $val) { $self->append_current($val); } else { $self->append_current(0); } } } sub handle_endif { my($self, $name) = @_; my $end = pop(@{$self->{'sstack'}}); pop(@{$self->{'lstack'}}); if (!defined $end) { return "Unmatched $name"; } else { my $in = index($end, $name); if ($in == 0) { $self->{'if_skip'} = 0; } elsif ($in == -1) { return "Unmatched $name"; } } return undef; } sub handle_endfor { my($self, $name) = @_; my $end = pop(@{$self->{'sstack'}}); pop(@{$self->{'lstack'}}); if (!defined $end) { return "Unmatched $name"; } else { my $in = index($end, $name); if ($in == 0) { my $index = $self->{'foreach'}->{'count'}; my $error = $self->process_foreach(); if (!defined $error) { --$self->{'foreach'}->{'count'}; $self->append_current($self->{'foreach'}->{'text'}->[$index]); } return $error; } elsif ($in == -1) { return "Unmatched $name"; } } return undef; } sub get_flag_overrides { my($self, $name) = @_; my $type; ## Split the name and type parameters ($name, $type) = split(/,\s*/, $name); my $file = $self->get_value($name); if (defined $file) { ## Save the name prefix (if there is one) for ## command parameter conversion at the end my $pre; if ($name =~ /^(\w+)->/) { $pre = $1; ## Replace the custom_type key with the actual custom type if ($pre eq 'custom_type') { my $ct = $self->get_value($pre); $name = $ct if (defined $ct); } elsif ($pre =~ /^grouped_(.*_file)$/) { $name = $1; } } my $fo = $self->{'prjc'}->{'flag_overrides'}; my $key = (defined $$fo{$name . 's'} ? $name . 's' : (defined $$fo{$name} ? $name : undef)); if (defined $key) { ## Convert the file name into a unix style file name my $ustyle = $file; $ustyle =~ s/\\/\//g if ($self->{'cslashes'}); ## Save the directory portion for checking in the foreach my $dir = $self->mpc_dirname($ustyle); my $of = (defined $$fo{$key}->{$ustyle} ? $ustyle : (defined $$fo{$key}->{$dir} ? $dir : undef)); if (defined $of) { my $prjc = $self->{'prjc'}; foreach my $aname (@{$prjc->{'matching_assignments'}->{$key}}) { if ($aname eq $type && defined $$fo{$key}->{$of}->{$aname}) { my $value = $$fo{$key}->{$of}->{$aname}; ## If the name that we're overriding has a value and ## requires parameters, then we will convert all of the ## pseudo variables and provide parameters. if (defined $pre && $prjc->requires_parameters($type)) { $value = $prjc->convert_command_parameters( $key, $value, $self->prepare_parameters($pre)); } return $prjc->relative($value); } } } } } return undef; } sub get_multiple { my($self, $name) = @_; return $self->doif_multiple( $self->create_array($self->get_value_with_default($name))); } sub doif_multiple { my($self, $value) = @_; return defined $value ? (scalar(@$value) > 1) : undef; } sub handle_multiple { my($self, $name) = @_; my $val = $self->get_value_with_default($name); if (defined $val) { my $array = $self->create_array($val); $self->append_current(scalar(@$array)); } else { $self->append_current(0); } } sub get_starts_with { my($self, $str) = @_; return $self->doif_starts_with([$str]); } sub doif_starts_with { my($self, $val) = @_; if (defined $val) { my($name, $pattern) = $self->split_parameters("@$val"); if (defined $name && defined $pattern) { return ($self->get_value_with_default($name) =~ /^$pattern/); } } return undef; } sub handle_starts_with { my($self, $str) = @_; $self->generic_handle('doif_starts_with', $str); } sub get_ends_with { my($self, $str) = @_; return $self->doif_ends_with([$str]); } sub doif_ends_with { my($self, $val) = @_; if (defined $val) { my($name, $pattern) = $self->split_parameters("@$val"); if (defined $name && defined $pattern) { return ($self->get_value_with_default($name) =~ /$pattern$/); } } return undef; } sub handle_ends_with { my($self, $str) = @_; $self->generic_handle('doif_ends_with', $str); } sub handle_keyname_used { my($self, $str) = @_; if (defined $str) { my($name, $key) = $self->split_parameters($str); my $file = $self->get_value_with_default($name); if (defined $self->{'keyname_used'}->{$file}->{$key}) { $self->append_current($self->{'keyname_used'}->{$file}->{$key}++); } else { $self->{'keyname_used'}->{$file}->{$key} = 1; } } } sub handle_scope { my($self, $str) = @_; if (defined $str) { my($state, $func, $param) = $self->split_parameters($str); if (defined $state) { my $pscope; my $scope = $self->{'scopes'}; while(defined $$scope{'scope'}) { $pscope = $scope; $scope = $$scope{'scope'}; } if ($state eq 'enter') { if (defined $func) { $param = '' if (!defined $param); $$scope{'scope'}->{$func} = [$self->process_special($param), $_[0]->{'foreach'}->{'count'}]; } else { $self->warning("The enter scope function requires a parameter."); } } elsif ($state eq 'leave') { if (defined $pscope) { delete $$pscope{'scope'}; } else { $self->warning("leave scope function encountered without an enter."); } } else { $self->warning("Unrecognized scope function parameter: $state."); } } else { $self->warning("The scope function requires 1 to 3 parameters."); } } } sub get_has_extension { my($self, $str) = @_; return $self->doif_has_extension([$str]); } sub doif_has_extension { my($self, $val) = @_; if (defined $val) { return ($self->tp_basename( $self->get_value_with_default("@$val")) =~ /\.[^\.]*$/); } return undef; } sub handle_has_extension { my($self, $str) = @_; $self->generic_handle('doif_has_extension', $str); } sub get_contains { my($self, $str) = @_; return $self->doif_contains([$str]); } sub doif_contains { my($self, $val) = @_; if (defined $val) { my($name, $pattern) = $self->split_parameters("@$val"); if (defined $name && defined $pattern) { $pattern = $self->get_match_pattern ($pattern); return ($self->get_value_with_default($name) =~ /$pattern/); } } return undef; } sub handle_contains { my($self, $str) = @_; $self->generic_handle('doif_contains', $str); } sub get_subst { my($self, $str) = @_; return $self->doif_subst([$str]); } sub doif_subst { my($self, $val) = @_; if (defined $val) { my($name, $pattern, $replacement) = $self->split_parameters("@$val"); if (defined $name && defined $pattern && defined $replacement) { my $result = $self->get_value_with_default($name); $result =~ s/$pattern/$replacement/g; return $result; } } return undef; } sub handle_subst { my($self, $str) = @_; $self->generic_handle('doif_subst', $str); } sub get_remove_from { my($self, $str) = @_; return $self->doif_remove_from($str); } sub doif_remove_from { my($self, $str) = @_; my @params = $self->split_parameters($str); my @removed = $self->perform_remove_from(\@params); return (defined $removed[0] ? 1 : undef); } sub perform_remove_from { my($self, $val) = @_; my($source, $pattern, $target, $tremove) = @$val; ## $source should be a component name (e.g., source_files, ## header_files, etc.) $target is a variable name ## $pattern and $tremove are optional; $pattern is a partial regular ## expression to match the end of the files found from $source. The ## beginning of the regular expression is made from $target by removing ## $tremove from the end of it. if (defined $source && defined $target && defined $self->{'values'}->{$source}) { my $tval = $self->get_value_with_default($target); if (defined $tval) { $tval =~ s/$tremove$// if (defined $tremove); $tval = $self->escape_regex_special($tval); my @removed; my $max = scalar(@{$self->{'values'}->{$source}}); for(my $i = 0; $i < $max;) { if ($self->{'values'}->{$source}->[$i] =~ /^$tval$pattern$/) { push(@removed, splice(@{$self->{'values'}->{$source}}, $i, 1)); $max--; } else { $i++; } } return @removed; } } return (); } sub handle_remove_from { my($self, $str) = @_; if (defined $str) { my @params = $self->split_parameters($str); my $val = $self->perform_remove_from(\@params); $self->append_current("@$val") if (defined $val); } } sub get_compares { my($self, $str) = @_; return $self->doif_compares([$str]); } sub doif_compares { my($self, $val) = @_; if (defined $val) { my($name, $pattern) = $self->split_parameters("@$val"); if (defined $name && defined $pattern) { return ($self->get_value_with_default($name) eq $pattern); } } return undef; } sub handle_compares { my($self, $str) = @_; $self->generic_handle('doif_compares', $str); } sub get_vars_equal { my($self, $str) = @_; return $self->doif_vars_equal([$str]); } sub doif_vars_equal { my($self, $val) = @_; if (defined $val) { my($var1, $var2) = $self->split_parameters("@$val"); if (defined $var1 && defined $var2) { return ($self->get_value_with_default($var1) eq $self->get_value_with_default($var2)); } } return undef; } sub handle_vars_equal { my($self, $str) = @_; $self->generic_handle('doif_vars_equal', $str); } sub get_reverse { my($self, $name) = @_; my $value = $self->get_value_with_default($name); if (defined $value) { my @array = $self->perform_reverse($self->create_array($value)); return \@array; } return undef; } sub perform_reverse { my($self, $value) = @_; return reverse(@$value); } sub handle_reverse { my($self, $name) = @_; my $val = $self->get_value_with_default($name); if (defined $val) { my @array = $self->perform_reverse($self->create_array($val)); $self->append_current("@array"); } } sub get_sort { my($self, $name) = @_; my $value = $self->get_value_with_default($name); if (defined $value) { my @array = $self->perform_sort($self->create_array($value)); return \@array; } return undef; } sub perform_sort { my($self, $value) = @_; return sort(@$value); } sub handle_sort { my($self, $name) = @_; my $val = $self->get_value_with_default($name); if (defined $val) { my @array = $self->perform_sort($self->create_array($val)); $self->append_current("@array"); } } sub get_uniq { my($self, $name) = @_; my $value = $self->get_value_with_default($name); if (defined $value) { my @array = $self->perform_uniq($self->create_array($value)); return \@array; } return undef; } sub perform_uniq { my($self, $value) = @_; my %value; @value{@$value} = (); return sort(keys %value); } sub handle_uniq { my($self, $name) = @_; my $val = $self->get_value_with_default($name); if (defined $val) { my @array = $self->perform_uniq($self->create_array($val)); $self->append_current("@array"); } } sub process_compound_if { my($self, $str) = @_; if (index($str, '||') >= 0) { my $ret = 0; foreach my $v (split(/\s*\|\|\s*/, $str)) { $ret |= $self->process_compound_if($v); return 1 if ($ret != 0); } return 0; } elsif (index($str, '&&') >= 0) { my $ret = 1; foreach my $v (split(/\s*\&\&\s*/, $str)) { $ret &&= $self->process_compound_if($v); return 0 if ($ret == 0); } return 1; } else { ## See if we need to reverse the return value my $not = 0; if ($str =~ /^!+(.*)/) { $not = 1; $str = $1; } ## Get the value based on the string my @cmds; my $val; while($str =~ /(\w+)\((.+)\)(.*)/) { if ($3 eq '') { push(@cmds, $1); $str = $2; } else { ## If there is something trailing the closing parenthesis then ## the whole thing is considered a parameter to the first ## function. last; } } if (defined $cmds[0]) { ## Start out calling get_xxx on the string my $type = $get_type; my $prefix = 'get_'; $val = $str; ## If there is only one command, we have to add it to the list ## again so that we can get the variable value and then use ## the doif_ version to test it, unless the get_ function ## also performs the doif_ functionality. if ($#cmds == 0 && defined $keywords{$cmds[0]} && ($keywords{$cmds[0]} & $doif_type) != 0 && ($keywords{$cmds[0]} & $get_combined_type) == 0) { push(@cmds, $cmds[0]); } foreach my $cmd (reverse @cmds) { if (defined $keywords{$cmd} && ($keywords{$cmd} & $type) != 0) { my $func = "$prefix$cmd"; $val = $self->$func($val); ## Now that we have a value, we need to switch over ## to calling doif_xxx $type = $doif_type; $prefix = 'doif_'; } else { $self->warning("Unable to use $cmd in if (no $prefix method)."); } } } else { $val = $self->get_value($str); } ## See if any portion of the value is defined and not empty my $ret = 0; if (defined $val) { if (UNIVERSAL::isa($val, 'ARRAY')) { foreach my $v (@$val) { if ($v ne '') { $ret = 1; last; } } } elsif ($val ne '') { $ret = 1; } } return ($not ? !$ret : $ret); } } sub handle_if { my($self, $val) = @_; my $name = 'endif'; push(@{$self->{'lstack'}}, "<%if($val)%> (" . $self->get_line_number() . '?)'); if ($self->{'if_skip'}) { push(@{$self->{'sstack'}}, "*$name"); } else { ## Determine if we are skipping the portion of this if statement ## $val will always be defined since we won't get into this method ## without properly parsing the if statement. $self->{'if_skip'} = !$self->process_compound_if($val); push(@{$self->{'sstack'}}, $name); } } sub handle_else { my $self = shift; my @scopy = @{$self->{'sstack'}}; my $index = index($scopy[$#scopy], 'endif'); if ($index >= 0) { if ($index == 0) { $self->{'if_skip'} ^= 1; } $self->{'sstack'}->[$#scopy] .= ':'; } return 'Unmatched else' if (($self->{'sstack'}->[$#scopy] =~ tr/:/:/) > 1); return undef; } sub handle_foreach { my $self = shift; my $val = lc(shift); my $name = 'endfor'; my $errorString; push(@{$self->{'lstack'}}, $self->get_line_number()); if (!$self->{'if_skip'}) { my $base = 1; my $vname; if ($val =~ /flag_overrides\([^\)]+\)/) { } elsif ($val =~ /([^,]*),(.*)/) { $vname = $1; $val = $2; $vname =~ s/^\s+//; $vname =~ s/\s+$//; $val =~ s/^\s+//; $val =~ s/\s+$//; if ($vname eq '') { $errorString = 'The foreach variable name is not valid'; } if ($val =~ /([^,]*),(.*)/) { $base = $1; $val = $2; $base =~ s/^\s+//; $base =~ s/\s+$//; $val =~ s/^\s+//; $val =~ s/\s+$//; if ($base !~ /^\d+$/) { $errorString = 'The forcount specified is not a valid number'; } } elsif ($vname =~ /^\d+$/) { $base = $vname; $vname = undef; } ## Due to the way flag_overrides works, we can't allow ## the user to name the foreach variable when dealing ## with variables that can be used with the -> operator if (defined $vname) { foreach my $ref (keys %arrow_op_ref) { my $name_re = $ref . 's'; if ($val =~ /^$ref\->/ || $val =~ /^$name_re$/) { $errorString = 'The foreach variable can not be ' . 'named when dealing with ' . $arrow_op_ref{$ref}; } } } } push(@{$self->{'sstack'}}, $name); my $index = ++$self->{'foreach'}->{'count'}; $self->{'foreach'}->{'base'}->[$index] = $base; $self->{'foreach'}->{'name'}->[$index] = $vname; $self->{'foreach'}->{'vars'}->[$index] = $val; $self->{'foreach'}->{'text'}->[$index] = ''; $self->{'foreach'}->{'scope'}->[$index] = {}; $self->{'foreach'}->{'scope_name'}->[$index] = undef; } else { push(@{$self->{'sstack'}}, "*$name"); } return $errorString; } sub handle_special { my($self, $name, $val) = @_; ## If $name (fornotlast, forfirst, etc.) is set to 1 ## Then we append the $val onto the current string that's ## being built. $self->append_current($val) if ($self->get_value($name)); } sub get_uc { my($self, $name) = @_; return uc($self->get_value_with_default($name)); } sub handle_uc { my($self, $name) = @_; $self->append_current($self->get_uc($name)); } sub perform_uc { my($self, $value) = @_; my @val; foreach my $val (@$value) { push(@val, uc($val)); } return @val; } sub get_lc { my($self, $name) = @_; return lc($self->get_value_with_default($name)); } sub handle_lc { my($self, $name) = @_; $self->append_current($self->get_lc($name)); } sub perform_lc { my($self, $value) = @_; my @val; foreach my $val (@$value) { push(@val, lc($val)); } return @val; } sub handle_ucw { my($self, $name) = @_; my $val = $self->get_value_with_default($name); substr($val, 0, 1) = uc(substr($val, 0, 1)); while($val =~ /[_\s]([a-z])/) { my $uc = uc($1); $val =~ s/[_\s][a-z]/ $uc/; } $self->append_current($val); } sub actual_normalize { $_[1] =~ tr/ \t\/\\\-$()./_/; return $_[1]; } sub perform_normalize { my($self, $value) = @_; my @val; foreach my $val (@$value) { push(@val, $self->actual_normalize($val)); } return @val; } sub get_normalize { my($self, $name) = @_; return $self->actual_normalize($self->get_value_with_default($name)); } sub handle_normalize { my($self, $name) = @_; $self->append_current($self->get_normalize($name)); } sub actual_noextension { $_[1] =~ s/\.[^\.]*$//; return $_[1]; } sub perform_noextension { my($self, $value) = @_; my @val; foreach my $val (@$value) { push(@val, $self->actual_noextension($val)); } return @val; } sub get_noextension { my($self, $name) = @_; return $self->actual_noextension($self->get_value_with_default($name)); } sub handle_noextension { my($self, $name) = @_; $self->append_current($self->get_noextension($name)); } sub perform_full_path { my($self, $value) = @_; my @val; foreach my $val (@$value) { push(@val, $self->actual_full_path($val)); } return @val; } sub get_full_path { my($self, $name) = @_; return $self->actual_full_path($self->get_value_with_default($name)); } sub actual_full_path { my($self, $value) = @_; ## Expand all defined env vars $value =~ s/\$\((\w+)\)/$ENV{$1} || '$(' . $1 . ')'/ge; ## If we expanded all env vars, get absolute path if ($value =~ /\$\(\w+\)/) { $self->{'error_in_handle'} = "<%full_path%> couldn't expand " . "environment variables in $value"; return $value; } ## Always convert the slashes since they may be in the OS native ## format and we need them in UNIX format. $value =~ s/\\/\//g; my $dir = $self->mpc_dirname($value); if (-e $dir) { $dir = $self->abs_path($dir); } elsif ($self->{'prjc'}->path_is_relative($dir)) { ## If the directory is is not already an absolute path, then we will ## assume that the directory is relative to the current directory ## (which will be the location of the MPC file). $dir = $self->getcwd() . '/' . $dir; } ## Create the full path value, remove directories represented as '.' and ## convert the slashes if necessary. $value = $dir . '/' . $self->mpc_basename($value); $value =~ s/\/\.\//\//g; $value =~ s/\/\.$//; $value =~ s/\//\\/g if ($self->{'cslashes'}); return $value; } sub handle_full_path { my($self, $name) = @_; my $val = $self->get_value_with_default($name); $self->append_current($self->actual_full_path($val)); } sub perform_extensions { my($self, $value) = @_; my @val; foreach my $val (@$value) { push(@val, $self->{'prjc'}->get_component_extensions($val)); } return @val; } sub handle_extensions { my($self, $name) = @_; my @val = $self->perform_extensions([$name]); $self->append_current("@val"); } sub evaluate_nested_functions { my($self, $funcname, $args) = @_; my @params = $self->split_parameters($args); my @results; foreach my $param (@params) { my @cmds; my $val = $param; while($val =~ /(\w+)\((.+)\)/) { push(@cmds, $1); $val = $2; } if (scalar @cmds == 0) { push @results, $val; next; } my $type = $get_type; my $prefix = 'get_'; foreach my $cmd (reverse @cmds) { if (defined $keywords{$cmd} && ($keywords{$cmd} & $type) != 0) { my $func = "$prefix$cmd"; if ($type == $get_type) { $val = $self->$func($val); $val = [ $val ] if (!UNIVERSAL::isa($val, 'ARRAY')); ## Now that we have a value, we need to switch over ## to calling perform_xxx $type = $perform_type; $prefix = 'perform_'; } else { my @array = $self->$func($val); $val = \@array; } } else { $self->warning("Unable to use $cmd in nested " . "functions (no $prefix method)."); } } push @results, "@$val"; } if (defined $keywords{$funcname} && ($keywords{$funcname} & $perform_type)) { my $func = 'perform_' . $funcname; my @array = $self->$func(\@results); $self->append_current("@array"); if ($keywords{$funcname} & $post_type) { $func = 'post_' . $funcname; $self->$func(); } } else { $self->warning("Unable to use $funcname in nested " . "functions (no perform_ method)."); } } sub perform_dirname { my($self, $value) = @_; my @val; foreach my $val (@$value) { push(@val, $self->tp_dirname($val)); } return @val; } sub get_dirname { my($self, $name) = @_; return $self->tp_dirname($self->get_value_with_default($name)); } sub doif_dirname { my($self, $value) = @_; if (defined $value) { $value = $self->tp_dirname($value); return ($value ne '.'); } return undef; } sub handle_dirname { my($self, $name) = @_; $self->append_current( $self->tp_dirname($self->get_value_with_default($name))); } sub perform_basename { my($self, $value) = @_; my @val; foreach my $val (@$value) { push(@val, $self->tp_basename($val)); } return @val; } sub get_basename { my($self, $name) = @_; return $self->tp_basename($self->get_value_with_default($name)); } sub doif_basename { my($self, $value) = @_; if (defined $value) { $value = $self->tp_basename($value); return ($value ne '.'); } return undef; } sub handle_basename { my($self, $name) = @_; $self->append_current( $self->tp_basename($self->get_value_with_default($name))); } sub actual_cmake_macro { my($self, $value) = @_; return $1 if ($value =~ /^\$\{(\w+)\}$/); return ''; } sub perform_cmake_macro { my($self, $value) = @_; my @val; foreach my $val (@$value) { push(@val, $self->actual_cmake_macro($val)); } return @val; } sub get_cmake_macro { my($self, $name) = @_; return $self->actual_cmake_macro($self->get_value_with_default($name)); } sub doif_cmake_macro { my($self, $value) = @_; return (defined $value && $value ne ''); } sub handle_cmake_macro { my($self, $name) = @_; $self->append_current( $self->actual_cmake_macro($self->get_value_with_default($name))); } sub handle_basenoextension { my($self, $name) = @_; my $val = $self->tp_basename($self->get_value_with_default($name)); $val =~ s/\.[^\.]*$//; $self->append_current($val); } sub handle_flag_overrides { my($self, $name) = @_; my $value = $self->get_flag_overrides($name); $self->append_current(UNIVERSAL::isa($value, 'ARRAY') ? "@$value" : $value) if (defined $value); } sub handle_marker { my($self, $name) = @_; my $val = $self->{'prjc'}->get_verbatim($name); $self->append_current($val) if (defined $val); } sub handle_eval { my($self, $name) = @_; my $val = $self->get_value_with_default($name); if (defined $val) { if (index($val, "<%eval($name)%>") >= 0) { $self->warning("Infinite recursion detected in '$name'."); } else { ## Enter the eval state ++$self->{'eval'}; ## Parse the eval line my($status, $error) = $self->parse_line(undef, $val); if ($status) { $self->{'built'} .= $self->{'eval_str'}; } else { $self->warning($error); } ## Leave the eval state --$self->{'eval'}; $self->{'eval_str'} = ''; } } } sub handle_pseudo { my($self, $name) = @_; $self->append_current($self->{'cmds'}->{$name}); } sub get_duplicate_index { my($self, $name) = @_; return $self->doif_duplicate_index($self->get_value_with_default($name)); } sub doif_duplicate_index { my($self, $value) = @_; if (defined $value) { my $base = lc($self->tp_basename($value)); my $path = $self->validated_dirname($value); if (!defined $self->{'dupfiles'}->{$base}) { $self->{'dupfiles'}->{$base} = [$path]; } else { my $index = 1; foreach my $file (@{$self->{'dupfiles'}->{$base}}) { return $index if ($file eq $path); ++$index; } push(@{$self->{'dupfiles'}->{$base}}, $path); return 1; } } return undef; } sub handle_duplicate_index { my($self, $name) = @_; my $value = $self->doif_duplicate_index( $self->get_value_with_default($name)); $self->append_current($value) if (defined $value); } sub actual_transdir { my($self, $value) = @_; if ($value =~ /([\/\\])/) { return $self->{'prjc'}->translate_directory( $self->tp_dirname($value)) . $1; } return undef; } sub get_transdir { my($self, $name) = @_; return $self->actual_transdir($self->get_value_with_default($name)); } sub doif_transdir { my($self, $value) = @_; return (defined $value ? $self->actual_transdir($value) : undef); } sub handle_transdir { my($self, $name) = @_; my $value = $self->actual_transdir($self->get_value_with_default($name)); $self->append_current($value) if (defined $value); } sub handle_create_aux_file { my $self = shift; my @fname = $self->perform_create_aux_file([$self->split_parameters(shift)]); $self->append_current($fname[0]); $self->post_create_aux_file(); } sub post_create_aux_file { my $self = shift; $self->{'aux_file'} = $self->{'aux_temp'}; $self->{'aux_temp'} = undef; } sub perform_create_aux_file { my($self, $argsref) = @_; if (defined $self->{'aux_file'}) { $self->{'error_in_handle'} = "Can't nest create_aux_file commands."; return undef; } my $fname = ''; foreach my $arg (@$argsref) { my $val = $self->get_value($arg); $fname .= defined $val ? (UNIVERSAL::isa($val, 'ARRAY') ? join('_', @$val) : $val) : $arg; } my $dir = $self->mpc_dirname($self->{'prjc'}->get_outdir() . '/' . $self->{'prjc'}->{'assign'}->{'project_file'}); $dir .= '/' . $self->mpc_dirname($fname) if ($fname =~ /[\/\\]/); $self->{'aux_temp'} = {'dir' => $dir, 'filename' => $self->mpc_basename($fname), 'foreach_baseline' => $self->{'foreach'}->{'count'}}; return $fname; } sub handle_end_aux_file { my $self = shift; if (!defined $self->{'aux_file'}) { $self->{'error_in_handle'} = 'end_aux_file seen before create_aux_file'; } else { my $af = $self->{'aux_file'}; mkpath($af->{'dir'}, 0, 0777) if ($af->{'dir'} ne '.'); my $fh = new FileHandle('> ' . $af->{'dir'} . '/' . $af->{'filename'}); if (defined $fh) { print $fh $af->{'text'}; close($fh); } else { $self->{'error_in_handle'} = "Couldn't open: " . $af->{'dir'} . '/' . $af->{'filename'}; } $self->{'aux_file'} = undef; } } sub handle_translate_vars { my($self, $arg) = @_; my @params = $self->split_parameters($arg); $self->append_current($self->perform_translate_vars([@params])); } sub get_translate_vars { my ($self, $str) = @_; my @params = $self->split_parameters($str); return $self->perform_translate_vars([@params]); } sub perform_translate_vars { my($self, $arg) = @_; ## If the first parameter is a template variable with a value, use it. ## Otherwise, use the parameter as the value. my $val = $self->get_value($arg->[0]); $val = $arg->[0] unless defined $val; ## If the second optional parameter is provided, use it. Otherwise, ## use the operating system found in the command substitution map. my $os = (defined $arg->[1] && $arg->[1] ne '') ? $arg->[1] : $self->{'prjc'}->{'command_subs'}->{'os'}; ## Get the variable reference characters based on the operating system ## for which we are generating this project. my ($pre, $post) = ($os eq 'win32') ? ('%', '%') : ('${', '}'); ## Replace $() with the environment variable reference characters. $val =~ s{\$\(([^)]+)\)([^\s\$]*)}{my ($var, $rest) = ($1, $2); $rest =~ s!/!\\!g if $os eq 'win32'; "$pre$var$post$rest"}ge; return $val; } sub handle_convert_slashes { my($self, $arg) = @_; my @params = $self->split_parameters($arg); $self->append_current($self->perform_convert_slashes([@params])); } sub perform_convert_slashes { my($self, $arg) = @_; ## If the first parameter is a template variable with a value, use it. ## Otherwise, use the parameter as the value. my $val = $self->get_value($arg->[0]); $val = $arg->[0] unless defined $val; ## If the second optional parameter is provided, use it. Otherwise, ## use the operating system found in the command substitution map. my $os = (defined $arg->[1] && $arg->[1] ne '') ? $arg->[1] : $self->{'prjc'}->{'command_subs'}->{'os'}; ## Replace forward slashes with backslashes if we're generating this ## project specific to Windows. $val =~ s!/!\\!g if $os eq 'win32'; return $val; } sub handle_new_guid { my($self, $name) = @_; my $val = $self->get_value_with_default($name); my $prjc = $self->{'prjc'}; my $guid = GUID::generate($val ? $val : $name, $prjc->{'current_input'}, File::Spec->abs2rel($prjc->getcwd(), $prjc->getstartdir())); $self->append_current($guid); } sub handle_deref { my($self, $name) = @_; my $val = $self->get_value_with_default($self->get_value_with_default($name)); $self->append_current($val); } sub handle_set { my($self, $val) = @_; my @params = $self->split_parameters($val); if ($#params == 1) { $self->{'values'}->{lc($params[0])} = $params[1]; } else { $self->{'error_in_handle'} = 'set() requires a name and a value'; } } sub get_is_relative { my($self, $name) = @_; return $self->doif_is_relative($self->get_value_with_default($name)); } sub doif_is_relative { my($self, $val) = @_; return $self->{'prjc'}->path_is_relative($val) if (defined $val); return undef; } sub handle_is_relative { my($self, $name) = @_; my $val = $self->get_value_with_default($name); $self->append_current( $self->{'prjc'}->path_is_relative($val) ? '1' : '0') if (defined $val); } sub get_is_custom_input { my($self, $name) = @_; return $self->doif_is_custom_input($self->get_value_with_default($name)); } sub doif_is_custom_input { my($self, $val) = @_; ## Create an array reference from the custom_types string value. my $custom_types = $self->{'prjc'}->get_assignment('custom_types'); my $ctypes = $self->create_array(defined $custom_types ? $custom_types : ''); foreach my $ctype (@$ctypes) { ## Get the input files for each custom type. We cache it to avoid ## generating the custom inputs for each and every call. This function ## is usually called within a foreach context, so it will be called many ## times per run. my $inputs; if (defined $self->{'custom_input_cache'}->{$ctype}) { $inputs = $self->{'custom_input_cache'}->{$ctype}; } else { $inputs = $self->{'prjc'}->get_custom_value('input_files', $ctype); $self->{'custom_input_cache'}->{$ctype} = $inputs; } ## Once we have the inputs, see if any of them match the current file foreach my $input (@$inputs) { ## There are various ways that the user could list files such that ## a custom input could physically match a built-in file listing ## but not be equal, in a string comparison sense. Resolving those ## differences requires path traversal and that the files actually ## exist (which isn't guaranteed at project generation time). So, ## we do the minimal comparison using the file_sorter on the ## ProjectCreator to handle case sensitivity automatically. return 1 if ($self->{'prjc'}->file_sorter($input, $val) == 0); } } ## There are either no custom types or there isn't a custom input file ## that matches the one we're currently processing. return undef; } sub handle_is_custom_input { my($self, $name) = @_; my $val = $self->get_value_with_default($name); $self->append_current( $self->doif_is_custom_input($val) ? '1' : '0') if (defined $val); } sub get_extension { my($self, $name) = @_; my $val = $self->get_value_with_default($name); return ($val =~ /(\.[^\.]+)$/ ? $1 : ''); } sub handle_extension { my($self, $name) = @_; $self->append_current($self->get_extension($name)); } sub prepare_parameters { my($self, $prefix) = @_; my $input = $self->get_value($prefix . '->input_file'); my $output; my $indir; my $outdir; if (defined $input) { $input =~ s/\//\\/g if ($self->{'cslashes'}); $indir = $self->tp_dirname($input); $output = $self->get_value($prefix . '->input_file->output_files'); if (defined $output) { my $size = scalar(@$output); for(my $i = 0; $i < $size; ++$i) { my $fo = $self->get_flag_overrides($prefix . '->input_file, gendir'); if (defined $fo) { $outdir = $self->tp_dirname($$output[$i]); if (!($outdir ne '' && $indir ne $outdir && $fo ne $outdir)) { $$output[$i] = ($fo eq '.' ? '' : $fo . '/') . $self->tp_basename($$output[$i]); } } $$output[$i] =~ s/\//\\/g if ($self->{'cslashes'}); } } } ## Set the parameters array with the determined input and output files return $input, $output; } sub process_name { my($self, $line) = @_; my $length = 0; my $errorString; ## Split the line into a name and value if ($line =~ /$process_name_re1/) { my $name = lc($1); my $val = $3; $length += length($name); if (defined $val) { ## Check for the parenthesis if (($val =~ tr/(//) != ($val =~ tr/)//)) { return 'Missing the closing parenthesis', $length; } ## Add the length of the value plus 2 for the surrounding () $length += length($val) + 2; } if (defined $keywords{$name}) { if ($name eq 'if') { $self->handle_if($val); } elsif ($name eq 'endif') { $errorString = $self->handle_endif($name); } elsif ($name eq 'else') { $errorString = $self->handle_else(); } elsif ($name eq 'endfor') { $errorString = $self->handle_endfor($name); } elsif ($name eq 'foreach') { $errorString = $self->handle_foreach($val); } elsif ($name eq 'fornotlast' || $name eq 'forlast' || $name eq 'fornotfirst' || $name eq 'forfirst') { if (!$self->{'if_skip'}) { $self->handle_special($name, $self->process_special($val)); } } elsif ($name eq 'comment') { ## Ignore the contents of the comment } else { if (!$self->{'if_skip'}) { if (index($val, '(') >= 0) { $self->evaluate_nested_functions($name, $val); } else { my $func = 'handle_' . $name; $self->$func($val); if ($self->{'error_in_handle'}) { $errorString = $self->{'error_in_handle'}; } } } } } elsif (defined $self->{'cmds'}->{$name}) { $self->handle_pseudo($name) if (!$self->{'if_skip'}); } else { if (!$self->{'if_skip'}) { if (defined $val && !defined $self->{'defaults'}->{$name}) { $self->{'defaults'}->{$name} = $self->process_special($val); } $self->append_current($self->get_value_with_default($name)); } } } else { my $error = $line; my $length = length($line); for(my $i = 0; $i < $length; ++$i) { my $part = substr($line, $i, 2); if ($part eq '%>') { $error = substr($line, 0, $i + 2); last; } } $errorString = "Unable to parse line starting at '$error'"; } return $errorString, $length; } sub collect_data { my $self = shift; my $prjc = $self->{'prjc'}; my $cwd = $self->getcwd(); ## Set the current working directory $cwd =~ s/\//\\/g if ($self->{'cslashes'}); $self->{'values'}->{'cwd'} = $cwd; ## Collect the components into {'values'} somehow foreach my $key (keys %{$prjc->{'valid_components'}}) { my @list = $prjc->get_component_list($key); $self->{'values'}->{$key} = \@list if (defined $list[0]); } ## If there is a staticname and no sharedname then this project ## 'type_is_static'. If we are generating static projects, let ## all of the templates know that we 'need_staticflags'. ## If there is a sharedname then this project 'type_is_dynamic'. my $sharedname = $prjc->get_assignment('sharedname'); my $staticname = $prjc->get_assignment('staticname'); if (!defined $sharedname && defined $staticname) { $self->{'override_target_type'} = 1; $self->{'values'}->{'type_is_static'} = 1; $self->{'values'}->{'need_staticflags'} = 1; } elsif ($prjc->get_static() == 1) { $self->{'values'}->{'need_staticflags'} = 1; } elsif (defined $sharedname) { $self->{'values'}->{'type_is_dynamic'} = 1; } ## If there is a sharedname or exename then this project ## 'type_is_binary'. if (defined $sharedname || defined $prjc->get_assignment('exename')) { $self->{'values'}->{'type_is_binary'} = 1; } ## A tiny hack (mainly for VC6 projects) ## for the workspace creator. It needs to know the ## target names to match up with the project name. $prjc->update_project_info($self, 0, ['project_name']); ## This is for all projects $prjc->update_project_info($self, 1, ['after']); ## VC7 Projects need to know the GUID. ## We need to save this value in our known values ## since each guid generated will be different. We need ## this to correspond to the same guid used in the workspace. my $guid = $prjc->update_project_info($self, 1, ['guid']); $self->{'values'}->{'guid'} = $guid; ## In order for VC7 to mix languages, we need to keep track ## of the language associated with each project. $prjc->update_project_info($self, 1, ['language']); ## For VC7+ to properly work with wince, which is cross compiled, ## a new platform-specific token is added, nocross, which is used ## to determine if a project is even to be built for non-native ## targets. Additionally, custom-only projects are built but not ## deployed, thus these are added to the project_info mix $prjc->update_project_info($self, 1, ['custom_only']); $prjc->update_project_info($self, 1, ['nocross']); ## For VC8 to be able to add references to managed DLL's to the current ## managed DLL project (if it is one), we need to keep track of whether ## the project is 'managed' or not. $prjc->update_project_info($self, 1, ['managed']); ## For WiX, only generate top-level groups for projects marked with "make_group" $prjc->update_project_info($self, 1, ['make_group']); ## Some Windows based projects can't deal with certain version ## values. So, for those we provide a translated version. my $version = $prjc->get_assignment('version'); if (defined $version) { $self->{'values'}->{'win_version'} = WinVersionTranslator::translate($version); } } sub parse_line { my($self, $ih, $line) = @_; my $errorString; my $startempty = ($line eq ''); ## If processing a foreach or the line only ## contains a keyword, then we do ## not need to add a newline to the end. if ($self->{'foreach'}->{'processing'} == 0 && !$self->{'eval'} && ($line !~ /$parse_line_re1/ || !defined $keywords{$1})) { $line .= $self->{'crlf'}; } if ($self->{'foreach'}->{'count'} < 0 && !$self->{'eval'}) { $self->{'built'} = ''; } my $start = index($line, '<%'); if ($start >= 0) { my $append_name; if ($start > 0) { if (!$self->{'if_skip'}) { $self->append_current(substr($line, 0, $start)); } $line = substr($line, $start); } my $nlen = 0; foreach my $item (split('<%', $line)) { my $name = 1; my $length = length($item); my $endi = index($item, '%>'); for(my $i = 0; $i < $length; ++$i) { if ($i == $endi) { ++$i; $endi = index($item, '%>', $i); $name = undef; if ($append_name) { $append_name = undef; if (!$self->{'if_skip'}) { $self->append_current('%>'); } } if ($length != $i + 1) { if (!$self->{'if_skip'}) { $self->append_current(substr($item, $i + 1)); } last; } } elsif ($name) { my $efcheck = (index($item, 'endfor%>') == 0); my $focheck = ($efcheck ? 0 : (index($item, 'foreach(') == 0)); if ($focheck && $self->{'foreach'}->{'count'} >= 0) { ++$self->{'foreach'}->{'nested'}; } if ($self->{'foreach'}->{'count'} < 0 || $self->{'foreach'}->{'processing'} > $self->{'foreach'}->{'nested'} || (($efcheck || $focheck) && $self->{'foreach'}->{'nested'} == $self->{'foreach'}->{'processing'})) { ($errorString, $nlen) = $self->process_name($item); if (defined $errorString) { return 0, $errorString; } elsif ($nlen == 0) { return 0, "Could not parse this line at column $i"; } $i += ($nlen - 1); } else { $name = undef; $nlen = ($i < $endi ? $endi : $length) - $i; if (!$self->{'if_skip'}) { $self->append_current('<%' . substr($item, $i, $nlen)); $append_name = 1; } $i += ($nlen - 1); } if ($efcheck && $self->{'foreach'}->{'nested'} > 0) { --$self->{'foreach'}->{'nested'}; } } else { $nlen = ($i < $endi ? $endi : $length) - $i; if (!$self->{'if_skip'}) { $self->append_current(substr($item, $i, $nlen)); } $i += ($nlen - 1); } } } } else { $self->append_current($line) if (!$self->{'if_skip'}); } if ($self->{'foreach'}->{'count'} < 0 && !$self->{'eval'} && ## If the line started out empty and we're not ## skipping from the start or the built up line is not empty ($startempty || ($self->{'built'} ne $self->{'crlf'} && $self->{'built'} ne ''))) { push(@{$self->{'lines'}}, $self->{'built'}); } return !defined $errorString, $errorString; } sub parse_file { my($self, $input) = @_; $self->collect_data(); my($status, $errorString) = $self->cached_file_read($input); ## If there was no error, check the stack to make sure that we aren't ## missing an <%endif%> or an <%endfor%>. if ($status && defined $self->{'sstack'}->[0]) { $status = 0; $errorString = "Missing an '$self->{'sstack'}->[0]' starting at " . $self->{'lstack'}->[0]; } ## Add in the line number if there is an error $errorString = "$input: line " . $self->get_line_number() . ":\n$errorString" if (!$status); return $status, $errorString; } sub get_lines { return $_[0]->{'lines'}; } # ************************************************************ # Accessors used by support scripts # ************************************************************ sub getKeywords { return \%keywords; } sub getArrowOp { return \%arrow_op_ref; } 1;