diff options
Diffstat (limited to 'ACE/MPC/modules')
79 files changed, 19918 insertions, 0 deletions
diff --git a/ACE/MPC/modules/AutomakeProjectCreator.pm b/ACE/MPC/modules/AutomakeProjectCreator.pm new file mode 100644 index 00000000000..2be84c51205 --- /dev/null +++ b/ACE/MPC/modules/AutomakeProjectCreator.pm @@ -0,0 +1,62 @@ +package AutomakeProjectCreator; + +# ************************************************************ +# Description : A Automake Project Creator +# Author : J.T. Conklin & Chad Elliott +# Create Date : 2/26/2003 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use MakeProjectBase; +use ProjectCreator; + +use vars qw(@ISA); +@ISA = qw(MakeProjectBase ProjectCreator); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub escape_spaces { + #my $self = shift; + return 1; +} + + +sub fill_value { + my($self, $name) = @_; + my $value; + + if ($name eq 'am_version') { + $value = $self->get_assignment('version'); + $value .= ':0' if (defined $value && ($value =~ tr/./:/) < 2); + } + + return $value; +} + + +sub project_file_extension { + #my $self = shift; + return '.am'; +} + + +sub get_dll_exe_template_input_file { + #my $self = shift; + return 'automakeexe'; +} + + +sub get_dll_template_input_file { + #my $self = shift; + return 'automakedll'; +} + + +1; diff --git a/ACE/MPC/modules/AutomakeWorkspaceCreator.pm b/ACE/MPC/modules/AutomakeWorkspaceCreator.pm new file mode 100644 index 00000000000..e3cdf9c6048 --- /dev/null +++ b/ACE/MPC/modules/AutomakeWorkspaceCreator.pm @@ -0,0 +1,778 @@ +package AutomakeWorkspaceCreator; + +# ************************************************************ +# Description : A Automake Workspace (Makefile) creator +# Author : J.T. Conklin & Steve Huston +# Create Date : 5/13/2002 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; +use File::Copy; + +use AutomakeProjectCreator; +use WorkspaceCreator; +use WorkspaceHelper; + +use vars qw(@ISA); +@ISA = qw(WorkspaceCreator); + +# ************************************************************ +# Data Section +# ************************************************************ + +my $acfile = 'configure.ac'; +my $acmfile = 'configure.ac.Makefiles'; + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub compare_output { + return 1; +} + + +sub files_are_different { + my($self, $old, $new) = @_; + my $diff = 1; + if (-r $old) { + my $lh = new FileHandle(); + my $rh = new FileHandle(); + if (open($lh, $old)) { + if (open($rh, $new)) { + my $done = 0; + my $lline; + my $rline; + + $diff = 0; + do { + $lline = <$lh>; + $rline = <$rh>; + if (defined $lline) { + if (defined $rline) { + $lline =~ s/#.*//; + $rline =~ s/#.*//; + $diff = 1 if ($lline ne $rline); + } + else { + $done = 1; + } + } + else { + $diff = 1 if (defined $rline); + $done = 1; + } + } while(!$done && !$diff); + close($rh); + } + close($lh); + } + } + return $diff; +} + + +sub workspace_file_name { + return $_[0]->get_modified_workspace_name('Makefile', '.am'); +} + + +sub workspace_per_project { + #my $self = shift; + return 1; +} + + +sub pre_workspace { + my($self, $fh) = @_; + my $crlf = $self->crlf(); + + $self->print_workspace_comment($fh, + '## Process this file with automake to create Makefile.in', $crlf, + '##', $crlf, + '## ', '$', 'Id', '$', $crlf, + '##', $crlf, + '## This file was generated by MPC. Any changes made directly to', $crlf, + '## this file will be lost the next time it is generated.', $crlf, + '##', $crlf, + '## MPC Command:', $crlf, + '## ', $self->create_command_line_string($0, @ARGV), $crlf, $crlf); +} + + +sub write_comps { + my($self, $fh, $creator, $toplevel) = @_; + my $projects = $self->get_projects(); + my @list = $self->sort_dependencies($projects); + my $crlf = $self->crlf(); + my %unique; + my @dirs; + my @locals; + my %proj_dir_seen; + my $have_subdirs = 0; + my $outdir = $self->get_outdir(); + my $cond = '--'; + + ## This step writes a configure.ac.Makefiles list into the starting + ## directory. The list contains of all the Makefiles generated down + ## the tree. configure.ac can include this to get an up-to-date list + ## of all the involved Makefiles. + my $mfh; + my $makefile; + if ($toplevel) { + my $need_acmfile = 1; + if (! -e "$outdir/$acfile") { + my $acfh = new FileHandle(); + if (open($acfh, ">$outdir/$acfile")) { + print $acfh "AC_INIT(", $self->get_workspace_name(), ", 1.0)$crlf", + "AM_INIT_AUTOMAKE([1.9])$crlf", + $crlf, + "AC_PROG_CXX$crlf", + "AC_PROG_CXXCPP$crlf", + "AC_PROG_LIBTOOL$crlf", + $crlf; + + my $fp = $creator->get_feature_parser(); + my $features = $fp->get_names(); + my %assoc = %{$self->get_associated_projects()}; + foreach my $feature (sort @$features) { + print $acfh 'AM_CONDITIONAL(BUILD_', uc($feature), + ', ', ($fp->get_value($feature) ? 'true' : 'false'), + ')', $crlf; + delete $assoc{$feature}; + } + foreach my $akey (keys %assoc) { + print $acfh 'AM_CONDITIONAL(BUILD_', uc($akey), ', true)', $crlf + if ($akey ne $cond); + } + + print $acfh $crlf, + "m4_include([$acmfile])$crlf", + $crlf, + "AC_OUTPUT$crlf"; + close($acfh); + } + } + else { + $self->information("$acfile already exists."); + $need_acmfile = !$self->edit_config_ac("$outdir/$acfile", \@list); + } + + if ($need_acmfile) { + unlink("$outdir/$acmfile"); + $mfh = new FileHandle(); + open($mfh, ">$outdir/$acmfile"); + ## The top-level is never listed as a dependency, so it needs to be + ## added explicitly. + $makefile = $self->mpc_basename($self->get_current_output_name()); + $makefile =~ s/\.am$//; + print $mfh "AC_CONFIG_FILES([ $makefile ])$crlf"; + $proj_dir_seen{'.'} = 1; + } + } + + ## If we're writing a configure.ac.Makefiles file, every seen project + ## goes into it. Since we only write this at the starting directory + ## level, it'll include all projects processed at this level and below. + foreach my $dep (@list) { + if ($mfh) { + ## There should be a Makefile at each level, but it's not a project, + ## it's a workspace; therefore, it's not in the list of projects. + ## Since we're consolidating all the project files into one workspace + ## Makefile.am per directory level, be sure to add that Makefile.am + ## entry at each level there's a project dependency. + my $dep_dir = $self->mpc_dirname($dep); + if (!defined $proj_dir_seen{$dep_dir}) { + $proj_dir_seen{$dep_dir} = 1; + ## If there are directory levels between project-containing + ## directories (for example, at this time in + ## ACE_wrappers/apps/JAWS/server, there are no projects at the + ## apps or apps/JAWS level) we need to insert the Makefile + ## entries for the levels without projects. They won't be listed + ## in @list but are needed for make to traverse intervening directory + ## levels down to where the project(s) to build are. + my @dirs = split /\//, $dep_dir; + my $inter_dir = ""; + foreach my $dep (@dirs) { + $inter_dir .= $dep; + if (!defined $proj_dir_seen{$inter_dir}) { + $proj_dir_seen{$inter_dir} = 1; + print $mfh "AC_CONFIG_FILES([ $inter_dir/$makefile ])$crlf"; + } + $inter_dir .= '/'; + } + print $mfh "AC_CONFIG_FILES([ $dep_dir/$makefile ])$crlf"; + } + } + + ## Get a unique list of next-level directories for SUBDIRS. + ## To make sure we keep the dependencies correct, insert the '.' for + ## any local projects in the proper place. Remember if any subdirs + ## are seen to know if we need a SUBDIRS entry generated. + my $dir = $self->get_first_level_directory($dep); + if (!defined $unique{$dir}) { + $unique{$dir} = 1; + unshift(@dirs, $dir); + } + if ($dir eq '.') { + ## At each directory level, each project is written into a separate + ## Makefile.<project>.am file. To bring these back into the build + ## process, they'll be sucked back into the workspace Makefile.am file. + ## Remember which ones to pull in at this level. + unshift(@locals, $dep); + } + else { + $have_subdirs = 1; + } + } + close($mfh) if ($mfh); + + # The Makefile.<project>.am files append values to build target macros + # for each program/library to build. When using conditionals, however, + # a plain empty assignment is done outside the conditional to be sure + # that each append can be done regardless of the condition test. Because + # automake fails if the first isn't a plain assignment, we need to resolve + # these situations when combining the files. The code below makes sure + # that there's always a plain assignment, whether it's one outside a + # conditional or the first append is changed to a simple assignment. + # + # We should consider extending this to support all macros that match + # automake's uniform naming convention. A true perl wizard probably + # would be able to do this in a single line of code. + + my %seen; + my %conditional_targets; + my %unconditional_targets; + my %first_instance_unconditional; + my $installable_headers; + my $installable_pkgconfig; + my $includedir; + my $project_name; + + ## To avoid unnecessarily emitting blank assignments, rip through the + ## Makefile.<project>.am files and check for conditions. + if (@locals) { + my $pfh = new FileHandle(); + foreach my $local (reverse @locals) { + if ($local =~ /Makefile\.(.*)\.am/) { + $project_name = $1; + } + else { + $project_name = 'nobase'; + } + + if (open($pfh, "$outdir/$local")) { + my $in_condition = 0; + my $regok = $self->escape_regex_special($project_name); + my $inc_pattern = $regok . '_include_HEADERS'; + my $pkg_pattern = $regok . '_pkginclude_HEADERS'; + while (<$pfh>) { + # Don't look at comments + next if (/^#/); + + $in_condition++ if (/^if\s*/); + $in_condition-- if (/^endif\s*/); + + if ( /(^[a-zA-Z][a-zA-Z0-9_]*_(PROGRAMS|LIBRARIES|LTLIBRARIES|LISP|PYTHON|JAVA|SCRIPTS|DATA|SOURCES|HEADERS|MANS|TEXINFOS|LIBADD|LDADD|DEPENDENCIES))\s*\+=\s*/ + || /(^CLEANFILES)\s*\+=\s*/ + || /(^EXTRA_DIST)\s*\+=\s*/ + ) { + + if ($in_condition) { + $conditional_targets{$1}++; + } else { + if (! $seen{$1} ) { + $first_instance_unconditional{$1} = 1; + } + $unconditional_targets{$1}++; + } + $seen{$1} = 1; + + $installable_pkgconfig= 1 if (/^pkgconfig_DATA/); + $installable_headers = 1 + if (/^$inc_pattern\s*\+=\s*/ || /^$pkg_pattern\s*\+=\s*/); + } + elsif (/includedir\s*=\s*(.*)/) { + $includedir = $1; + } + } + + close($pfh); + $in_condition = 0; + } + else { + $self->error("Unable to open $local for reading."); + } + } + } + + # + # Clear seen hash + # + %seen = (); + + ## Print out the Makefile.am. + my $wsHelper = WorkspaceHelper::get($self); + my $convert_header_name; + if ((!defined $includedir && $installable_headers) + || $installable_pkgconfig) { + if (!defined $includedir && $installable_headers) { + my $incdir = $wsHelper->modify_value('includedir', + $self->get_includedir()); + if ($incdir ne '') { + print $fh "includedir = \@includedir\@$incdir$crlf"; + $convert_header_name = 1; + } + } + if ($installable_pkgconfig) { + print $fh "pkgconfigdir = \@libdir\@/pkgconfig$crlf"; + } + + print $fh $crlf; + } + + if (@locals) { + my($status, $error) = $wsHelper->write_settings($self, $fh, @locals); + if (!$status) { + $self->error($error); + } + } + + ## Create the SUBDIRS setting. If there are associated projects, then + ## we will also set up conditionals for it as well. + if ($have_subdirs == 1) { + my $assoc = $self->get_associated_projects(); + my @aorder; + my %afiles; + my $entry = " \\$crlf "; + print $fh 'SUBDIRS ='; + foreach my $dir (reverse @dirs) { + my $found; + foreach my $akey (keys %$assoc) { + if (defined $$assoc{$akey}->{$dir}) { + if ($akey eq $cond) { + if ($toplevel) { + print $fh $entry, '@', $dir, '@'; + $found = 1; + } + } + else { + push(@aorder, $akey); + push(@{$afiles{$akey}}, $dir); + $found = 1; + } + last; + } + elsif ($toplevel && defined $$assoc{$akey}->{uc($dir)} && + $akey eq $cond) { + print $fh $entry, '@', uc($dir), '@'; + $found = 1; + last; + } + } + print $fh $entry, $dir if (!$found); + } + print $fh $crlf; + my $second = 1; + foreach my $aorder (@aorder) { + if (defined $afiles{$aorder}) { + $second = undef; + print $fh $crlf, + 'if BUILD_', uc($aorder), "\n", + 'SUBDIRS +='; + foreach my $afile (@{$afiles{$aorder}}) { + print $fh " $afile"; + } + delete $afiles{$aorder}; + print $fh $crlf, 'endif', $crlf; + } + } + print $fh $crlf if ($second); + } + + ## Now, for each target used in a conditional, emit a blank assignment + ## and mark that we've seen that target to avoid changing the += to = + ## as the individual files are pulled in. + if (%conditional_targets) { + my $primary; + my $count; + + while ( ($primary, $count) = each %conditional_targets) { + if (! $first_instance_unconditional{$primary} + && ($unconditional_targets{$primary} || ($count > 1))) + { + print $fh "$primary =$crlf"; + $seen{$primary} = 1; + } + } + + print $fh $crlf; + } + + ## Take the local Makefile.<project>.am files and insert each one here, + ## then delete it. + if (@locals) { + my $pfh = new FileHandle(); + my $liblocs = $self->get_lib_locations(); + my $here = $self->getcwd(); + my $start = $self->getstartdir(); + my %explicit; + foreach my $local (reverse @locals) { + if (open($pfh, "$outdir/$local")) { + print $fh "## $local", $crlf; + + my $look_for_libs = 0; + my $prev_line; + my $in_explicit; + + while (<$pfh>) { + # Don't emit comments + next if (/^#/); + + # Check for explicit targets + if ($in_explicit) { + if (/^\t/) { + next; + } + else { + $in_explicit = undef; + } + } + elsif (/^([\w\/\.\-\s]+):/) { + my $target = $1; + $target =~ s/^\s+//; + $target =~ s/\s+$//; + if (defined $explicit{$target}) { + $in_explicit = 1; + next; + } + else { + $explicit{$target} = 1; + } + } + + if ($convert_header_name) { + if ($local =~ /Makefile\.(.*)\.am/) { + $project_name = $1; + } + else { + $project_name = 'nobase'; + } + my $regok = $self->escape_regex_special($project_name); + my $inc_pattern = $regok . '_include_HEADERS'; + my $pkg_pattern = $regok . '_pkginclude_HEADERS'; + if (/^$inc_pattern\s*\+=\s*/ || /^$pkg_pattern\s*\+=\s*/) { + $_ =~ s/^$regok/nobase/; + } + } + + if ( /(^[a-zA-Z][a-zA-Z0-9_]*_(PROGRAMS|LIBRARIES|LTLIBRARIES|LISP|PYTHON|JAVA|SCRIPTS|DATA|SOURCES|HEADERS|MANS|TEXINFOS|LIBADD|LDADD|DEPENDENCIES))\s*\+=\s*/ + || /(^CLEANFILES)\s*\+=\s*/ + || /(^EXTRA_DIST)\s*\+=\s*/ + ) { + if (!defined ($seen{$1})) { + $seen{$1} = 1; + s/\+=/=/; + } + } + + ## This scheme relies on automake.mpd emitting the 'la' libs first. + ## Look for all the libXXXX.la, find out where they are located + ## relative to the start of the MPC run, and relocate the reference + ## to that location under $top_builddir. Unless the referred-to + ## library is in the current directory, then leave it undecorated + ## so the automake-generated dependency orders the build correctly. + if ($look_for_libs) { + my @libs = /\s+(lib(\w+).la)/gm; + my $libcount = @libs / 2; + for(my $i = 0; $i < $libcount; ++$i) { + my $libfile = $libs[$i * 2]; + my $libname = $libs[$i * 2 + 1]; + my $reldir = $$liblocs{$libname}; + + ## If we could not find a relative directory for this + ## library, it may be that it is a decorated library name. + ## We will search for an approximate match. + if (!defined $reldir) { + my $tmpname = $libname; + while($tmpname ne '') { + $tmpname = substr($tmpname, 0, length($tmpname) - 1); + if (defined $$liblocs{$tmpname}) { + $reldir = $$liblocs{$tmpname}; + $self->warning("Relative directory for $libname " . + "was approximated with $tmpname."); + last; + } + } + } + + if (defined $reldir) { + my $append = ($reldir eq '' ? '' : "/$reldir"); + if ("$start$append" ne $here) { + my $mod = $wsHelper->modify_libpath($_, $reldir, $libfile); + if (defined $mod) { + $_ = $mod; + } + else { + s/$libfile/\$(top_builddir)$append\/$libfile/; + } + } + } + else { + my $mod = $wsHelper->modify_libpath($_, $reldir, $libfile); + if (defined $mod) { + $_ = $mod; + } + else { + $self->warning("No reldir found for $libname ($libfile)."); + } + } + } + $look_for_libs = 0 if ($libcount == 0); + } + $look_for_libs = 1 if (/_LDADD = \\$/ || /_LIBADD = \\$/); + + ## I have introduced a one line delay so that I can simplify + ## the automake template. If our current line is empty, then + ## we will remove the trailing backslash before printing the + ## previous line. Automake is horribly unforgiving so we must + ## avoid this situation at all cost. + if (defined $prev_line) { + $prev_line =~ s/\s*\\$// if ($_ =~ /^\s*$/); + print $fh $prev_line; + } + $prev_line = $_; + } + ## The one line delay requires that we print out the previous + ## line (if there was one) when we reach the end of the file. + if (defined $prev_line) { + $prev_line =~ s/\s*\\$//; + print $fh $prev_line; + } + + close($pfh); + unlink("$outdir/$local"); + print $fh $crlf; + } + else { + $self->error("Unable to open $local for reading."); + } + } + } + + ## If this is the top-level Makefile.am, it needs the directives to pass + ## autoconf/automake flags down the tree when running autoconf. + ## *** This may be too closely tied to how we have things set up in ACE, + ## even though it's recommended practice. *** + if ($toplevel) { + my $m4inc = '-I m4'; + print $fh $crlf, + 'ACLOCAL = @ACLOCAL@', $crlf, + 'ACLOCAL_AMFLAGS = ', + (defined $wsHelper ? + $wsHelper->modify_value('amflags', $m4inc) : $m4inc), $crlf, + 'AUTOMAKE_OPTIONS = foreign', $crlf, $crlf, + (defined $wsHelper ? + $wsHelper->modify_value('extra', '') : ''); + } + + ## Finish up with the cleanup specs. + if (@locals) { + ## There is no reason to emit this if there are no local targets. + ## An argument could be made that it shouldn't be emitted in any + ## case because it could be handled by CLEANFILES or a verbatim + ## clause. + + print $fh '## Clean up template repositories, etc.', $crlf, + 'clean-local:', $crlf, + "\t-rm -f *~ *.bak *.rpo *.sym lib*.*_pure_* core core.*", + $crlf, + "\t-rm -f gcctemp.c gcctemp so_locations *.ics", $crlf, + "\t-rm -rf cxx_repository ptrepository ti_files", $crlf, + "\t-rm -rf templateregistry ir.out", $crlf, + "\t-rm -rf ptrepository SunWS_cache Templates.DB", $crlf; + } +} + + +sub get_includedir { + my $self = shift; + my $value = $self->getcwd(); + my $start = $self->getstartdir(); + + ## Take off the starting directory + $value =~ s/\Q$start\E//; + return $value; +} + + +sub edit_config_ac { + my($self, $file, $files) = @_; + my $fh = new FileHandle(); + my $status = 0; + + if (open($fh, $file)) { + my $crlf = $self->crlf(); + my @in; + my @lines; + my $assoc = $self->get_associated_projects(); + my $indent = ''; + my %proj_dir_seen; + my $in_config_files = 0; + + while(<$fh>) { + my $line = $_; + push(@lines, $line); + + ## Remove comments and trailing space + $line =~ s/\bdnl\s+.*//; + $line =~ s/\s+$//; + + if ($line eq '') { + } + elsif ($line =~ /^\s*if\s+test\s+["]?([^"]+)["]?\s*=\s*\w+;\s*then/) { + ## Entering an if test, save the name + my $name = $1; + $name =~ s/\s+$//; + $name =~ s/.*_build_//; + push(@in, $name); + } + elsif ($line =~ /^\s*if\s+test\s+-d\s+(.+);\s*then/) { + ## Entering an if test -d, save the name + my $name = $1; + $name =~ s/\s+$//; + $name =~ s/\$srcdir\///; + push(@in, $name); + } + elsif ($line =~ /^\s*fi$/) { + pop(@in); + } + elsif ($line =~ /^(\s*AC_CONFIG_FILES\s*\(\s*\[)/) { + ## Entering an AC_CONFIG_FILES section, start ignoring the entries + pop(@lines); + push(@lines, "$1\n"); + $indent = ' '; + if ($lines[$#lines] =~ /^(\s+)/) { + $indent .= $1; + } + $in_config_files = 1; + } + elsif ($in_config_files) { + if ($line =~ /(.*)\]\s*\).*/) { + ## We've reached the end of the AC_CONFIG_FILES section + my $olast = pop(@lines); + if ($olast =~ /^[^\s]+(\s*\]\s*\).*)/) { + $olast = $1; + } + ## Add in the Makefiles for this configuration + if ($#in < 0 && !defined $proj_dir_seen{'.'}) { + push(@lines, $indent . 'Makefile' . $crlf); + $proj_dir_seen{'.'} = 1; + } + + foreach my $dep (@$files) { + ## First things first, see if we've already seen this + ## project's directory. If we have, then there's nothing + ## else we need to do with it. + my $dep_dir = $self->mpc_dirname($dep); + if (!defined $proj_dir_seen{$dep_dir}) { + my $ok = 1; + my @dirs = split(/\//, $dep_dir); + my $base = $dep; + + if ($base =~ s/\/.*//) { + my $found = 0; + foreach my $akey (keys %$assoc) { + if (defined $$assoc{$akey}->{$base} || + defined $$assoc{$akey}->{uc($base)}) { + if ($#in >= 0) { + if (index($base, $in[0]) >= 0) { + if ($#in >= 1) { + $found = 1; + for(my $i = 0; $i <= $#in; $i++) { + if (!defined $dirs[$i] || + index($dirs[$i], $in[$i]) < 0) { + $found = 0; + last; + } + } + } + else { + ## We need to see into the future here. :-) + ## If the second element of @dirs matches an + ## association key, we'll guess that there will + ## be a "build" section devoted to it. + if (!defined $dirs[1] || + !defined $$assoc{$dirs[1]}) { + $found = 1; + } + } + } + } + else { + $found = 1; + } + last; + } + } + if ($#in >= 0) { + $ok = $found; + } + else { + $ok = !$found; + } + } + + if ($ok) { + $proj_dir_seen{$dep_dir} = 1; + my $inter_dir = ''; + foreach my $dep (@dirs) { + $inter_dir .= $dep; + if (!defined $proj_dir_seen{$inter_dir}) { + $proj_dir_seen{$inter_dir} = 1; + push(@lines, $indent . $inter_dir . "/Makefile$crlf"); + } + $inter_dir .= '/'; + } + push(@lines, $indent . $dep_dir . "/Makefile$crlf"); + } + } + } + push(@lines, $olast); + $in_config_files = 0; + } + else { + ## Ignore the entry + pop(@lines); + } + } + } + close($fh); + + ## Make a backup and create the new file + my $backup = $file . '.bak'; + if (copy($file, $backup)) { + my @buf = stat($file); + if (defined $buf[8] && defined $buf[9]) { + utime($buf[8], $buf[9], $backup); + } + if (open($fh, ">$file")) { + foreach my $line (@lines) { + print $fh $line; + } + close($fh); + $status = 1; + } + } + else { + $self->warning("Unable to create backup file: $backup"); + } + } + return $status; +} + +1; diff --git a/ACE/MPC/modules/BCB2007ProjectCreator.pm b/ACE/MPC/modules/BCB2007ProjectCreator.pm new file mode 100644 index 00000000000..298a09a9a6e --- /dev/null +++ b/ACE/MPC/modules/BCB2007ProjectCreator.pm @@ -0,0 +1,50 @@ +package BCB2007ProjectCreator; + +# ************************************************************ +# Description : The Borland C++ Builder 2007 Project Creator +# Author : Johnny Willemsen +# Create Date : 14/12/2005 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use ProjectCreator; +use BorlandProjectBase; +use XMLProjectBase; + +use vars qw(@ISA); +@ISA = qw(XMLProjectBase BorlandProjectBase ProjectCreator); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub crlf { + #my $self = shift; + return "\n"; +} + + +sub project_file_extension { + #my $self = shift; + return '.cbproj'; +} + + +sub get_dll_exe_template_input_file { + #my $self = shift; + return 'bcb2007exe'; +} + + +sub get_dll_template_input_file { + #my $self = shift; + return 'bcb2007dll'; +} + + +1; diff --git a/ACE/MPC/modules/BCB2007WorkspaceCreator.pm b/ACE/MPC/modules/BCB2007WorkspaceCreator.pm new file mode 100644 index 00000000000..50a31cf7d89 --- /dev/null +++ b/ACE/MPC/modules/BCB2007WorkspaceCreator.pm @@ -0,0 +1,123 @@ +package BCB2007WorkspaceCreator; + +# ************************************************************ +# Description : A BCB2007 Workspace Creator +# Author : Johnny Willemsen +# Create Date : 14/12/2005 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use BCB2007ProjectCreator; +use WinWorkspaceBase; +use WorkspaceCreator; + +use vars qw(@ISA); +@ISA = qw(WinWorkspaceBase WorkspaceCreator); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub crlf { + #my $self = shift; + return "\n"; +} + + +sub compare_output { + #my $self = shift; + return 1; +} + + +sub workspace_file_extension { + #my $self = shift; + return '.groupproj'; +} + + +sub pre_workspace { + my($self, $fh) = @_; + my $crlf = $self->crlf(); + + ## This identifies it as a Borland C++Builder 2007 file + print $fh '<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">', $crlf; + + ## Optionally print the workspace comment +# $self->print_workspace_comment($fh, +# '<!-- $Id$ -->', $crlf, +# '<!-- MPC Command -->', $crlf, +# '<!-- ', $self->create_command_line_string($0, @ARGV), ' -->', +# $crlf); +} + + +sub write_comps { + my($self, $fh) = @_; + my $crlf = $self->crlf(); + my $project_info = $self->get_project_info(); + my @projects = $self->sort_dependencies($self->get_projects(), 0); + + ## Print GUID and personality information + print $fh ' <PropertyGroup>', $crlf, + ' <ProjectGuid>{1946f85e-487f-46b6-8e41-159cd446db35}</ProjectGuid>', $crlf, + ' </PropertyGroup>', $crlf, + ' <ItemGroup />', $crlf, + ' <ItemGroup />', $crlf, + ' <ProjectExtensions>', $crlf, + ' <Borland.Personality>Default.Personality</Borland.Personality>', $crlf, + ' <Borland.ProjectType />', $crlf, + ' <BorlandProject>', $crlf, + ' <BorlandProject xmlns=""> <Default.Personality> </Default.Personality> </BorlandProject></BorlandProject>', $crlf, + ' </ProjectExtensions>', $crlf; + + ## Print the project targets + foreach my $project (@projects) { + my $name = $$project_info{$project}->[0]; + print $fh ' <Target Name="', $name, '">', $crlf, + ' <MSBuild Projects="', $self->mpc_basename($project), '" Targets="" />', $crlf, + ' </Target>', $crlf, + ' <Target Name="', $name, ':Make">', $crlf, + ' <MSBuild Projects="', $self->mpc_basename($project), '" Targets="Make" />', $crlf, + ' </Target>', $crlf, + ' <Target Name="', $name, ':Clean">', $crlf, + ' <MSBuild Projects="', $self->mpc_basename($project), '" Targets="Clean" />', $crlf, + ' </Target>', $crlf; + } + + ## Print the target build order + print $fh ' <Target Name="Build">', $crlf, + ' <CallTarget Targets="'; + foreach my $project (@projects) { + print $fh $$project_info{$project}->[0], ';'; + } + + ## Print the target make order + print $fh '" />', $crlf, + ' </Target>', $crlf, + ' <Target Name="Make">', $crlf, + ' <CallTarget Targets="'; + foreach my $project (@projects) { + print $fh $$project_info{$project}->[0], ':Make;'; + } + + ## Print the target clean order + print $fh '" />', $crlf, + ' </Target>', $crlf, + ' <Target Name="Clean">', $crlf, + ' <CallTarget Targets="'; + foreach my $project (@projects) { + print $fh $$project_info{$project}->[0], ':Clean;'; + } + print $fh '" />', $crlf, + ' </Target>', $crlf, + '</Project>', $crlf; +} + + +1; diff --git a/ACE/MPC/modules/BCB2009ProjectCreator.pm b/ACE/MPC/modules/BCB2009ProjectCreator.pm new file mode 100644 index 00000000000..ee2970d26bb --- /dev/null +++ b/ACE/MPC/modules/BCB2009ProjectCreator.pm @@ -0,0 +1,36 @@ +package BCB2009ProjectCreator; + +# ************************************************************ +# Description : The Borland C++ Builder 2009 Project Creator +# Author : Johnny Willemsen +# Create Date : 17/10/2008 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use BCB2007ProjectCreator; + +use vars qw(@ISA); +@ISA = qw(BCB2007ProjectCreator); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub get_dll_exe_template_input_file { + #my $self = shift; + return 'bcb2009exe'; +} + + +sub get_dll_template_input_file { + #my $self = shift; + return 'bcb2009dll'; +} + + +1; diff --git a/ACE/MPC/modules/BCB2009WorkspaceCreator.pm b/ACE/MPC/modules/BCB2009WorkspaceCreator.pm new file mode 100644 index 00000000000..2c6c69d805c --- /dev/null +++ b/ACE/MPC/modules/BCB2009WorkspaceCreator.pm @@ -0,0 +1,36 @@ +package BCB2009WorkspaceCreator; + +# ************************************************************ +# Description : A BCB2009 Workspace Creator +# Author : Johnny Willemsen +# Create Date : 17/10/2008 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use BCB2007WorkspaceCreator; +use BCB2009ProjectCreator; + +use vars qw(@ISA); +@ISA = qw(BCB2007WorkspaceCreator); + +sub pre_workspace { + my($self, $fh) = @_; + my $crlf = $self->crlf(); + + ## This identifies it as a Borland C++Builder 2009 file + print $fh '<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">', $crlf; + + ## Optionally print the workspace comment +# $self->print_workspace_comment($fh, +# '<!-- $Id$ -->', $crlf, +# '<!-- MPC Command -->', $crlf, +# '<!-- ', $self->create_command_line_string($0, @ARGV), ' -->', +# $crlf); +} + +1; diff --git a/ACE/MPC/modules/BDS4ProjectCreator.pm b/ACE/MPC/modules/BDS4ProjectCreator.pm new file mode 100644 index 00000000000..a3fea2f90ad --- /dev/null +++ b/ACE/MPC/modules/BDS4ProjectCreator.pm @@ -0,0 +1,50 @@ +package BDS4ProjectCreator; + +# ************************************************************ +# Description : The Borland Developer Studio 4 Project Creator +# Author : Johnny Willemsen +# Create Date : 14/12/2005 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use ProjectCreator; +use BorlandProjectBase; +use XMLProjectBase; + +use vars qw(@ISA); +@ISA = qw(XMLProjectBase BorlandProjectBase ProjectCreator); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub crlf { + #my $self = shift; + return "\n"; +} + + +sub project_file_extension { + #my $self = shift; + return '.bdsproj'; +} + + +sub get_dll_exe_template_input_file { + #my $self = shift; + return 'bds4exe'; +} + + +sub get_dll_template_input_file { + #my $self = shift; + return 'bds4dll'; +} + + +1; diff --git a/ACE/MPC/modules/BDS4WorkspaceCreator.pm b/ACE/MPC/modules/BDS4WorkspaceCreator.pm new file mode 100644 index 00000000000..b4ce3d4dca5 --- /dev/null +++ b/ACE/MPC/modules/BDS4WorkspaceCreator.pm @@ -0,0 +1,89 @@ +package BDS4WorkspaceCreator; + +# ************************************************************ +# Description : A BDS 4 Workspace Creator +# Author : Johnny Willemsen +# Create Date : 14/12/2005 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use BDS4ProjectCreator; +use WinWorkspaceBase; +use WorkspaceCreator; + +use vars qw(@ISA); +@ISA = qw(WinWorkspaceBase WorkspaceCreator); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub crlf { + #my $self = shift; + return "\n"; +} + + +sub compare_output { + #my $self = shift; + return 1; +} + + +sub workspace_file_extension { + #my $self = shift; + return '.bdsgroup'; +} + + +sub pre_workspace { + my($self, $fh) = @_; + my $crlf = $self->crlf(); + + ## This identifies it as a Borland Developer Studio 2006 file + print $fh '<?xml version="1.0" encoding="utf-8"?>', $crlf; + + ## Optionally print the workspace comment + $self->print_workspace_comment($fh, + '<!-- $Id$ -->', $crlf, + '<!-- MPC Command -->', $crlf, + '<!-- ', $self->create_command_line_string($0, @ARGV), ' -->', + $crlf); +} + + +sub write_comps { + my($self, $fh) = @_; + my $crlf = $self->crlf(); + + ## Print out the guid and the personality information + print $fh '<BorlandProject>', $crlf, + ' <PersonalityInfo>', $crlf, + ' <Option>', $crlf, + ' <Option Name="Personality">Default.Personality</Option>', $crlf, + ' <Option Name="ProjectType"></Option>', $crlf, + ' <Option Name="Version">1.0</Option>', $crlf, + ' <Option Name="GUID">{93D77FAD-C603-4FB1-95AB-34E0B6FBF615}</Option>', $crlf, + ' </Option>', $crlf, + ' </PersonalityInfo>', $crlf, + ' <Default.Personality>', $crlf, + ' <Projects>', $crlf; + + ## Print out the projects in the correct build order + foreach my $project ($self->sort_dependencies($self->get_projects(), 0)) { + print $fh ' <Projects Name="$project">$project</Projects>', $crlf; + } + + print $fh ' </Projects>', $crlf, + ' <Dependencies/>', $crlf, + ' </Default.Personality>', $crlf, + '</BorlandProject>', $crlf; +} + + +1; diff --git a/ACE/MPC/modules/BMakeProjectCreator.pm b/ACE/MPC/modules/BMakeProjectCreator.pm new file mode 100644 index 00000000000..6ef1e7f1ffc --- /dev/null +++ b/ACE/MPC/modules/BMakeProjectCreator.pm @@ -0,0 +1,111 @@ +package BMakeProjectCreator; + +# ************************************************************ +# Description : A BMake Project Creator +# Author : Chad Elliott +# Create Date : 2/03/2004 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use ProjectCreator; +use BorlandProjectBase; +use MakeProjectBase; + +use vars qw(@ISA); +@ISA = qw(MakeProjectBase BorlandProjectBase ProjectCreator); + +# ************************************************************ +# Data Section +# ************************************************************ + +my %names = ('cppdir' => 'source_files', + 'rcdir' => 'resource_files'); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub fill_value { + my($self, $name) = @_; + + if (defined $names{$name}) { + my %dirnames = ('.' => 1); + foreach my $file ($self->get_component_list($names{$name}, 1)) { + my $dirname = $self->mpc_dirname($file); + if ($dirname eq '') { + $dirname = '.'; + } + else { + $dirname =~ s/\//\\/g; + } + $dirnames{$dirname} = 1; + } + + ## Sort the directories to ensure that '.' comes first + return join(';', sort keys %dirnames); + } + + return undef; +} + + +sub get_and_symbol { + #my $self = shift; + return '&$(__TRICK_BORLAND_MAKE__)&'; +} + +sub project_file_extension { + #my $self = shift; + return '.bmak'; +} + + +sub get_dll_exe_template_input_file { + #my $self = shift; + return 'bmakedllexe'; +} + + +sub get_lib_exe_template_input_file { + #my $self = shift; + return 'bmakelibexe'; +} + + +sub get_lib_template_input_file { + #my $self = shift; + return 'bmakelib'; +} + + +sub get_dll_template_input_file { + #my $self = shift; + return 'bmakedll'; +} + + +sub get_properties { + my $self = shift; + + ## Create the map of properties that we support. + my $props = {}; + + ## Merge in properties from all base projects + foreach my $base (@ISA) { + my $func = $base . '::get_properties'; + my $p = $self->$func(); + foreach my $key (keys %$p) { + $$props{$key} = $$p{$key}; + } + } + + return $props; +} + + +1; diff --git a/ACE/MPC/modules/BMakeWorkspaceCreator.pm b/ACE/MPC/modules/BMakeWorkspaceCreator.pm new file mode 100644 index 00000000000..b5b67602b10 --- /dev/null +++ b/ACE/MPC/modules/BMakeWorkspaceCreator.pm @@ -0,0 +1,99 @@ +package BMakeWorkspaceCreator; + +# ************************************************************ +# Description : A Borland Make Workspace (Makefile) creator +# Author : Chad Elliott +# Create Date : 2/03/2004 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use BMakeProjectCreator; +use MakeWorkspaceBase; +use WinWorkspaceBase; +use WorkspaceCreator; + +use vars qw(@ISA); +@ISA = qw(MakeWorkspaceBase WinWorkspaceBase WorkspaceCreator); + +# ************************************************************ +# Data Section +# ************************************************************ + +## Borland Make's maximum line length +my $max_line_length = 32767; +my $targets = 'clean generated realclean $(CUSTOM_TARGETS)'; + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub workspace_file_extension { + #my $self = shift; + return '.bmak'; +} + + +sub workspace_file_name { + my $self = shift; + return $self->get_modified_workspace_name('Makefile', '.bmak'); +} + + +sub pre_workspace { + my($self, $fh) = @_; + $self->workspace_preamble($fh, $self->crlf(), + 'Borland Workspace Makefile', + '$Id$'); +} + + +sub write_project_targets { + my($self, $fh, $crlf, $target, $list, $and) = @_; + my $cwd = $self->getcwd(); + + ## Print out a make command for each project + foreach my $project (@$list) { + my $dir = $self->mpc_dirname($project); + $dir =~ s/\//\\/g; + my $chdir = ($dir ne '.'); + + print $fh "\t", ($chdir ? "\$(COMSPEC) /c \"cd $dir $and " : ''), + "\$(MAKE) -\$(MAKEFLAGS) -f ", + $self->mpc_basename($project), " $target", + ($chdir ? '"' : ''), $crlf; + } +} + + +sub write_comps { + my($self, $fh, $creator) = @_; + my %targnum; + my $pjs = $self->get_project_info(); + my @list = $self->number_target_deps($self->get_projects(), $pjs, + \%targnum, 0); + my $crlf = $self->crlf(); + + ## Set up the custom targets + print $fh '!ifndef CUSTOM_TARGETS', $crlf, + 'CUSTOM_TARGETS=_EMPTY_TARGET_', $crlf, + '!endif', $crlf; + + ## Translate each project name + my %trans; + foreach my $project (@list) { + $trans{$project} = $$pjs{$project}->[0]; + } + + ## Send all the information to our base class method + $self->write_named_targets($fh, $crlf, \%targnum, \@list, + $targets, '', '', \%trans, undef, + $creator->get_and_symbol(), $max_line_length); +} + + +1; diff --git a/ACE/MPC/modules/BorlandProjectBase.pm b/ACE/MPC/modules/BorlandProjectBase.pm new file mode 100644 index 00000000000..396e24ef416 --- /dev/null +++ b/ACE/MPC/modules/BorlandProjectBase.pm @@ -0,0 +1,36 @@ +package BorlandProjectBase; + +# ************************************************************ +# Description : A Borland base module for Borland Project Creators +# Author : Chad Elliott +# Create Date : 5/5/2009 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; +use WinProjectBase; + +our @ISA = qw(WinProjectBase); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub get_properties { + my $self = shift; + + ## Get the base class properties and add the properties that we + ## support. + my $props = $self->WinProjectBase::get_properties(); + + ## All projects that use this base class are for Borland compilers. + $$props{'borland'} = 1; + + return $props; +} + + +1; diff --git a/ACE/MPC/modules/CCProjectCreator.pm b/ACE/MPC/modules/CCProjectCreator.pm new file mode 100644 index 00000000000..f154ca46187 --- /dev/null +++ b/ACE/MPC/modules/CCProjectCreator.pm @@ -0,0 +1,62 @@ +package CCProjectCreator; + +# ************************************************************ +# Description : A Code Composer Project Creator +# Author : Chad Elliott +# Create Date : 9/18/2006 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use ProjectCreator; +use WinProjectBase; + +use vars qw(@ISA); +@ISA = qw(WinProjectBase ProjectCreator); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub compare_output { + #my $self = shift; + return 1; +} + + +sub override_valid_component_extensions { + my $self = shift; + my $comp = shift; + my @array = @_; + + if ($comp eq 'source_files' && $self->languageIs(Creator::cplusplus)) { + push(@array, "\\.cdb"); + } + + return \@array; +} + + +sub project_file_extension { + #my $self = shift; + return '.pjt'; +} + + +sub get_dll_exe_template_input_file { + #my $self = shift; + return 'ccexe'; +} + + +sub get_dll_template_input_file { + #my $self = shift; + return 'cclib'; +} + + +1; diff --git a/ACE/MPC/modules/CCWorkspaceCreator.pm b/ACE/MPC/modules/CCWorkspaceCreator.pm new file mode 100644 index 00000000000..5cb7bf7200d --- /dev/null +++ b/ACE/MPC/modules/CCWorkspaceCreator.pm @@ -0,0 +1,117 @@ +package CCWorkspaceCreator; + +# ************************************************************ +# Description : A Code Composer Workspace creator +# Author : Chad Elliott +# Create Date : 9/18/2006 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use CCProjectCreator; +use WinWorkspaceBase; +use WorkspaceCreator; + +use vars qw(@ISA); +@ISA = qw(WinWorkspaceBase WorkspaceCreator); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub compare_output { + #my $self = shift; + return 1; +} + + +sub workspace_file_extension { + #my $self = shift; + return '.code_composer'; +} + + +sub write_comps { + my($self, $fh, $creator) = @_; + my $crlf = $self->crlf(); + + ## Workspace only consists of the name of the project. Really, Code + ## Composer doesn't use a workspace. Each project contains the + ## dependencies. + foreach my $project ($self->sort_dependencies($self->get_projects(), 0)) { + print $fh "$project$crlf"; + $self->add_dependencies($creator, $project); + } +} + + +sub add_dependencies { + my($self, $creator, $proj) = @_; + my $fh = new FileHandle(); + my $outdir = $self->get_outdir(); + $outdir = $self->getcwd() if ($outdir eq '.'); + + if (open($fh, "$outdir/$proj")) { + my @read; + my $write; + my $cwd = $self->getcwd(); + while(<$fh>) { + ## This is a comment found in cc.mpd if the project contains the + ## 'after' keyword setting. + if (/MPC\s+ADD\s+DEPENDENCIES/) { + my @projs; + my $crlf = $self->crlf(); + my $deps = $self->get_validated_ordering($proj); + foreach my $dep (@$deps) { + my $relative = $self->get_relative_dep_file($creator, + "$cwd/$proj", $dep); + if (defined $relative) { + if (!$write) { + ## Indicate that we need to re-write the file and add in + ## the start of the project dependencies section + $write = 1; + push(@read, "[Project Dependencies]$crlf"); + } + + ## Add in the dependency and save the project name for later. + push(@read, "Source=\"$relative\"$crlf"); + push(@projs, $relative); + } + } + if ($write) { + ## Finish off the dependency information for the current + ## project. + push(@read, $crlf); + foreach my $proj (@projs) { + push(@read, "[\"$proj\" Settings]$crlf", + "MatchConfigName=true$crlf", $crlf); + } + } + else { + ## We don't need to re-write the file, so we can stop reading + ## it. + last; + } + } + else { + ## Save the line to possibly be written out at the end. + push(@read, $_); + } + } + close($fh); + + ## If we need to re-write the file, then do so + if ($write && open($fh, ">$outdir/$proj")) { + foreach my $line (@read) { + print $fh $line; + } + close($fh); + } + } +} + +1; diff --git a/ACE/MPC/modules/CommandHelper.pm b/ACE/MPC/modules/CommandHelper.pm new file mode 100644 index 00000000000..f632944ab8d --- /dev/null +++ b/ACE/MPC/modules/CommandHelper.pm @@ -0,0 +1,96 @@ +package CommandHelper; + +# ************************************************************ +# Description : Base class and factory for all command helpers. +# +# The get() method converts the define custom type +# provided to uppercase, removes the '_FILES' portion and +# adds 'Helper' to the end. If a module is found matching +# that name, it will be used to assist the ProjectCreator +# in determining which output files will be generated by +# the command given the file name and command options. +# +# Author : Chad Elliott +# Create Date : 6/30/2008 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; +use File::Basename; + +# ************************************************************ +# Data Section +# ************************************************************ + +my %required; +my %notfound; + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub get { + ## Create the helper name + my $type = uc(shift); + $type =~ s/_FILES$/Helper/; + + ## Don't search the filesystem again if we didn't find one the first + ## time we looked. + return undef if ($notfound{$type}); + + ## Return the helper if we've already created one + return $required{$type} if (defined $required{$type}); + + ## Assist users in figuring out why their helper isn't being picked up. + OutputMessage::debug(undef, "Searching @INC for $type.pm"); + + ## If we can find a helper with this name, we will + ## create a singleton of that type and return it. + foreach my $inc (@INC) { + if (-r "$inc/$type.pm") { + require "$type.pm"; + $required{$type} = $type->new(); + return $required{$type}; + } + } + + ## We didn't find a helper. Keep track of that fact and return undef. + $notfound{$type} = 1; + return undef; +} + +sub new { + my $class = shift; + return bless {}, $class; +} + +sub get_output { + ## This method is called with the filename and command options and + ## expects an array reference containing filenames that will be + ## generated, but can not be described using the normal Define_Custom + ## syntax. + return []; +} + +sub get_outputexts { + ## This method is expected to return an array reference containing the + ## extensions for files returned by the get_output() method. They will + ## be used as regular expressions so regular expression characters + ## (such as '.', '[', ']', etc.) must be escaped. + return []; +} + +sub get_tied { + ## This method is called with a file name and an array reference of + ## files. The first expected return value is an array reference of those + ## files listed in the passed array reference that are in some way tied + ## to the file name passed in. The second is a component name to help + ## MPC figure out a way to tie the files together. The result of "tied" + ## files is that they may be compiled after the file name passed in. + return [], undef; +} + +1; diff --git a/ACE/MPC/modules/ConfigParser.pm b/ACE/MPC/modules/ConfigParser.pm new file mode 100644 index 00000000000..ae90bb35104 --- /dev/null +++ b/ACE/MPC/modules/ConfigParser.pm @@ -0,0 +1,129 @@ +package ConfigParser; + +# ************************************************************ +# Description : Reads a generic config file and store the values +# Author : Chad Elliott +# Create Date : 6/12/2006 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use Parser; + +use vars qw(@ISA); +@ISA = qw(Parser); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub new { + my($class, $valid) = @_; + my $self = $class->SUPER::new(); + + ## Set up the internal data members + $self->{'values'} = {}; + $self->{'clean'} = {}; + $self->{'valid'} = $valid; + $self->{'warned'} = {}; + + return $self; +} + + +sub parse_line { + my($self, $if, $line) = @_; + my $error; + + if ($line eq '') { + } + elsif ($line =~ /^([^=]+)\s*=\s*(.*)$/) { + ## Save the name, removing any trailing white space, and the value + ## too. + my $name = $1; + my $clean = $2; + $name =~ s/\s+$//; + + ## Pre-process the name and value + my $value = $self->preprocess($clean); + $name = $self->preprocess($name); + $name =~ s/\\/\//g; + + ## Store the name value pair + if (!defined $self->{'valid'}) { + ## There are no valid names, so all names are valid, except an + ## empty name. + if ($name ne '') { + $self->{'values'}->{$name} = $value; + $self->{'clean'}->{$name} = $clean; + } + } + elsif (defined $self->{'valid'}->{lc($name)}) { + ## This is a valid value, so we can store it. + $self->{'values'}->{lc($name)} = $value; + $self->{'clean'}->{lc($name)} = $clean; + } + else { + $error = "Invalid keyword: $name"; + } + } + else { + $error = "Unrecognized line: $line"; + } + + return (defined $error ? 0 : 1), $error; +} + + +sub get_names { + my @names = keys %{$_[0]->{'values'}}; + return \@names; +} + + +sub get_value { + ## Try the tag first and if that doesn't work make it all lower-case. + my($self, $tag) = @_; + return $self->{'values'}->{$tag} || $self->{'values'}->{lc($tag)}; +} + + +sub get_unprocessed { + ## Try the tag first and if that doesn't work make it all lower-case. + my($self, $tag) = @_; + return $self->{'clean'}->{$tag} || $self->{'clean'}->{lc($tag)}; +} + + +sub preprocess { + my($self, $str) = @_; + + ## We need to replace $(...) with the equivalent environment variable + ## value. + while($str =~ /\$([\(\w\)]+)/) { + my $name = $1; + $name =~ s/[\(\)]//g; + my $val = $ENV{$name}; + + ## If the environment variable is not set, we will end up removing + ## the reference, but we need to warn the user that we're doing so. + if (!defined $val) { + $val = ''; + if (!defined $self->{'warned'}->{$name}) { + $self->diagnostic("$name was used in the configuration file, " . + "but was not defined."); + $self->{'warned'}->{$name} = 1; + } + } + + ## Do the replacement + $str =~ s/\$([\(\w\)]+)/$val/; + } + return $str; +} + +1; diff --git a/ACE/MPC/modules/Creator.pm b/ACE/MPC/modules/Creator.pm new file mode 100644 index 00000000000..a3566b5d1d2 --- /dev/null +++ b/ACE/MPC/modules/Creator.pm @@ -0,0 +1,1310 @@ +package Creator; + +# ************************************************************ +# Description : Base class for workspace and project creators +# Author : Chad Elliott +# Create Date : 5/13/2002 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; +use FileHandle; +use File::Compare; + +use Parser; + +use vars qw(@ISA); +@ISA = qw(Parser); + +# ************************************************************ +# Data Section +# ************************************************************ + +## Constants for use throughout the project +use constant cplusplus => 'cplusplus'; +use constant csharp => 'csharp'; +use constant java => 'java'; +use constant vb => 'vb'; +use constant website => 'website'; + +## The default language for MPC +my $deflang = 'cplusplus'; + +## A map of all of the allowed languages. The 'website' value +## is not here because it isn't really a language. It is used +## as a language internally by some project types though. +my %languages = (cplusplus => 1, + csharp => 1, + java => 1, + vb => 1, + ); + +my $assign_key = 'assign'; +my $gassign_key = 'global_assign'; +my %non_convert = ('prebuild' => 1, + 'postbuild' => 1, + 'postclean' => 1, + ); +my @statekeys = ('global', 'include', 'template', 'ti', + 'dynamic', 'static', 'relative', 'addtemp', + 'addproj', 'progress', 'toplevel', 'baseprojs', + 'features', 'feature_file', 'hierarchy', + 'name_modifier', 'apply_project', 'into', 'use_env', + 'expand_vars', 'language', + ); + +my %all_written; +my $onVMS = DirectoryManager::onVMS(); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub new { + my($class, $global, $inc, $template, $ti, $dynamic, $static, $relative, $addtemp, $addproj, $progress, $toplevel, $baseprojs, $feature, $features, $hierarchy, $nmodifier, $applypj, $into, $language, $use_env, $expandvars, $type) = @_; + my $self = Parser::new($class, $inc); + + $self->{'relative'} = $relative; + $self->{'template'} = $template; + $self->{'ti'} = $ti; + $self->{'global'} = $global; + $self->{'grammar_type'} = $type; + $self->{'type_check'} = $type . '_defined'; + $self->{'global_read'} = 0; + $self->{'current_input'} = ''; + $self->{'progress'} = $progress; + $self->{'addtemp'} = $addtemp; + $self->{'addproj'} = $addproj; + $self->{'toplevel'} = $toplevel; + $self->{'files_written'} = {}; + $self->{'real_fwritten'} = []; + $self->{'reading_global'} = 0; + $self->{$gassign_key} = {}; + $self->{$assign_key} = {}; + $self->{'baseprojs'} = $baseprojs; + $self->{'dynamic'} = $dynamic; + $self->{'static'} = $static; + $self->{'feature_file'} = $feature; + $self->{'features'} = $features; + $self->{'hierarchy'} = $hierarchy; + $self->{'name_modifier'} = $nmodifier; + $self->{'apply_project'} = $applypj; + $self->{'into'} = $into; + $self->{'language'} = defined $language ? $language : $deflang; + $self->{'use_env'} = $use_env; + $self->{'expand_vars'} = $expandvars; + $self->{'convert_slashes'} = $self->convert_slashes(); + $self->{'requires_forward_slashes'} = $self->requires_forward_slashes(); + $self->{'case_tolerant'} = $self->case_insensitive(); + + return $self; +} + + +sub preprocess_line { + my($self, $fh, $line) = @_; + + $line = $self->strip_line($line); + while ($line =~ /\\$/) { + $line =~ s/\s*\\$/ /; + my $next = $fh->getline(); + $line .= $self->strip_line($next) if (defined $next); + } + return $line; +} + + +sub generate_default_input { + my $self = shift; + my($status, + $error) = $self->parse_line(undef, "$self->{'grammar_type'} {"); + + ## Parse the finish line if there was no error + ($status, $error) = $self->parse_line(undef, '}') if ($status); + + ## Display the error if there was one + $self->error($error) if (!$status); + + return $status; +} + + +sub parse_file { + my($self, $input) = @_; + + ## Save the last line number so we can put it back later + my $oline = $self->get_line_number(); + + ## Read the input file + my($status, $errorString) = $self->read_file($input); + + if (!$status) { + $self->error($errorString, + "$input: line " . $self->get_line_number() . ':'); + } + elsif ($self->{$self->{'type_check'}}) { + ## If we are at the end of the file and the type we are looking at + ## is still defined, then we have an error + $self->error("Did not " . + "find the end of the $self->{'grammar_type'}", + "$input: line " . $self->get_line_number() . ':'); + $status = 0; + } + $self->set_line_number($oline); + + return $status; +} + + +sub generate { + my($self, $input) = @_; + my $status = 1; + + ## Reset the files_written hash array between processing each file + $self->{'files_written'} = {}; + $self->{'real_fwritten'} = []; + + ## Allow subclasses to reset values before + ## each call to generate(). + $self->reset_values(); + + ## Read the global configuration file + if (!$self->{'global_read'}) { + $status = $self->read_global_configuration(); + $self->{'global_read'} = 1; + } + + if ($status) { + $self->{'current_input'} = $input; + + ## An empty input file name says that we + ## should generate a default input file and use that + if ($input eq '') { + $status = $self->generate_default_input(); + } + else { + $status = $self->parse_file($input); + } + } + + return $status; +} + + +sub parse_known { + my($self, $line) = @_; + my $status = 1; + my $errorString; + my $type = $self->{'grammar_type'}; + my @values; + + ## + ## Each regexp that looks for the '{' looks for it at the + ## end of the line. It is purposely this way to decrease + ## the amount of extra lines in each file. This + ## allows for the most compact file as human readably + ## possible. + ## + if ($line eq '') { + } + elsif ($line =~ /^$type\s*(\([^\)]+\))?\s*(:.*)?\s*{$/) { + my $name = $1; + my $parents = $2; + if ($self->{$self->{'type_check'}}) { + $errorString = "Did not find the end of the $type"; + $status = 0; + } + else { + if (defined $parents) { + $parents =~ s/^:\s*//; + $parents =~ s/\s+$//; + my @parents = split(/\s*,\s*/, $parents); + if (!defined $parents[0]) { + ## The : was used, but no parents followed. This + ## is an error. + $errorString = 'No parents listed'; + $status = 0; + } + $parents = \@parents; + } + push(@values, $type, $name, $parents); + } + } + elsif ($line =~ /^}$/) { + if ($self->{$self->{'type_check'}}) { + push(@values, $type, $line); + } + else { + $errorString = "Did not find the beginning of the $type"; + $status = 0; + } + } + elsif ($line =~ /^(feature)\s*\(([^\)]+)\)\s*(:.*)?\s*{$/) { + my $type = $1; + my $name = $2; + my $parents = $3; + my @names = split(/\s*,\s*/, $name); + + if (defined $parents) { + $parents =~ s/^:\s*//; + $parents =~ s/\s+$//; + my @parents = split(/\s*,\s*/, $parents); + if (!defined $parents[0]) { + ## The : was used, but no parents followed. This + ## is an error. + $errorString = 'No parents listed'; + $status = 0; + } + $parents = \@parents; + } + push(@values, $type, \@names, $parents); + } + elsif (!$self->{$self->{'type_check'}}) { + $errorString = "No $type was defined"; + $status = 0; + } + elsif ($self->parse_assignment($line, \@values)) { + ## If this returns true, then we've found an assignment + } + elsif ($line =~ /^(\w+)\s*(\([^\)]+\))?\s*{$/) { + my $comp = lc($1); + my $name = $2; + + if (defined $name) { + $name =~ s/^\(\s*//; + $name =~ s/\s*\)$//; + } + else { + $name = $self->get_default_component_name(); + } + push(@values, 'component', $comp, $name); + } + else { + $errorString = "Unrecognized line: $line"; + $status = -1; + } + + return $status, $errorString, @values; +} + + +sub parse_scope { + my($self, $fh, $name, $type, $validNames, $flags, $elseflags) = @_; + my $status = 0; + my $errorString = "Unable to process $name"; + + ## Make sure $flags has a hash map reference + $flags = {} if (!defined $flags); + + while(<$fh>) { + my $line = $self->preprocess_line($fh, $_); + + if ($line eq '') { + } + elsif ($line =~ /^}$/) { + ($status, $errorString) = $self->handle_scoped_end($type, $flags); + last; + } + elsif ($line =~ /^}\s*else\s*{$/) { + if (defined $elseflags) { + ## From here on out anything after this goes into the $elseflags + $flags = $elseflags; + $elseflags = undef; + + ## We need to adjust the type also. If there was a type + ## then the first part of the clause was used. If there was + ## no type, then the first part was ignored and the second + ## part will be used. + if (defined $type) { + $type = undef; + } + else { + $type = $self->get_default_component_name(); + } + } + else { + $status = 0; + $errorString = 'An else is not allowed in this context'; + last; + } + } + else { + my @values; + if (defined $validNames && $self->parse_assignment($line, \@values)) { + if (defined $$validNames{$values[1]}) { + ## If $type is not defined, we don't even need to bother with + ## processing the assignment as we will be throwing the value + ## away anyway. + if (defined $type) { + if ($values[0] == 0) { + $self->process_assignment($values[1], $values[2], $flags); + } + elsif ($values[0] == 1) { + $self->process_assignment_add($values[1], $values[2], $flags); + } + elsif ($values[0] == -1) { + $self->process_assignment_sub($values[1], $values[2], $flags); + } + } + } + else { + ($status, + $errorString) = $self->handle_unknown_assignment($type, + @values); + last if (!$status); + } + } + else { + ($status, $errorString) = $self->handle_scoped_unknown($fh, + $type, + $flags, + $line); + last if (!$status); + } + } + } + return $status, $errorString; +} + + +sub base_directory { + my $self = shift; + return $self->mpc_basename($self->getcwd()); +} + + +sub generate_default_file_list { + my($self, $dir, $exclude, $fileexc, $recurse) = @_; + my $dh = new FileHandle(); + my @files; + + if (opendir($dh, $dir)) { + my $prefix = ($dir ne '.' ? "$dir/" : ''); + my $have_exc = (defined $$exclude[0]); + my $skip = 0; + foreach my $file (grep(!/^\.\.?$/, + ($onVMS ? map {$_ =~ s/\.dir$//; $_} readdir($dh) : + readdir($dh)))) { + ## Prefix each file name with the directory only if it's not '.' + my $full = $prefix . $file; + + if ($have_exc) { + foreach my $exc (@$exclude) { + if ($full eq $exc) { + $skip = 1; + last; + } + } + } + + if ($skip) { + $skip = 0; + $$fileexc = 1 if (defined $fileexc); + } + else { + if ($recurse && -d $full) { + push(@files, + $self->generate_default_file_list($full, $exclude, + $fileexc, $recurse)); + } + else { + # Strip out ^ symbols + $full =~ s/\^//g if ($onVMS); + + push(@files, $full); + } + } + } + + if ($self->sort_files()) { + @files = sort { $self->file_sorter($a, $b) } @files; + } + + closedir($dh); + } + return @files; +} + + +sub transform_file_name { + my($self, $name) = @_; + + $name =~ s/[\s\-]/_/g; + return $name; +} + + +sub file_written { + my($self, $file) = @_; + return (defined $all_written{$self->getcwd() . '/' . $file}); +} + + +sub add_file_written { + my($self, $file) = @_; + my $key = lc($file); + + if (defined $self->{'files_written'}->{$key}) { + $self->warning("$self->{'grammar_type'} $file " . + ($self->{'case_tolerant'} ? + "has been overwritten." : + "of differing case has been processed.")); + } + else { + $self->{'files_written'}->{$key} = $file; + push(@{$self->{'real_fwritten'}}, $file); + } + + $all_written{$self->getcwd() . '/' . $file} = 1; +} + + +sub extension_recursive_input_list { + my($self, $dir, $exclude, $ext) = @_; + my $fh = new FileHandle(); + my @files; + + if (opendir($fh, $dir)) { + my $prefix = ($dir ne '.' ? "$dir/" : ''); + my $skip = 0; + foreach my $file (grep(!/^\.\.?$/, + ($onVMS ? map {$_ =~ s/\.dir$//; $_} readdir($fh) : + readdir($fh)))) { + my $full = $prefix . $file; + + ## Check for command line exclusions + if (defined $$exclude[0]) { + foreach my $exc (@$exclude) { + if ($full eq $exc) { + $skip = 1; + last; + } + } + } + + ## If we are not skipping this directory or file, then check it out + if ($skip) { + $skip = 0; + } + else { + if (-d $full) { + push(@files, $self->extension_recursive_input_list($full, + $exclude, + $ext)); + } + elsif ($full =~ /$ext$/) { + push(@files, $full); + } + } + } + closedir($fh); + } + + return @files; +} + +sub recursive_directory_list { + my($self, $dir, $exclude) = @_; + my $directories = ''; + my $fh = new FileHandle(); + + if (opendir($fh, $dir)) { + my $prefix = ($dir ne '.' ? "$dir/" : ''); + my $skip = 0; + if (defined $$exclude[0]) { + foreach my $exc (@$exclude) { + if ($dir eq $exc) { + $skip = 1; + last; + } + } + } + if ($skip) { + $skip = 0; + } + else { + $directories .= ' ' . $dir; + } + + foreach my $file (grep(!/^\.\.?$/, + ($onVMS ? map {$_ =~ s/\.dir$//; $_} readdir($fh) : + readdir($fh)))) { + my $full = $prefix . $file; + + if ($file eq '.svn' || $file eq 'CVS') { + $skip = 1; + } + else { + ## Check for command line exclusions + if (defined $$exclude[0]) { + foreach my $exc (@$exclude) { + if ($full eq $exc) { + $skip = 1; + last; + } + } + } + } + + ## If we are not skipping this directory or file, then check it out + if ($skip) { + $skip = 0; + } + else { + if (-d $full) { + $directories .= $self->recursive_directory_list($full, $exclude); + } + } + } + closedir($fh); + } + + return $directories; +} + + +sub modify_assignment_value { + my($self, $name, $value) = @_; + + if ($self->{'convert_slashes'} && + index($name, 'flags') == -1 && !defined $non_convert{$name}) { + $value =~ s/\//\\/g; + } + + return $value; +} + + +sub get_assignment_hash { + ## NOTE: If anything in this block changes, then you must make the + ## same change in process_assignment. + my $self = shift; + return $self->{$self->{'reading_global'} ? $gassign_key : $assign_key}; +} + + +sub process_assignment { + my($self, $name, $value, $assign) = @_; + + ## If no hash table was passed in + if (!defined $assign) { + ## NOTE: If anything in this block changes, then you must make the + ## same change in get_assignment_hash. + $assign = $self->{$self->{'reading_global'} ? + $gassign_key : $assign_key}; + } + + if (defined $value) { + $value =~ s/^\s+//; + $value =~ s/\s+$//; + + ## Modify the assignment value before saving it + $$assign{$name} = $self->modify_assignment_value($name, $value); + } + else { + $$assign{$name} = undef; + } +} + + +sub addition_core { + my($self, $name, $value, $nval, $assign) = @_; + + if (defined $nval) { + if ($self->preserve_assignment_order($name)) { + $nval .= " $value"; + } + else { + $nval = "$value $nval"; + } + } + else { + $nval = $value; + } + $self->process_assignment($name, $nval, $assign, 1); +} + + +sub process_assignment_add { + my($self, $name, $value, $assign) = @_; + my $nval = $self->get_assignment_for_modification($name, $assign); + + ## Remove all duplicate parts from the value to be added. + ## Whether anything gets removed or not is up to the implementation + ## of the sub classes. + $value = $self->remove_duplicate_addition($name, $value, $nval); + + ## If there is anything to add, then do so + $self->addition_core($name, $value, $nval, $assign) if ($value ne ''); +} + + +sub subtraction_core { + my($self, $name, $value, $nval, $assign) = @_; + + if (defined $nval) { + my $last = 1; + my $found; + + ## Escape any regular expression special characters + $value = $self->escape_regex_special($value); + + ## If necessary, split the value into an array + my $elements = ($value =~ /\s/ ? $self->create_array($value) : [$value]); + for(my $i = 0; $i <= $last; $i++) { + if ($i == $last) { + ## If we did not find the string to subtract in the original + ## value, try again after expanding template variables for + ## subtraction. + $nval = $self->get_assignment_for_modification($name, $assign, 1); + } + for(my $j = 0; $j <= $last; $j++) { + ## Try to remove each individual element and then set the new + ## value if any of the elements were found in the original value + foreach my $elem (@$elements) { + ## First try with quotes, then try again without them + my $re = ($j == 0 ? '"' . $elem . '"' : $elem); + + if ($nval =~ s/\s+$re\s+/ / || $nval =~ s/\s+$re$// || + $nval =~ s/^$re\s+// || $nval =~ s/^$re$//) { + $found = 1; + } + } + if ($found) { + $self->process_assignment($name, $nval, $assign, -1); + last; + } + } + last if ($found); + } + } +} + + +sub process_assignment_sub { + my($self, $name, $value, $assign) = @_; + my $nval = $self->get_assignment_for_modification($name, $assign); + + ## Remove double quotes if there are any + $value =~ s/^\"(.*)\"$/$1/; + + $self->subtraction_core($name, $value, $nval, $assign); +} + + +sub fill_type_name { + my($self, $names, $def) = @_; + my $array = ($names =~ /\s/ ? $self->create_array($names) : [$names]); + + $names = ''; + foreach my $name (@$array) { + if ($name =~ /\*/) { + my $pre = $def . '_'; + my $mid = '_' . $def . '_'; + my $post = '_' . $def; + + ## Replace the beginning and end first then the middle + $name =~ s/^\*/$pre/; + $name =~ s/\*$/$post/; + $name =~ s/\*/$mid/g; + + ## Remove any trailing underscore or any underscore that is followed + ## by a space. This value could be a space separated list. + $name =~ s/_$//; + $name =~ s/_\s/ /g; + $name =~ s/\s_/ /g; + + ## If any one word is capitalized then capitalize each word + if ($name =~ /[A-Z][0-9a-z_]+/) { + ## Do the first word + if ($name =~ /^([a-z])([^_]+)/) { + my $first = uc($1); + my $rest = $2; + $name =~ s/^[a-z][^_]+/$first$rest/; + } + ## Do subsequent words + while($name =~ /(_[a-z])([^_]+)/) { + my $first = uc($1); + my $rest = $2; + $name =~ s/_[a-z][^_]+/$first$rest/; + } + } + } + + $names .= $name . ' '; + } + $names =~ s/\s+$//; + + return $names; +} + + +sub clone { + my($self, $obj) = @_; + + ## Check for various types of data. Those that are not found to be + ## types that we need to deep copy are just assigned to new values. + ## All others are copied by recursively calling this method. + if (UNIVERSAL::isa($obj, 'HASH')) { + my $new = {}; + foreach my $key (keys %$obj) { + $$new{$key} = $self->clone($$obj{$key}); + } + return $new; + } + elsif (UNIVERSAL::isa($obj, 'ARRAY')) { + my $new = []; + foreach my $o (@$obj) { + push(@$new, $self->clone($o)); + } + return $new; + } + + return $obj; +} + + +sub save_state { + my($self, $selected) = @_; + my %state; + + ## Make a deep copy of each state value. That way our array + ## references and hash references do not get accidentally modified. + foreach my $skey (defined $selected ? $selected : @statekeys) { + if (defined $self->{$skey}) { + ## It is necessary to clone each value so that nested complex data + ## types do not get unknowingly modified. + $state{$skey} = $self->clone($self->{$skey}); + } + } + + return %state; +} + + +sub restore_state { + my($self, $state, $selected) = @_; + + ## Make a deep copy of each state value. That way our array + ## references and hash references do not get accidentally modified. + ## It's not necessary to do a recursive deep copy (i.e., use the + ## clone() method) because the value coming in will now be owned by + ## this object and will not be modified unknowingly. + foreach my $skey (defined $selected ? $selected : @statekeys) { + my $old = $self->{$skey}; + if (defined $state->{$skey} && + UNIVERSAL::isa($state->{$skey}, 'ARRAY')) { + my @arr = @{$state->{$skey}}; + $self->{$skey} = \@arr; + } + elsif (defined $state->{$skey} && + UNIVERSAL::isa($state->{$skey}, 'HASH')) { + my %hash = %{$state->{$skey}}; + $self->{$skey} = \%hash; + } + else { + $self->{$skey} = $state->{$skey}; + } + $self->restore_state_helper($skey, $old, $self->{$skey}); + } +} + + +sub get_global_cfg { + return $_[0]->{'global'}; +} + + +sub get_template_override { + return $_[0]->{'template'}; +} + + +sub get_ti_override { + return $_[0]->{'ti'}; +} + + +sub get_relative { + return $_[0]->{'relative'}; +} + + +sub get_progress_callback { + return $_[0]->{'progress'}; +} + + +sub get_addtemp { + return $_[0]->{'addtemp'}; +} + + +sub get_addproj { + return $_[0]->{'addproj'}; +} + + +sub get_toplevel { + return $_[0]->{'toplevel'}; +} + + +sub get_into { + return $_[0]->{'into'}; +} + + +sub get_use_env { + return $_[0]->{'use_env'}; +} + + +sub get_expand_vars { + return $_[0]->{'expand_vars'}; +} + + +sub get_files_written { + return $_[0]->{'real_fwritten'}; +} + + +sub get_assignment { + my $self = shift; + my $name = $self->resolve_alias(shift); + my $assign = shift; + + ## If no hash table was passed in + if (!defined $assign) { + $assign = $self->{$self->{'reading_global'} ? + $gassign_key : $assign_key}; + } + + return $$assign{$name}; +} + + +sub get_assignment_for_modification { + my($self, $name, $assign, $subtraction) = @_; + return $self->get_assignment($name, $assign); +} + + +sub get_baseprojs { + return $_[0]->{'baseprojs'}; +} + + +sub get_dynamic { + return $_[0]->{'dynamic'}; +} + + +sub get_static { + return $_[0]->{'static'}; +} + + +sub get_default_component_name { + #my $self = shift; + return 'default'; +} + + +sub get_features { + return $_[0]->{'features'}; +} + + +sub get_hierarchy { + return $_[0]->{'hierarchy'}; +} + + +sub get_name_modifier { + return $_[0]->{'name_modifier'}; +} + + +sub get_apply_project { + return $_[0]->{'apply_project'}; +} + + +sub get_language { + return $_[0]->{'language'}; +} + + +sub get_outdir { + my $self = shift; + if (defined $self->{'into'}) { + my $outdir = $self->getcwd(); + my $re = $self->escape_regex_special($self->getstartdir()); + + $outdir =~ s/^$re//; + return $self->{'into'} . $outdir; + } + else { + return '.'; + } +} + + +sub expand_variables { + my($self, $value, $rel, $expand_template, $scope, $expand, $warn) = @_; + my $cwd = $self->getcwd(); + my $start = 0; + my $forward_slashes = $self->{'convert_slashes'} || + $self->{'requires_forward_slashes'}; + + ## Fix up the value for Windows switch the \\'s to / + $cwd =~ s/\\/\//g if ($forward_slashes); + + while(substr($value, $start) =~ /(\$\(([^)]+)\))/) { + my $whole = $1; + my $name = $2; + if (defined $$rel{$name}) { + my $val = $$rel{$name}; + if ($expand) { + $val =~ s/\//\\/g if ($forward_slashes); + substr($value, $start) =~ s/\$\([^)]+\)/$val/; + $whole = $val; + } + else { + ## Fix up the value for Windows switch the \\'s to / + $val =~ s/\\/\//g if ($forward_slashes); + + my $icwd = ($self->{'case_tolerant'} ? lc($cwd) : $cwd); + my $ival = ($self->{'case_tolerant'} ? lc($val) : $val); + my $iclen = length($icwd); + my $ivlen = length($ival); + + ## If the relative value contains the current working + ## directory plus additional subdirectories, we must pull + ## off the additional directories into a temporary where + ## it can be put back after the relative replacement is done. + my $append; + if (index($ival, $icwd) == 0 && $iclen != $ivlen && + substr($ival, $iclen, 1) eq '/') { + my $diff = $ivlen - $iclen; + $append = substr($ival, $iclen); + substr($ival, $iclen, $diff) = ''; + $ivlen -= $diff; + } + + if (index($icwd, $ival) == 0 && + ($iclen == $ivlen || substr($icwd, $ivlen, 1) eq '/')) { + my $current = $icwd; + substr($current, 0, $ivlen) = ''; + + my $dircount = ($current =~ tr/\///); + if ($dircount == 0) { + $ival = '.'; + } + else { + $ival = '../' x $dircount; + $ival =~ s/\/$//; + } + $ival .= $append if (defined $append); + + ## We have to remove the leading ./ if there is one. + ## Otherwise, if this value is used as an exclude value it will + ## not match up correctly. + $ival =~ s!^\./!!; + + ## Convert the slashes if necessary + $ival =~ s/\//\\/g if ($self->{'convert_slashes'}); + substr($value, $start) =~ s/\$\([^)]+\)/$ival/; + $whole = $ival; + } + elsif ($self->convert_all_variables() && $warn) { + ## The user did not choose to expand $() variables directly, + ## but we could not convert it into a relative path. So, + ## instead of leaving it we will expand it. But, we will only + ## get into this section if this is the secondary attempt to + ## replace the variable (indicated by the $warn boolean). + $val =~ s/\//\\/g if ($self->{'convert_slashes'}); + substr($value, $start) =~ s/\$\([^)]+\)/$val/; + $whole = $val; + } + else { + my $loc = index(substr($value, $start), $whole); + $start += $loc if ($loc > 0); + } + } + } + elsif ($expand_template || + $self->expand_variables_from_template_values()) { + my $ti = $self->get_template_input(); + my $val = (defined $ti ? $ti->get_value($name) : undef); + my $sname = (defined $scope ? $scope . "::$name" : undef); + my $arr = $self->adjust_value([$sname, $name], + (defined $val ? $val : [])); + if (UNIVERSAL::isa($arr, 'HASH')) { + $self->warning("$name conflicts with a template variable scope"); + } + elsif (UNIVERSAL::isa($arr, 'ARRAY') && defined $$arr[0]) { + $val = $self->modify_assignment_value(lc($name), "@$arr"); + substr($value, $start) =~ s/\$\([^)]+\)/$val/; + + ## We have replaced the template value, but that template + ## value may contain a $() construct that may need to get + ## replaced too. However, if the name of the template variable + ## is the same as the original $() variable name, we need to + ## leave it alone to avoid looping infinitely. + $whole = '' if ($whole ne $val); + } + else { + $self->warning("Unable to expand $name.") if ($expand && $warn); + my $loc = index(substr($value, $start), $whole); + $start += $loc if ($loc > 0); + } + } + elsif ($self->convert_all_variables() && $warn) { + ## We could not find a value to correspond to the variable name. + ## Instead of leaving it we will expand it. But, we will only + ## get into this section if this is the secondary attempt to + ## replace the variable (indicated by the $warn boolean). + substr($value, $start) =~ s/\$\([^)]+\)//; + $whole = ''; + } + else { + my $loc = index(substr($value, $start), $whole); + $start += $loc if ($loc > 0); + } + $start += length($whole); + } + + $value =~ s/\\/\//g if ($self->{'requires_forward_slashes'}); + + return $value; +} + + +sub replace_env_vars { + my($self, $lref) = @_; + my $one_empty = undef; + + ## Loop through the string until we find no more environment variables. + while($$lref =~ /\$(\w+)/) { + my $name = $1; + my $val = ''; + + ## PWD is a special variable. It isn't set on Windows, but in MPC we + ## must guarantee that it is always there. + if ($name eq 'PWD') { + $val = $self->getcwd(); + } + elsif (defined $ENV{$name}) { + $val = $ENV{$name}; + } + else { + ## Keep track of an environment variable not being set. + $one_empty = 1; + } + $$lref =~ s/\$\w+/$val/; + } + return $one_empty; +} + + +sub relative { + my($self, $value, $expand_template, $scope) = @_; + + if (defined $value) { + if (UNIVERSAL::isa($value, 'ARRAY')) { + my @built; + foreach my $val (@$value) { + my $rel = $self->relative($val, $expand_template, $scope); + if (UNIVERSAL::isa($rel, 'ARRAY')) { + push(@built, @$rel); + } + else { + push(@built, $rel); + } + } + return \@built; + } + elsif (index($value, '$') >= 0) { + ## A form of this code lives in + ## ProjectCreator::create_recursive_settings. If you are changing + ## something in this area, please look at the method in + ## ProjectCreator.pm to see if it needs changing too. + + my $ovalue = $value; + my($rel, $how) = $self->get_initial_relative_values(); + $value = $self->expand_variables($value, $rel, + $expand_template, $scope, $how); + + if ($ovalue eq $value || index($value, '$') >= 0) { + ($rel, $how) = $self->get_secondary_relative_values(); + $value = $self->expand_variables($value, $rel, + $expand_template, $scope, + $how, 1); + } + } + } + + ## Values that have two or more strings enclosed in double quotes are + ## to be interpreted as elements of an array + if (defined $value && $value =~ /^"[^"]+"(\s+"[^"]+")+$/) { + $value = $self->create_array($value); + } + + return $value; +} + + +## Static function. Returns the default language for MPC. +sub defaultLanguage { + return $deflang; +} + + +## Static function. Returns an array of valid languages. +sub validLanguages { + return keys %languages; +} + + +## Static function. The one and only argument is the language +## string to check for validity. +sub isValidLanguage { + return defined $languages{$_[0]}; +} + + +sub languageIs { + #my($self, $language) = @_; + return $_[0]->{'language'} eq $_[1]; +} + +# ************************************************************ +# Virtual Methods To Be Overridden +# ************************************************************ + +sub restore_state_helper { + #my $self = shift; + #my $skey = shift; + #my $old = shift; + #my $new = shift; +} + + +sub get_initial_relative_values { + #my $self = shift; + return {}, 0; +} + + +sub get_secondary_relative_values { + my $self = shift; + return ($self->{'use_env'} ? \%ENV : + $self->{'relative'}), $self->{'expand_vars'}; +} + + +sub convert_all_variables { + #my $self = shift; + return 0; +} + + +sub expand_variables_from_template_values { + #my $self = shift; + return 0; +} + + +sub preserve_assignment_order { + #my $self = shift; + #my $name = shift; + return 1; +} + + +sub compare_output { + #my $self = shift; + return 0; +} + + +sub files_are_different { + my($self, $old, $new) = @_; + return !(-r $old && -s $new == -s $old && compare($new, $old) == 0); +} + + +sub handle_scoped_end { + #my $self = shift; + #my $type = shift; + #my $flags = shift; + return 1, undef; +} + +sub handle_unknown_assignment { + my $self = shift; + my $type = shift; + my @values = @_; + return 0, "Invalid assignment name: '$values[1]'"; +} + + +sub handle_scoped_unknown { + my($self, $fh, $type, $flags, $line) = @_; + return 0, "Unrecognized line: $line"; +} + + +sub remove_duplicate_addition { + my($self, $name, $value, $current) = @_; + return $value; +} + + +sub generate_recursive_input_list { + #my $self = shift; + #my $dir = shift; + #my $exclude = shift; + return (); +} + + +sub reset_values { + #my $self = shift; +} + + +sub sort_files { + #my $self = shift; + return 1; +} + + +sub file_sorter { + #my $self = shift; + #my $left = shift; + #my $right = shift; + return $_[1] cmp $_[2]; +} + + +sub read_global_configuration { + #my $self = shift; + #my $input = shift; + return 1; +} + + +sub set_verbose_ordering { + #my $self = shift; + #my $value = shift; +} + + +1; diff --git a/ACE/MPC/modules/Depgen/DependencyEditor.pm b/ACE/MPC/modules/Depgen/DependencyEditor.pm new file mode 100644 index 00000000000..6f551d64b5f --- /dev/null +++ b/ACE/MPC/modules/Depgen/DependencyEditor.pm @@ -0,0 +1,117 @@ +package DependencyEditor; + +# ************************************************************ +# Description : Edits existing dependencies. +# Author : Chad Elliott +# Create Date : 2/10/2002 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; +use FileHandle; + +use DependencyGenerator; + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub new { + return bless {}, $_[0]; +} + + +sub process { + my($self, $output, $type, $noinline, $macros, + $ipaths, $replace, $exclude, $files) = @_; + + ## Back up the original file and receive the contents + my $contents; + if (-s $output) { + $contents = []; + if (!$self->backup($output, $contents)) { + print STDERR "ERROR: Unable to backup $output\n"; + return 1; + } + } + + ## Write out the contents of the file + my $fh = new FileHandle(); + if (open($fh, ">$output")) { + if (defined $contents) { + foreach my $line (@$contents) { + print $fh $line; + } + } + + ## Write out the new dependency marker + print $fh "# DO NOT DELETE THIS LINE -- depgen.pl uses it.\n", + "# DO NOT PUT ANYTHING AFTER THIS LINE, IT WILL GO AWAY.\n\n"; + + ## Generate the new dependencies and write them to the file + my $dep = new DependencyGenerator($macros, $ipaths, $replace, + $type, $noinline, $exclude); + ## Sort the files so the dependencies are reproducible + foreach my $file (sort @$files) { + ## In some situations we may be passed a directory as part of an + ## option. If it is an unknown option, we may think the directory + ## needs to be part of the dependencies when it should not. + print $fh $dep->process($file), "\n" if (!-d $file); + } + + ## Write out the end of the block warning + print $fh "# IF YOU PUT ANYTHING HERE IT WILL GO AWAY\n"; + close($fh); + } + else { + print STDERR "ERROR: Unable to open $output for output\n"; + return 1; + } + + return 0; +} + + +sub backup { + my($self, $source, $contents) = @_; + my $status; + my $fh = new FileHandle(); + my $backup = "$source.bak"; + + ## Back up the file. While doing so, keep track of the contents of the + ## file and keep everything except the old dependencies. + if (open($fh, $source)) { + my $oh = new FileHandle(); + if (open($oh, ">$backup")) { + my $record = 1; + $status = 1; + while(<$fh>) { + print $oh $_; + if ($record) { + if (index($_, 'DO NOT DELETE') >= 0) { + $record = undef; + } + else { + push(@$contents, $_); + } + } + } + close($oh); + + ## Set file permission so that the backup has the same permissions + ## as the original file. + my @buf = stat($source); + if (defined $buf[8] && defined $buf[9]) { + utime($buf[8], $buf[9], $backup); + } + } + close($fh); + } + return $status; +} + + +1; diff --git a/ACE/MPC/modules/Depgen/DependencyGenerator.pm b/ACE/MPC/modules/Depgen/DependencyGenerator.pm new file mode 100644 index 00000000000..77c0eee81f7 --- /dev/null +++ b/ACE/MPC/modules/Depgen/DependencyGenerator.pm @@ -0,0 +1,67 @@ +package DependencyGenerator; + +# ************************************************************ +# Description : Runs the correct dependency generator on the file. +# Author : Chad Elliott +# Create Date : 2/10/2002 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use Preprocessor; +use DependencyWriterFactory; +use ObjectGeneratorFactory; + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub new { + my($class, $macros, $ipaths, $replace, $type, $noinline, $exclude) = @_; + my $self = bless {'pre' => new Preprocessor($macros, + $ipaths, $exclude), + 'replace' => $replace, + 'dwrite' => DependencyWriterFactory::create($type), + 'objgen' => ObjectGeneratorFactory::create($type), + 'noinline' => $noinline, + }, $class; + + ## Set the current working directory, but + ## escape regular expression special characters + $self->{'cwd'} = Cwd::getcwd() . '/'; + $self->{'cwd'} =~ s/([\+\-\\\$\[\]\(\)\.])/\\$1/g; + + ## Sort the replace keys to get the longest key first. This way + ## when we are replacing portions of the file path, we replace the + ## most we can. + my @repkeys = sort { length($b) <=> length($a) } keys %$replace; + $self->{'repkeys'} = \@repkeys; + + return $self; +} + + +sub process { + my($self, $file) = @_; + + ## Generate the dependency string + my $depstr = $self->{'dwrite'}->process( + $self->{'objgen'}->process($file), + $self->{'pre'}->process($file, $self->{'noinline'})); + + ## Perform the replacements on the dependency string + $depstr =~ s/$self->{'cwd'}//go; + my $replace = $self->{'replace'}; + foreach my $rep (@{$self->{'repkeys'}}) { + $depstr =~ s/$rep/$$replace{$rep}/g; + } + + return $depstr; +} + + +1; diff --git a/ACE/MPC/modules/Depgen/DependencyWriter.pm b/ACE/MPC/modules/Depgen/DependencyWriter.pm new file mode 100644 index 00000000000..0f2cc5738af --- /dev/null +++ b/ACE/MPC/modules/Depgen/DependencyWriter.pm @@ -0,0 +1,30 @@ +package DependencyWriter; + +# ************************************************************ +# Description : Base class for all Dependency Writers. +# Author : Chad Elliott +# Create Date : 2/10/2002 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub new { + return bless {}, $_[0]; +} + + +sub process { + #my($self, $objects, $files) = @_; + return ''; +} + + +1; diff --git a/ACE/MPC/modules/Depgen/DependencyWriterFactory.pm b/ACE/MPC/modules/Depgen/DependencyWriterFactory.pm new file mode 100644 index 00000000000..558793ea0a5 --- /dev/null +++ b/ACE/MPC/modules/Depgen/DependencyWriterFactory.pm @@ -0,0 +1,40 @@ +package DependencyWriterFactory; + +# ************************************************************ +# Description : Create DependencyWriter objects. +# Author : Chad Elliott +# Create Date : 5/23/2003 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use DependencyWriter; + +# ************************************************************ +# Data Section +# ************************************************************ + +my $writers = {}; + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub register { + $writers = shift; +} + + +sub create { + return $$writers{$_[0]}->new() if (defined $$writers{$_[0]}); + + print STDERR "WARNING: Invalid dependency writer type: $_[0]\n"; + return new DependencyWriter(); +} + + +1; diff --git a/ACE/MPC/modules/Depgen/Driver.pm b/ACE/MPC/modules/Depgen/Driver.pm new file mode 100644 index 00000000000..8aac67ca7f6 --- /dev/null +++ b/ACE/MPC/modules/Depgen/Driver.pm @@ -0,0 +1,244 @@ +package Driver; + +# ************************************************************ +# Description : Generate dependencies for Make and NMake. +# Author : Chad Elliott +# Create Date : 3/21/2007 +# ************************************************************ + +# ************************************************************ +# Pragma Section +# ************************************************************ + +use strict; +use File::Basename; + +use DependencyEditor; + +# ************************************************************ +# Data Section +# ************************************************************ + +my $version = '1.2'; +my $os = ($^O eq 'MSWin32' ? 'Windows' : 'UNIX'); +my %types; +my %defaults = ('UNIX' => 'make', + 'Windows' => 'nmake', + ); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub BEGIN { + my $fh = new FileHandle(); + my(%writers, %generators); + + ## Find all the dependency writers and object generators + foreach my $dir (@INC) { + if (opendir($fh, $dir)) { + foreach my $module (readdir($fh)) { + if ($module =~ /(.+)DependencyWriter\.pm$/) { + my $type = lc($1); + my $class = $module; + $class =~ s/\.pm$//; + require $module; + $writers{$type} = $class; + $types{$type} = 1; + } + elsif ($module =~ /(.+)ObjectGenerator\.pm$/) { + my $type = lc($1); + my $class = $module; + $class =~ s/\.pm$//; + require $module; + $generators{$type} = $class; + } + } + closedir($fh); + } + } + + ## Register them with the right factory + DependencyWriterFactory::register(\%writers); + ObjectGeneratorFactory::register(\%generators); +} + + +sub new { + my $class = shift; + my $self = bless {'automatic' => [], + }, $class; + + foreach my $add (@_) { + if ($add =~ /(UNIX|Windows)=(.*)/) { + $defaults{$1} = $2; + } + elsif ($add =~ /automatic=(.*)/) { + my @auto = split(/,/, $1); + $self->{'automatic'} = \@auto; + } + else { + print "WARNING: Unknown parameter: $add\n"; + } + } + + return $self; +} + + +sub usageAndExit { + my($self, $opt) = @_; + my $base = basename($0); + + if (defined $opt) { + print "$opt.\n"; + } + + print "$base v$version\n" . + "Usage: $base [-D<MACRO>[=VALUE]] [-I<include dir>] ", + (defined $self->{'automatic'}->[0] ? "[-A] " : ''), + "[-R <VARNAME>]\n" . + " " . (" " x length($base)) . + " [-e <file>] [-f <output file>] [-i] [-t <type>] [-n]\n" . + " " . (" " x length($base)) . " <files...>\n" . + "\n"; + if (defined $self->{'automatic'}->[0]) { + print "-A Replace paths equal to the following variables with ", + "the corresponding \$()\n value: ", + join(', ', @{$self->{'automatic'}}), ".\n"; + } + print "-D This option sets a macro to an optional value.\n" . + "-I The -I option adds an include directory.\n" . + "-R Replace \$VARNAME paths with \$(VARNAME).\n" . + "-e Exclude dependencies generated by <file>, but not <file> " . + "itself.\n" . + "-f Specifies the output file. This file will be edited if it " . + "already\n exists.\n" . + "-i Do not print an error if no source files are provided.\n" . + "-n Do not include inline files (ending in .i or .inl) in the " . + "dependencies.\n" . + "-t Use specified type ("; + my @keys = sort keys %types; + for(my $i = 0; $i <= $#keys; ++$i) { + print "$keys[$i]" . + ($i != $#keys ? $i == $#keys - 1 ? ' or ' : ', ' : '');; + } + print ") instead of the default.\n" . + " The default is "; + @keys = sort keys %defaults; + for(my $i = 0; $i <= $#keys; ++$i) { + my $def = $keys[$i]; + print $defaults{$def} . " on $def" . + ($i != $#keys ? $i == $#keys - 1 ? ' and ' : ', ' : ''); + } + print ".\n"; + exit(0); +} + + +sub setReplace { + my($self, $replace, $name, $value) = @_; + + if (defined $name) { + ## The key will be used in a regular expression. + ## So, we need to escape some special characters. + $name = File::Spec->canonpath($name); + $name =~ s/([\+\-\\\$\[\]\(\)\.])/\\$1/g; + + $$replace{$name} = $value; + } +} + + +sub run { + my($self, $args) = @_; + my $argc = scalar(@$args); + my $type = $defaults{$os}; + my $output = '-'; + my $needsrc = 1; + my($noinline, @files, %macros, @ipaths, %replace, %exclude); + + for(my $i = 0; $i < $argc; ++$i) { + my $arg = $$args[$i]; + if ($arg =~ /^\-D(\w+)(=(.*))?/) { + $macros{$1} = $3; + } + elsif ($arg =~ /^\-I(.*)/) { + push(@ipaths, File::Spec->canonpath($1)); + } + elsif ($arg eq '-A') { + foreach my $auto (@{$self->{'automatic'}}) { + $self->setReplace(\%replace, $ENV{$auto}, '$(' . $auto . ')'); + } + } + elsif ($arg eq '-R') { + ++$i; + $arg = $$args[$i]; + if (defined $arg) { + my $val = $ENV{$arg}; + if (defined $val) { + $self->setReplace(\%replace, $val, "\$($arg)"); + } + } + else { + $self->usageAndExit('Invalid use of -R'); + } + } + elsif ($arg eq '-e') { + ++$i; + $arg = $$args[$i]; + if (defined $arg) { + $exclude{$arg} = 1; + } + else { + $self->usageAndExit('Invalid use of -e'); + } + } + elsif ($arg eq '-f') { + ++$i; + $arg = $$args[$i]; + if (defined $arg) { + $output = $arg; + } + else { + $self->usageAndExit('Invalid use of -f'); + } + } + elsif ($arg eq '-i') { + $needsrc = undef; + } + elsif ($arg eq '-n') { + $noinline = 1; + } + elsif ($arg eq '-h') { + $self->usageAndExit(); + } + elsif ($arg eq '-t') { + ++$i; + $arg = $$args[$i]; + if (defined $arg && defined $types{$arg}) { + $type = $arg; + } + else { + $self->usageAndExit('Invalid use of -t'); + } + } + elsif ($arg =~ /^[\-+]/) { + ## We will ignore unknown options + ## Some options for aCC start with + + } + else { + push(@files, $arg); + } + } + + if (!defined $files[0]) { + if ($needsrc) { + $self->usageAndExit('No files specified'); + } + } + + my $editor = new DependencyEditor(); + return $editor->process($output, $type, $noinline, \%macros, + \@ipaths, \%replace, \%exclude, \@files); +} diff --git a/ACE/MPC/modules/Depgen/MakeDependencyWriter.pm b/ACE/MPC/modules/Depgen/MakeDependencyWriter.pm new file mode 100644 index 00000000000..a10d061996b --- /dev/null +++ b/ACE/MPC/modules/Depgen/MakeDependencyWriter.pm @@ -0,0 +1,43 @@ +package MakeDependencyWriter; + +# ************************************************************ +# Description : Generates generic Makefile dependencies. +# Author : Chad Elliott +# Create Date : 2/10/2002 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; +use DependencyWriter; + +use vars qw(@ISA); +@ISA = qw(DependencyWriter); + +# ************************************************************ +# Data Section +# ************************************************************ + +my $cygwin = (defined $ENV{OS} && $ENV{OS} =~ /windows/i); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub process { + ## Replace whitespace with escaped whitespace. + map(s/(\s)/\\$1/g, @{$_[2]}); + + ## Replace <drive letter>: with /cygdrive/<drive letter>. The user may + ## or may not be using Cygwin, but leaving the colon in there will + ## cause make to fail catastrophically on the next invocation. + map(s/([A-Z]):/\/cygdrive\/$1/gi, @{$_[2]}) if ($cygwin); + + ## Sort the dependencies to make them reproducible. + return "@{$_[1]}: \\\n " . join(" \\\n ", sort @{$_[2]}) . "\n"; +} + + +1; diff --git a/ACE/MPC/modules/Depgen/MakeObjectGenerator.pm b/ACE/MPC/modules/Depgen/MakeObjectGenerator.pm new file mode 100644 index 00000000000..397c6a01abc --- /dev/null +++ b/ACE/MPC/modules/Depgen/MakeObjectGenerator.pm @@ -0,0 +1,43 @@ +package MakeObjectGenerator; + +# ************************************************************ +# Description : Generates object files for generic Makefiles. +# Author : Chad Elliott +# Create Date : 5/23/2003 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; +use ObjectGenerator; + +use vars qw(@ISA); +@ISA = qw(ObjectGenerator); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub process { + my $noext = $_[1]; + my @exts = ('o'); + my @dirs = (defined $ENV{VDIR} ? $ENV{VDIR} : ''); + $noext =~ s/\.[^\.]+$//o; + + push(@exts, $ENV{SOEXT}) if (defined $ENV{SOEXT}); + push(@dirs, $ENV{VSHDIR}) if (defined $ENV{VSHDIR}); + + my @objects; + foreach my $dirs (@dirs) { + foreach my $ext (@exts) { + push(@objects, "$dirs$noext.$ext"); + } + } + + return \@objects; +} + + +1; diff --git a/ACE/MPC/modules/Depgen/NMakeDependencyWriter.pm b/ACE/MPC/modules/Depgen/NMakeDependencyWriter.pm new file mode 100644 index 00000000000..0428a55c176 --- /dev/null +++ b/ACE/MPC/modules/Depgen/NMakeDependencyWriter.pm @@ -0,0 +1,53 @@ +package NMakeDependencyWriter; + +# ************************************************************ +# Description : Generates NMake dependencies. +# Author : Chad Elliott +# Create Date : 2/10/2002 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; +use DependencyWriter; + +use vars qw(@ISA); +@ISA = qw(DependencyWriter); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub process { + my $sources = $_[1]; + my $files = $_[2]; + my $total = 0; + + $$sources[0] =~ s/\//\\/g; + $$sources[0] =~ s/\\\\/\\/g; + my $dep = "$$sources[0] :\\\n"; + + ## Sort the dependencies to make them reproducible + foreach my $file (sort @$files) { + $file =~ s/\//\\/g; + $file =~ s/\\\\/\\/g; + if ($file ne $$sources[0]) { + $dep .= "\t\"$file\"\\\n"; + ++$total; + } + } + + if ($total == 0) { + $dep = ''; + } + else { + $dep .= "\n\n"; + } + + return $dep; +} + + +1; diff --git a/ACE/MPC/modules/Depgen/NMakeObjectGenerator.pm b/ACE/MPC/modules/Depgen/NMakeObjectGenerator.pm new file mode 100644 index 00000000000..e718fa34412 --- /dev/null +++ b/ACE/MPC/modules/Depgen/NMakeObjectGenerator.pm @@ -0,0 +1,51 @@ +# ************************************************************ +# Description : Generates object files for NMake Makefiles. +# Author : Chad Elliott +# Create Date : 5/23/2003 +# ************************************************************ + +package WinProjectBaseEx; + +use WinProjectBase; +use DirectoryManager; + +use vars qw(@ISA); +@ISA = qw(WinProjectBase DirectoryManager); + +sub new { + return bless {}, $_[0]; +} + +1; + + +package NMakeObjectGenerator; + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; +use ObjectGenerator; + +use vars qw(@ISA); +@ISA = qw(ObjectGenerator); + +# ************************************************************ +# Data Section +# ************************************************************ + +my $wpb = new WinProjectBaseEx(); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub process { + my $noext = $wpb->translate_directory($_[1]); + $noext =~ s/\.[^\.]+$//o; + return [ "\"\$(INTDIR)\\$noext.obj\"" ]; +} + + +1; diff --git a/ACE/MPC/modules/Depgen/ObjectGenerator.pm b/ACE/MPC/modules/Depgen/ObjectGenerator.pm new file mode 100644 index 00000000000..1935a5f3b42 --- /dev/null +++ b/ACE/MPC/modules/Depgen/ObjectGenerator.pm @@ -0,0 +1,30 @@ +package ObjectGenerator; + +# ************************************************************ +# Description : Base class for all Object Generators. +# Author : Chad Elliott +# Create Date : 5/23/2003 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub new { + return bless {}, $_[0]; +} + + +sub process { + #my($self, $file) = @_; + return []; +} + + +1; diff --git a/ACE/MPC/modules/Depgen/ObjectGeneratorFactory.pm b/ACE/MPC/modules/Depgen/ObjectGeneratorFactory.pm new file mode 100644 index 00000000000..6f2834a8525 --- /dev/null +++ b/ACE/MPC/modules/Depgen/ObjectGeneratorFactory.pm @@ -0,0 +1,40 @@ +package ObjectGeneratorFactory; + +# ************************************************************ +# Description : Create ObjectGenerator objects. +# Author : Chad Elliott +# Create Date : 5/23/2003 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use ObjectGenerator; + +# ************************************************************ +# Data Section +# ************************************************************ + +my $generators = {}; + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub register { + $generators = shift; +} + + +sub create { + return $$generators{$_[0]}->new() if (defined $$generators{$_[0]}); + + print STDERR "WARNING: Invalid object generator type: $_[0]\n"; + return new ObjectGenerator(); +} + + +1; diff --git a/ACE/MPC/modules/Depgen/Preprocessor.pm b/ACE/MPC/modules/Depgen/Preprocessor.pm new file mode 100644 index 00000000000..4dea2fc4117 --- /dev/null +++ b/ACE/MPC/modules/Depgen/Preprocessor.pm @@ -0,0 +1,145 @@ +package Preprocessor; + +# ************************************************************ +# Description : Preprocesses the supplied file. +# Author : Chad Elliott +# Create Date : 2/10/2002 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; +use FileHandle; +use File::Basename; + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub new { + my($class, $macros, $ipaths, $exclude) = @_; + return bless {'macros' => $macros, + 'ipaths' => $ipaths, + 'exclude' => $exclude, + 'files' => {}, + 'ifound' => {}, + 'recurse' => 0, + }, $class; +} + + +sub process { + my($self, $file, $noinline, $noincs) = @_; + my $fh = new FileHandle(); + + ## Open the file, but if we can't we'll just silently ignore it. + if (open($fh, $file)) { + my @zero; + my $ifcount = 0; + my $files = $self->{'files'}; + my $dir = dirname($file); + + ## We only need to keep track of recursion inside this block + my $recurse = ++$self->{'recurse'}; + + $$files{$file} = []; + while(<$fh>) { + ## As an optimization, use a very simple regular expression on the + ## outside that all of the inner regular expressions have in + ## common. That way we go down the path of if elsif only if it is + ## even possible due to the outside regular expression. + ## index() is faster than a regular expression, so use index first. + next if (index($_, '#') == -1 || not /^\s*#/); + + ## Remove same line c comments (no need to worry about c++ + ## comments due to the regular expressions) inside this if statement. + ## This saves about 5% off of processing the ace directory + ## and we only need to strip comments if we are actually + ## going to look at the string. + $_ =~ s/\/\*.*\*\///o; + + if (/^\s*#\s*endif/) { + --$ifcount; + if (defined $zero[0] && $ifcount == $zero[$#zero]) { + pop(@zero); + } + } + elsif (/^\s*#\s*if\s+0/) { + push(@zero, $ifcount); + ++$ifcount; + } + elsif (/^\s*#\s*if/) { + ++$ifcount; + } + elsif (!defined $zero[0] && + /^\s*#\s*include\s+[<"]([^">]+)[">]/o) { + ## Locate the include file + my $inc; + if (exists $self->{'ifound'}->{$1}) { + $inc = $self->{'ifound'}->{$1}; + } + else { + foreach my $dirp (@{$self->{'ipaths'}}) { + if (-r "$dirp/$1") { + $inc = "$dirp/$1"; + last; + } + } + + if (!defined $inc) { + ## If the file we're currently looking at contains a + ## directory name then, we need to look for include + ## files in that directory. + if (-r "$dir/$1") { + $inc = "$dir/$1"; + } + } + $self->{'ifound'}->{$1} = $inc; + } + + ## If we've found the include file, then process it too. + next if (not defined $inc); + + $inc =~ s/\\/\//go; + if (!$noinline || + ($recurse == 1 || $inc !~ /\.i(nl)?$/o)) { + push(@{$$files{$file}}, $inc); + if (!defined $$files{$inc}) { + ## Process this file, but do not return the include files + if (!defined $self->{'exclude'}->{substr($inc, rindex($inc, '/') + 1)}) { + $self->process($inc, $noinline, 1); + } + } + } + } + } + close($fh); + + ## We only need to keep track of recursion inside this block + --$self->{'recurse'}; + } + + ## This has to be outside the if (open(... + ## If the last file to be processed isn't accessable then + ## we still need to return the array reference of includes. + if (!$noincs) { + my @files = ($file); + my %ifiles; + + foreach my $processed (@files) { + foreach my $inc (@{$self->{'files'}->{$processed}}) { + if (!defined $ifiles{$inc}) { + $ifiles{$inc} = 1; + push(@files, $inc); + } + } + } + shift(@files); + return \@files; + } +} + + +1; diff --git a/ACE/MPC/modules/DirectoryManager.pm b/ACE/MPC/modules/DirectoryManager.pm new file mode 100644 index 00000000000..cd9aa993e51 --- /dev/null +++ b/ACE/MPC/modules/DirectoryManager.pm @@ -0,0 +1,205 @@ +package DirectoryManager; + +# ************************************************************ +# Description : This module provides directory related methods +# Author : Chad Elliott +# Create Date : 5/13/2004 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; +use File::Spec; +use File::Basename; + +# ************************************************************ +# Data Section +# ************************************************************ + +my $onVMS = ($^O eq 'VMS'); +my $case_insensitive = File::Spec->case_tolerant(); +my $cwd = Cwd::getcwd(); +if ($^O eq 'cygwin' && $cwd !~ /[A-Za-z]:/) { + my $cyg = `cygpath -w $cwd`; + if (defined $cyg) { + $cyg =~ s/\\/\//g; + chop($cwd = $cyg); + } + $case_insensitive = 1; +} +elsif ($onVMS) { + $cwd = VMS::Filespec::unixify($cwd); + $cwd =~ s!/$!!g; +} +my $start = $cwd; + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub cd { + my($self, $dir) = @_; + my $status = chdir($dir); + + if ($status && $dir ne '.') { + ## First strip out any /./ or ./ or /. + $dir =~ s/\/\.\//\//g; + $dir =~ s/^\.\///; + $dir =~ s/\/\.$//; + + ## If the new directory contains a relative directory + ## then we just get the real working directory + if (index($dir, '..') >= 0) { + $cwd = Cwd::getcwd(); + if ($^O eq 'cygwin' && $cwd !~ /[A-Za-z]:/) { + ## We're using Cygwin perl, use cygpath to get the windows path + ## and then fix up the slashes. + my $cyg = `cygpath -w $cwd`; + if (defined $cyg) { + $cyg =~ s/\\/\//g; + chop($cwd = $cyg); + } + } + elsif ($onVMS) { + ## On VMS, we nee to get the UNIX style path and remove the + ## trailing slash. + $cwd = VMS::Filespec::unixify($cwd); + $cwd =~ s!/$!!g; + } + } + else { + if ($dir =~ /^(\/|[a-z]:)/i) { + ## It was a full path, just store it. + $cwd = $dir; + } + else { + ## This portion was relative, add it onto the current working + ## directory. + $cwd .= "/$dir"; + } + } + } + return $status; +} + + +sub getcwd { + #my $self = shift; + return $cwd; +} + + +sub getstartdir { + #my $self = shift; + return $start; +} + + +sub mpc_basename { + #my $self = $_[0]; + #my $file = $_[1]; + return substr($_[1], rindex($_[1], '/') + 1); +} + + +sub mpc_dirname { + my($self, $dir) = @_; + + ## The dirname() on VMS doesn't work as we expect it to. + if ($onVMS) { + ## If the directory contains multiple parts, we need to get the + ## dirname in a UNIX style format and then remove the slash from the + ## end. + if (index($dir, '/') >= 0) { + $dir = VMS::Filespec::unixify(dirname($dir)); + $dir =~ s!/$!!g; + return $dir; + } + else { + ## There's no directory portion, so just return '.' + return '.'; + } + } + else { + return dirname($dir); + } +} + + +sub mpc_glob { + my($self, $pattern) = @_; + + ## glob() provided by OpenVMS does not understand [] within + ## the pattern. So, we implement our own through recursive calls + ## to mpc_glob(). + if ($onVMS && $pattern =~ /(.*)\[([^\]]+)\](.*)/) { + my @files; + my($pre, $mid, $post) = ($1, $2, $3); + for(my $i = 0; $i < length($mid); $i++) { + foreach my $new ($self->mpc_glob($pre . substr($mid, $i, 1) . $post)) { + push(@files, $new) if (!StringProcessor::fgrep($new, \@files)); + } + } + return @files; + } + + ## Otherwise, we just return the globbed pattern. + return glob($pattern); +} + + +sub onVMS { + return $onVMS; +} + + +sub path_is_relative { + ## To determine if the path is relative, we just determine if it is not + ## an absolute path. + #my($self, $path) = @_; + return (index($_[1], '/') != 0 && $_[1] !~ /^[A-Z]:\//i); +} + +# ************************************************************ +# Virtual Methods To Be Overridden +# ************************************************************ + +sub translate_directory { + my($self, $dir) = @_; + + ## Remove the current working directory from $dir (if it is contained) + my $cwd = $self->getcwd(); + $cwd =~ s/\//\\/g if ($self->convert_slashes()); + if (index($dir, $cwd) == 0) { + my $cwdl = length($cwd); + return '.' if (length($dir) == $cwdl); + $dir = substr($dir, $cwdl + 1); + } + + ## Translate .. to $dd + if (index($dir, '..') >= 0) { + my $dd = 'dotdot'; + $dir =~ s/^\.\.([\/\\])/$dd$1/; + $dir =~ s/([\/\\])\.\.$/$1$dd/; + $dir =~ s/([\/\\])\.\.([\/\\])/$1$dd$2/g; + $dir =~ s/^\.\.$/$dd/; + } + + return $dir; +} + + +sub convert_slashes { + #my $self = shift; + return 0; +} + + +sub case_insensitive { + #my $self = shift; + return $case_insensitive; +} + +1; diff --git a/ACE/MPC/modules/Driver.pm b/ACE/MPC/modules/Driver.pm new file mode 100644 index 00000000000..231c7cf6499 --- /dev/null +++ b/ACE/MPC/modules/Driver.pm @@ -0,0 +1,636 @@ +package Driver; + +# ************************************************************ +# Description : Functionality to call a workspace or project creator +# Author : Chad Elliott +# Create Date : 5/28/2002 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use Options; +use Parser; +use Version; +use ConfigParser; + +use vars qw(@ISA); +@ISA = qw(Parser Options); + +# ************************************************************ +# Data Section +# ************************************************************ + +my $index = 0; +my @progress = ('|', '/', '-', '\\'); +my %valid_cfg = ('command_line' => 1, + 'default_type' => 1, + 'dynamic_types' => 1, + 'includes' => 1, + 'logging' => 1, + 'main_functions' => 1, + 'verbose_ordering' => 1, + ); +my @intype = ('mwc.pl', 'mpc.pl'); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub new { + my $class = shift; + my $path = shift; + my $name = shift; + my @creators = @_; + my $self = $class->SUPER::new(); + + $self->{'path'} = $path; + $self->{'basepath'} = ::getBasePath(); + $self->{'name'} = $name; + $self->{'type'} = (lc($self->{'name'}) eq $intype[0] ? + 'WorkspaceCreator' : 'ProjectCreator'); + $self->{'types'} = {}; + $self->{'creators'} = \@creators; + $self->{'reldefs'} = {}; + $self->{'relorder'} = []; + + return $self; +} + + +sub workspaces { + return $intype[0]; +} + + +sub projects { + return $intype[1]; +} + + +sub locate_default_type { + my $self = shift; + my $name = lc(shift) . lc($self->{'type'}) . '.pm'; + my $fh = new FileHandle(); + + foreach my $dir (@INC) { + if (opendir($fh, $dir)) { + foreach my $file (readdir($fh)) { + if (lc($file) eq $name) { + $file =~ s/\.pm$//; + return $file; + } + } + closedir($fh); + } + } + + return undef; +} + + +sub locate_dynamic_directories { + my($self, $cfg, $label) = @_; + my $dtypes = $cfg->get_value($label); + + if (defined $dtypes) { + my $count = 0; + my @directories; + my @unprocessed = split(/\s*,\s*/, $cfg->get_unprocessed($label)); + foreach my $dir (split(/\s*,\s*/, $dtypes)) { + if (-d $dir) { + if (-d "$dir/modules" || -d "$dir/config" || -d "$dir/templates") { + push(@directories, $dir); + } + } + elsif (!(defined $unprocessed[$count] && + $unprocessed[$count] =~ s/\$[\(\w\)]+//g && + $unprocessed[$count] eq $dir)) { + $self->diagnostic("'$label' directory $dir not found."); + } + $count++; + } + return \@directories; + } + + return undef; +} + + +sub add_dynamic_creators { + my($self, $dirs) = @_; + my $type = $self->{'type'}; + + foreach my $dir (@$dirs) { + my $fh = new FileHandle(); + if (opendir($fh, "$dir/modules")) { + foreach my $file (readdir($fh)) { + if ($file =~ /(.+$type)\.pm$/i) { + my $name = $1; + if (DirectoryManager::onVMS()) { + my $fh = new FileHandle(); + if (open($fh, $dir . "/modules/" . $file)) { + my $line = <$fh>; + if ($line =~ /^\s*package\s+(.+);/) { + $name = $1; + } + close($fh); + } + } + $self->debug("Pulling in $name"); + push(@{$self->{'creators'}}, $name); + } + } + closedir($fh); + } + } +} + +sub parse_line { + my($self, $ih, $line) = @_; + my $status = 1; + my $errorString; + + if ($line eq '') { + } + elsif ($line =~ /^([\w\*]+)(\s*,\s*(.*))?$/) { + my $name = $1; + my $value = $3; + if (defined $value) { + $value =~ s/^\s+//; + $value =~ s/\s+$//; + } + if ($name =~ s/\*/.*/g) { + foreach my $key (keys %ENV) { + if ($key =~ /^$name$/ && !exists $self->{'reldefs'}->{$key}) { + ## Put this value at the front since it doesn't need + ## to be built up from anything else. It is a stand-alone + ## relative definition. + $self->{'reldefs'}->{$key} = undef; + unshift(@{$self->{'relorder'}}, $key); + } + } + } + else { + $self->{'reldefs'}->{$name} = $value; + if (defined $value) { + ## This relative definition may need to be built up from an + ## existing value, so it needs to be put at the end. + push(@{$self->{'relorder'}}, $name); + } + else { + ## Put this value at the front since it doesn't need + ## to be built up from anything else. It is a stand-alone + ## relative definition. + unshift(@{$self->{'relorder'}}, $name); + } + } + } + else { + $status = 0; + $errorString = "Unrecognized line: $line"; + } + + return $status, $errorString; +} + + +sub optionError { + my($self, $line) = @_; + + $self->printUsage($line, $self->{'name'}, Version::get(), + keys %{$self->{'types'}}); + exit(defined $line ? 1 : 0); +} + + +sub find_file { + my($self, $includes, $file) = @_; + + foreach my $inc (@$includes) { + if (-r $inc . '/' . $file) { + $self->debug("$file found in $inc"); + return $inc . '/' . $file; + } + } + return undef; +} + + +sub determine_cfg_file { + my($self, $cfg, $odir) = @_; + my $ci = $self->case_insensitive(); + + $odir = lc($odir) if ($ci); + foreach my $name (@{$cfg->get_names()}) { + my $value = $cfg->get_value($name); + if (index($odir, ($ci ? lc($name) : $name)) == 0) { + $self->warning("$value does not exist.") if (!-d $value); + my $cfgfile = $value . '/MPC.cfg'; + return $cfgfile if (-e $cfgfile); + } + } + + return undef; +} + + +sub run { + my $self = shift; + my @args = @_; + my $cfgfile; + + ## Save the original directory outside of the loop + ## to avoid calling it multiple times. + my $orig_dir = $self->getcwd(); + + ## Read the code base config file from the config directory + ## under $MPC_ROOT + my $cbcfg = new ConfigParser(); + my $cbfile = "$self->{'basepath'}/config/base.cfg"; + if (-r $cbfile) { + my($status, $error) = $cbcfg->read_file($cbfile); + if (!$status) { + $self->error("$error at line " . $cbcfg->get_line_number() . + " of $cbfile"); + return 1; + } + $cfgfile = $self->determine_cfg_file($cbcfg, $orig_dir); + } + + ## If no MPC config file was found and + ## there is one in the config directory, we will use that. + if (!defined $cfgfile) { + $cfgfile = $self->{'path'} . '/config/MPC.cfg'; + $cfgfile = $self->{'basepath'} . '/config/MPC.cfg' if (!-e $cfgfile); + $cfgfile = undef if (!-e $cfgfile); + } + + ## Read the MPC config file + my $cfg = new ConfigParser(\%valid_cfg); + if (defined $cfgfile) { + my $ellipses = $cfgfile; + $ellipses =~ s!.*(/[^/]+/[^/]+/[^/]+/[^/]+/[^/]+/[^/]+)!...$1!; + $self->diagnostic("Using $ellipses"); + my($status, $error) = $cfg->read_file($cfgfile); + if (!$status) { + $self->error("$error at line " . $cfg->get_line_number() . + " of $cfgfile"); + return 1; + } + OutputMessage::set_levels($cfg->get_value('logging')); + } + + $self->debug("CMD: $0 @ARGV"); + + ## After we read the config file, see if the user has provided + ## dynamic types + my $dynamic = $self->locate_dynamic_directories($cfg, 'dynamic_types'); + if (defined $dynamic) { + ## If so, add in the creators found in the dynamic directories + $self->add_dynamic_creators($dynamic); + + ## Add the each dynamic path to the include paths + foreach my $dynpath (@$dynamic) { + unshift(@INC, $dynpath . '/modules'); + unshift(@args, '-include', "$dynpath/config", + '-include', "$dynpath/templates"); + } + } + + ## Add in the creators found in the main MPC/modules directory + $self->add_dynamic_creators([$self->{'basepath'}]); + + ## Dynamically load in each perl module and set up + ## the type tags and project creators + my $creators = $self->{'creators'}; + foreach my $creator (@$creators) { + my $tag = $self->extractType($creator); + $self->{'types'}->{$tag} = $creator; + } + + ## Before we process the arguments, we will prepend the command_line + ## config variable. + my $cmd = $cfg->get_value('command_line'); + if (defined $cmd) { + my $envargs = $self->create_array($cmd); + unshift(@args, @$envargs); + } + + ## Now add in the includes to the command line arguments. + ## It is done this way to allow the Options module to process + ## the include path as it does all others. + my $incs = $cfg->get_value('includes'); + if (defined $incs) { + foreach my $inc (split(/\s*,\s*/, $incs)) { + ## We must add it to the front so that options provided at the end + ## that require a parameter (but are not given one) do not gobble + ## up the -include option. + unshift(@args, '-include', $inc); + } + } + + my $options = $self->options($self->{'name'}, + $self->{'types'}, + 1, + @args); + + ## If options are not defined, that means that calling options + ## took care of whatever functionality that was required and + ## we can now return with a good status. + return 0 if (!defined $options); + + ## Set up a hash that we can use to keep track of what + ## has been 'required' + my %loaded; + + ## Set up the default creator, if no type is selected + if (!defined $options->{'creators'}->[0]) { + my $utype = $cfg->get_value('default_type'); + if (defined $utype) { + my $default = $self->locate_default_type($utype); + if (defined $default) { + push(@{$options->{'creators'}}, $default); + } + else { + $self->error("Unable to locate the module that corresponds to " . + "the '$utype' type."); + return 1; + } + } + } + + ## If there's still no default, issue an error + if (!defined $options->{'creators'}->[0]) { + $self->error('There is no longer a default project type. Please ' . + 'specify one in MPC.cfg or use the -type option.'); + return 1; + } + + ## Set up additional main functions to recognize + my $val = $cfg->get_value('main_functions'); + if (defined $val) { + foreach my $main (split(/\s*,\s*/, $val)) { + my $err = ProjectCreator::add_main_function($main); + if (defined $err) { + $self->error("$err at line " . $cfg->get_line_number() . + " of $cfgfile"); + return 1; + } + } + } + + if ($options->{'recurse'}) { + if (defined $options->{'input'}->[0]) { + ## This is an error. + ## -recurse was used and input files were specified. + $self->optionError('No files should be ' . + 'specified when using -recurse'); + } + else { + ## We have to load at least one creator here in order + ## to call the generate_recursive_input_list virtual function. + my $name = $options->{'creators'}->[0]; + if (!$loaded{$name}) { + require "$name.pm"; + $loaded{$name} = 1; + } + + ## Generate the recursive input list + my $creator = $name->new(); + my @input = $creator->generate_recursive_input_list( + '.', $options->{'exclude'}); + $options->{'input'} = \@input; + + ## If no files were found above, then we issue a warning + ## that we are going to use the default input + if (!defined $options->{'input'}->[0]) { + $self->information('No files were found using the -recurse option. ' . + 'Using the default input.'); + } + } + } + + ## Add the default include paths. If the user has used the dynamic + ## types method of adding types to MPC, we need to push the paths + ## on. Otherwise, we unshift them onto the front. + if ($self->{'path'} ne $self->{'basepath'}) { + unshift(@{$options->{'include'}}, $self->{'path'} . '/config', + $self->{'path'} . '/templates'); + } + push(@{$options->{'include'}}, $self->{'basepath'} . '/config', + $self->{'basepath'} . '/templates'); + + ## All includes (except the current directory) have been added by this time + $self->debug("INCLUDES: @{$options->{'include'}}"); + + ## Set the global feature file + my $global_feature_file = (defined $options->{'gfeature_file'} && + -r $options->{'gfeature_file'} ? + $options->{'gfeature_file'} : undef); + if (defined $global_feature_file) { + ## If the specified path is relative, expand it based on + ## the current working directory. + if ($global_feature_file !~ /^[\/\\]/ && + $global_feature_file !~ /^[A-Za-z]:[\/\\]?/) { + $global_feature_file = DirectoryManager::getcwd() . '/' . + $global_feature_file; + } + } + else { + my $gf = 'global.features'; + $global_feature_file = $self->find_file($options->{'include'}, $gf); + if (!defined $global_feature_file) { + $global_feature_file = $self->{'basepath'} . '/config/' . $gf; + } + } + + ## Set up default values + push(@{$options->{'input'}}, '') if (!defined $options->{'input'}->[0]); + $options->{'feature_file'} = $self->find_file($options->{'include'}, + 'default.features') + if (!defined $options->{'feature_file'}); + + $options->{'global'} = $self->find_file($options->{'include'}, + 'global.mpb') + if (!defined $options->{'global'}); + + ## Set the relative + my $relative_file = (defined $options->{'relative_file'} && + -r $options->{'relative_file'} ? + $options->{'relative_file'} : undef); + if (!defined $relative_file) { + my $gf = 'default.rel'; + $relative_file = $self->find_file($options->{'include'}, $gf); + if (!defined $relative_file) { + $relative_file = $self->{'basepath'} . '/config/' . $gf; + } + } + if ($options->{'reldefs'}) { + ## Only try to read the file if it exists + if (defined $relative_file) { + my($srel, $errorString) = $self->read_file($relative_file); + if (!$srel) { + $self->error("$errorString\nin $relative_file"); + return 1; + } + + foreach my $key (@{$self->{'relorder'}}) { + if (defined $ENV{$key} && + !defined $options->{'relative'}->{$key}) { + $options->{'relative'}->{$key} = $ENV{$key}; + } + if (defined $self->{'reldefs'}->{$key} && + !defined $options->{'relative'}->{$key}) { + my $value = $self->{'reldefs'}->{$key}; + if ($value =~ /\$(\w+)(.*)?/) { + my $var = $1; + my $extra = $2; + $options->{'relative'}->{$key} = + (defined $options->{'relative'}->{$var} ? + $options->{'relative'}->{$var} : '') . + (defined $extra ? $extra : ''); + } + else { + $options->{'relative'}->{$key} = $value; + } + } + + ## If a relative path is defined, remove all trailing slashes + ## and replace any two or more slashes with a single slash. + if (defined $options->{'relative'}->{$key}) { + $options->{'relative'}->{$key} =~ s/([\/\\])[\/\\]+/$1/g; + $options->{'relative'}->{$key} =~ s/[\/\\]$//g; + } + } + } + + ## Remove MPC_ROOT since we never want to expand it + delete $options->{'relative'}->{'MPC_ROOT'}; + } + + ## Always add the current path to the include paths + unshift(@{$options->{'include'}}, $orig_dir); + + ## Set up un-buffered output for the progress callback + $| = 1; + + ## Keep the starting time for the total output + my $startTime = time(); + my $loopTimes = 0; + + ## Generate the files + my $status = 0; + foreach my $cfile (@{$options->{'input'}}) { + ## To correctly reference any pathnames in the input file, chdir to + ## its directory if there's any directory component to the specified path. + ## mpc_basename() always expects UNIX file format. + $cfile =~ s/\\/\//g; + my $base = ($cfile eq '' ? '' : $self->mpc_basename($cfile)); + + $base = '' if (-d $cfile); + + foreach my $name (@{$options->{'creators'}}) { + ++$loopTimes; + + if (!$loaded{$name}) { + require "$name.pm"; + $loaded{$name} = 1; + } + my $file = $cfile; + my $creator = $name->new($options->{'global'}, + $options->{'include'}, + $options->{'template'}, + $options->{'ti'}, + $options->{'dynamic'}, + $options->{'static'}, + $options->{'relative'}, + $options->{'addtemp'}, + $options->{'addproj'}, + (-t 1 ? \&progress : undef), + $options->{'toplevel'}, + $options->{'baseprojs'}, + $global_feature_file, + $options->{'relative_file'}, + $options->{'feature_file'}, + $options->{'features'}, + $options->{'hierarchy'}, + $options->{'exclude'}, + $options->{'make_coexistence'}, + $options->{'name_modifier'}, + $options->{'apply_project'}, + $options->{'genins'}, + $options->{'into'}, + $options->{'language'}, + $options->{'use_env'}, + $options->{'expand_vars'}, + $options->{'gendot'}, + $options->{'comments'}, + $options->{'for_eclipse'}); + + ## Update settings based on the configuration file + $creator->set_verbose_ordering($cfg->get_value('verbose_ordering')); + + if ($base ne $file) { + my $dir = ($base eq '' ? $file : $self->mpc_dirname($file)); + if (!$creator->cd($dir)) { + $self->error("Unable to change to directory: $dir"); + $status++; + last; + } + $file = $base; + } + my $diag = 'Generating \'' . $self->extractType($name) . + '\' output using '; + if ($file eq '') { + $diag .= 'default input'; + } + else { + my $partial = $self->getcwd(); + my $oescaped = $self->escape_regex_special($orig_dir) . '(/)?'; + $partial =~ s!\\!/!g; + $partial =~ s/^$oescaped//; + $diag .= ($partial ne '' ? "$partial/" : '') . $file; + } + $self->diagnostic($diag); + my $start = time(); + if (!$creator->generate($file)) { + $self->error("Unable to process: " . + ($file eq '' ? 'default input' : $file)); + $status++; + last; + } + my $total = time() - $start; + $self->diagnostic('Generation Time: ' . + (int($total / 60) > 0 ? int($total / 60) . 'm ' : '') . + ($total % 60) . 's'); + $creator->cd($orig_dir); + } + last if ($status); + } + + ## If we went through the loop more than once, we need to print + ## out the total amount of time + if ($loopTimes > 1) { + my $total = time() - $startTime; + $self->diagnostic(' Total Time: ' . + (int($total / 60) > 0 ? int($total / 60) . 'm ' : '') . + ($total % 60) . 's'); + } + + return $status; +} + + +sub progress { + ## This method will be called before each output file is written. + print "$progress[$index]\r"; + $index++; + $index = 0 if ($index > $#progress); +} + + +1; diff --git a/ACE/MPC/modules/EM3ProjectCreator.pm b/ACE/MPC/modules/EM3ProjectCreator.pm new file mode 100644 index 00000000000..280f4cb4f4f --- /dev/null +++ b/ACE/MPC/modules/EM3ProjectCreator.pm @@ -0,0 +1,54 @@ +package EM3ProjectCreator; + +# ************************************************************ +# Description : An eMbedded Visual C++ 3.00 Project Creator +# Author : Chad Elliott +# Create Date : 7/3/2002 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use VC6ProjectCreator; + +use vars qw(@ISA); +@ISA = qw(VC6ProjectCreator); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub project_file_extension { + #my $self = shift; + return '.vcp'; +} + + +sub get_dll_exe_template_input_file { + #my $self = shift; + return 'em3vcpdllexe'; +} + + +sub get_lib_exe_template_input_file { + #my $self = shift; + return 'em3vcplibexe'; +} + + +sub get_lib_template_input_file { + #my $self = shift; + return 'em3vcplib'; +} + + +sub get_dll_template_input_file { + #my $self = shift; + return 'em3vcpdll'; +} + + +1; diff --git a/ACE/MPC/modules/EM3WorkspaceCreator.pm b/ACE/MPC/modules/EM3WorkspaceCreator.pm new file mode 100644 index 00000000000..09e20fdf653 --- /dev/null +++ b/ACE/MPC/modules/EM3WorkspaceCreator.pm @@ -0,0 +1,53 @@ +package EM3WorkspaceCreator; + +# ************************************************************ +# Description : An eMbedded v3 Workspace Creator +# Author : Chad Elliott +# Create Date : 7/3/2002 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use EM3ProjectCreator; +use VC6WorkspaceCreator; + +use vars qw(@ISA); +@ISA = qw(VC6WorkspaceCreator); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + + +sub workspace_file_extension { + #my $self = shift; + return '.vcw'; +} + + +sub pre_workspace { + my($self, $fh) = @_; + my $crlf = $self->crlf(); + + ## This identifies it as a Visual C++ for WinCE file + print $fh 'Microsoft eMbedded Visual Tools Workspace File, Format Version 3.00', $crlf; + + ## Optionally print the workspace comment + $self->print_workspace_comment($fh, + '#', $crlf, + '# $Id$', $crlf, + '#', $crlf, + '# This file was generated by MPC. Any changes made directly to', $crlf, + '# this file will be lost the next time it is generated.', $crlf, + '#', $crlf, + '# MPC Command:', $crlf, + '# ', $self->create_command_line_string($0, @ARGV), $crlf, + $crlf); +} + + +1; diff --git a/ACE/MPC/modules/FeatureParser.pm b/ACE/MPC/modules/FeatureParser.pm new file mode 100644 index 00000000000..e0a5ced6843 --- /dev/null +++ b/ACE/MPC/modules/FeatureParser.pm @@ -0,0 +1,89 @@ +package FeatureParser; + +# ************************************************************ +# Description : Reads the feature files and store the values +# Author : Chad Elliott +# Create Date : 5/21/2003 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use Parser; + +use vars qw(@ISA); +@ISA = qw(Parser); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub new { + my $class = shift; + my $features = shift; + my @files = @_; + my $self = $class->SUPER::new(); + + ## Set the values associative array + $self->{'values'} = {}; + + ## Process each feature file + foreach my $f (@files) { + if (defined $f) { + my($status, $warn) = $self->read_file($f); + if (!$status) { + ## We only want to warn the user about problems + ## with the feature file. + my $lnumber = $self->get_line_number(); + $self->warning($self->mpc_basename($f) . ": line $lnumber: $warn"); + } + } + } + + ## Process each feature definition + foreach my $feature (@$features) { + my($status, $warn) = $self->parse_line(undef, $feature); + ## We only want to warn the user about problems + ## with the -feature option. + $self->warning("-features parameter: $warn") if (!$status); + } + + return $self; +} + + +sub parse_line { + my($self, $if, $line) = @_; + my $error; + + if ($line eq '') { + } + elsif ($line =~ /^(\w+)\s*=\s*(\d+)$/) { + ## This is a valid value, so we can store it. + $self->{'values'}->{lc($1)} = $2; + } + else { + $error = "Unrecognized line: $line"; + } + + return (defined $error ? 0 : 1), $error; +} + + +sub get_names { + my @names = sort keys %{$_[0]->{'values'}}; + return \@names; +} + + +sub get_value { + ## All feature names are case-insensitive. + my($self, $tag) = @_; + return $self->{'values'}->{lc($tag)}; +} + + +1; diff --git a/ACE/MPC/modules/GHSProjectCreator.pm b/ACE/MPC/modules/GHSProjectCreator.pm new file mode 100644 index 00000000000..ab7d9eeea8a --- /dev/null +++ b/ACE/MPC/modules/GHSProjectCreator.pm @@ -0,0 +1,166 @@ +package GHSProjectCreator; + +# ************************************************************ +# Description : A GHS project creator for version 4.x. +# By default, this module assumes Multi will +# be used on Windows. If it is not, you must +# set the MPC_GHS_UNIX environment variable. +# Author : Chad Elliott +# Create Date : 4/19/2002 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use ProjectCreator; + +use vars qw(@ISA); +@ISA = qw(ProjectCreator); + +# ************************************************************ +# Data Section +# ************************************************************ + +my $startre; +my $ghsunix = 'MPC_GHS_UNIX'; + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub convert_slashes { + return (defined $ENV{$ghsunix} ? 0 : 1); +} + + +sub case_insensitive { + return (defined $ENV{$ghsunix} ? 0 : 1); +} + + +sub use_win_compatibility_commands { + return (defined $ENV{$ghsunix} ? 0 : 1); +} + + +sub post_file_creation { + my $self = shift; + + ## These special files are only used if it is a custom only project or + ## there are no source files in the project. + if ((defined $self->get_assignment('custom_only') || + !defined $self->get_assignment('source_files')) && + defined $self->get_assignment('custom_types')) { + my $fh = new FileHandle(); + if (open($fh, '>.custom_build_rule')) { + print $fh ".empty_html_file\n"; + close($fh); + } + if (open($fh, '>.empty_html_file')) { + close($fh); + } + } +} + +sub compare_output { + #my $self = shift; + return 1; +} + + +sub project_file_extension { + #my $self = shift; + return '.gpj'; +} + + +sub fill_value { + my($self, $name) = @_; + my $value; + + if (!defined $startre) { + $startre = $self->escape_regex_special($self->getstartdir()); + } + + ## The Green Hills project format is strange and needs all paths + ## relative to the top directory, no matter where the source files + ## reside. The template uses reltop_ in front of the real project + ## settings, so we get the value of the real keyword and then do some + ## adjusting to get it relative to the top directory. + if ($name =~ /^reltop_(\w+)/) { + $value = $self->relative($self->get_assignment($1)); + if (defined $value) { + my $part = $self->getcwd(); + $part =~ s/^$startre[\/]?//; + if ($part ne '') { + if ($value eq '.') { + $value = $part; + } + else { + $value = $part . '/' . $value; + } + } + } + } + elsif ($name eq 'reltop') { + $value = $self->getcwd(); + $value =~ s/^$startre[\/]?//; + $value = '.' if ($value eq ''); + } + elsif ($name eq 'slash') { + ## We need to override the slash value so that we can give the right + ## value for Windows or UNIX. + $value = (defined $ENV{$ghsunix} ? '/' : '\\'); + } + elsif ($name eq 'postmkdir') { + ## If we're on Windows, we need an "or" command that will reset the + ## errorlevel so that a mkdir on a directory that already exists + ## doesn't cause the build to cease. + $value = ' || type nul' if (!defined $ENV{$ghsunix}); + } + + return $value; +} + +sub get_dll_exe_template_input_file { + #my $self = shift; + return 'ghsdllexe'; +} + + +sub get_lib_exe_template_input_file { + #my $self = shift; + return 'ghslibexe'; +} + + +sub get_lib_template_input_file { + #my $self = shift; + return 'ghslib'; +} + + +sub get_dll_template_input_file { + #my $self = shift; + return 'ghsdll'; +} + + +sub get_properties { + my $self = shift; + + ## Get the base class properties and add the properties that we + ## support. + my $props = $self->ProjectCreator::get_properties(); + + ## This project creator can work for UNIX and Windows. Set the + ## property based on the environment variable. + $$props{'windows'} = 1 if (!defined $ENV{$ghsunix}); + + return $props; +} + +1; diff --git a/ACE/MPC/modules/GHSWorkspaceCreator.pm b/ACE/MPC/modules/GHSWorkspaceCreator.pm new file mode 100644 index 00000000000..9236b1cb5d7 --- /dev/null +++ b/ACE/MPC/modules/GHSWorkspaceCreator.pm @@ -0,0 +1,199 @@ +package GHSWorkspaceCreator; + +# ************************************************************ +# Description : A GHS Workspace creator for version 4.x +# Author : Chad Elliott +# Create Date : 7/3/2002 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use GHSProjectCreator; +use WorkspaceCreator; + +use vars qw(@ISA); +@ISA = qw(WorkspaceCreator); + +# ************************************************************ +# Data Section +# ************************************************************ + +my %directives = ('I' => 1, + 'L' => 1, + 'D' => 1, + 'l' => 1, + 'G' => 1, + 'non_shared' => 1, + 'bsp' => 1, + 'os_dir' => 1, + ); +my $tgt; +my $integrity = '[INTEGRITY Application]'; +my @integ_bsps; + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub compare_output { + #my $self = shift; + return 1; +} + + +sub workspace_file_name { + return $_[0]->get_modified_workspace_name('default', '.gpj'); +} + + +sub pre_workspace { + my($self, $fh) = @_; + my $crlf = $self->crlf(); + my $prjs = $self->get_projects(); + + ## Take the primaryTarget from the first project in the list + if (defined $$prjs[0]) { + my $fh = new FileHandle(); + my $outdir = $self->get_outdir(); + if (open($fh, "$outdir/$$prjs[0]")) { + while(<$fh>) { + if (/^#primaryTarget=(.+)$/) { + $tgt = $1; + last; + } + } + close($fh); + } + } + + ## Print out the preliminary information + print $fh "#!gbuild$crlf", + "primaryTarget=$tgt$crlf", + "[Project]$crlf", + "\t--one_instantiation_per_object$crlf", + "\t:sourceDir=.$crlf", + "\t--std$crlf", + "\t-language=cxx$crlf", + "\t--long_long$crlf", + "\t--new_style_casts$crlf"; +} + + +sub create_integrity_project { + my($self, $int_proj, $project, $type, $target) = @_; + my $outdir = $self->get_outdir(); + my $crlf = $self->crlf(); + my $fh = new FileHandle(); + my $int_file = $int_proj; + $int_file =~ s/\.gpj$/.int/; + + if (open($fh, ">$outdir/$int_proj")) { + ## First print out the project file + print $fh "#!gbuild$crlf", + "\t$integrity$crlf", + "$project\t\t$type$crlf", + "$int_file$crlf"; + foreach my $bsp (@integ_bsps) { + print $fh "$bsp$crlf"; + } + close($fh); + + ## Next create the integration file + if (open($fh, ">$outdir/$int_file")) { + print $fh "Kernel$crlf", + "\tFilename\t\t\tDynamicDownload$crlf", + "EndKernel$crlf$crlf", + "AddressSpace$crlf", + "\tFilename\t\t\t$target$crlf", + "\tLanguage\t\t\tC++$crlf", + "\tLibrary\t\t\t\tlibINTEGRITY.so$crlf", + "\tLibrary\t\t\t\tlibc.so$crlf", + "\tLibrary\t\t\t\tlibscxx_e.so$crlf", + "\tTask Initial$crlf", + "\t\tStackLength\t\t0x8000$crlf", + "\tEndTask$crlf", + "EndAddressSpace$crlf"; + close($fh); + } + } +} + + +sub mix_settings { + my($self, $project) = @_; + my $rh = new FileHandle(); + my $mix = $project; + my $outdir = $self->get_outdir(); + + ## Things that seem like they should be set in the project + ## actually have to be set in the controlling project file. + if (open($rh, "$outdir/$project")) { + my $crlf = $self->crlf(); + my $integrity_project = (index($tgt, 'integrity') >= 0); + my($int_proj, $int_type, $target); + + while(<$rh>) { + if (/^\s*(\[(Program|Library|Subproject)\])\s*$/) { + my $type = $1; + if ($integrity_project && $type eq '[Program]') { + $int_proj = $project; + $int_proj =~ s/(\.gpj)$/_int$1/; + $int_type = $type; + $mix =~ s/(\.gpj)$/_int$1/; + $type = $integrity; + } + $mix .= "\t\t$type$crlf" . + "\t-object_dir=" . $self->mpc_dirname($project) . + '/.obj' . $crlf; + } + elsif (/^\s*(\[Shared Object\])\s*$/) { + $mix .= "\t\t$1$crlf" . + "\t-pic$crlf" . + "\t-object_dir=" . $self->mpc_dirname($project) . + '/.shobj' . $crlf; + } + elsif ($integrity_project && /^(.*\.bsp)\s/) { + push(@integ_bsps, $1); + } + else { + if (/^\s*\-((\w)\w*)/) { + ## Save the required options into the mixed project string + if (defined $directives{$2} || defined $directives{$1}) { + $mix .= $_; + } + + ## If this is an integrity project, we need to find out + ## what the output file will be for the integrate file. + if (defined $int_proj && /^\s*\-o\s+(.*)\s$/) { + $target = $1; + } + } + } + } + if (defined $int_proj) { + $self->create_integrity_project($int_proj, $project, + $int_type, $target); + } + close($rh); + } + + return $mix; +} + + +sub write_comps { + my($self, $fh) = @_; + + ## Print out each projet + foreach my $project ($self->sort_dependencies($self->get_projects(), 0)) { + print $fh $self->mix_settings($project); + } +} + + + +1; diff --git a/ACE/MPC/modules/GUID.pm b/ACE/MPC/modules/GUID.pm new file mode 100644 index 00000000000..0f4a29b709a --- /dev/null +++ b/ACE/MPC/modules/GUID.pm @@ -0,0 +1,48 @@ +package GUID; + +# ************************************************************ +# Description : Generate GUID's for VC7 projects and workspaces +# Author : Chad Elliott +# Create Date : 5/14/2002 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub generate { + my($out, $in, $cwd) = @_; + my $chash = GUID::hash($cwd); + my $nhash = GUID::hash($out); + my $ihash = GUID::hash($in); + my $val = 0xfeca1bad; + + return sprintf("%08X-%04X-%04X-%04X-%04X%08X", + $nhash & 0xffffffff, ($val >> 16) & 0xffff, + ($val & 0xffff), ($ihash >> 16) & 0xffff, + $ihash & 0xffff, $chash & 0xffffffff); +} + + +sub hash { + my $str = shift; + my $value = 0; + + if (defined $str) { + my $length = length($str); + for(my $i = 0; $i < $length; $i++) { + $value = (($value << 4) & 0xffffffff) ^ ($value >> 28) + ^ ord(substr($str, $i, 1)); + } + } + + return $value; +} + +1; diff --git a/ACE/MPC/modules/HTMLProjectCreator.pm b/ACE/MPC/modules/HTMLProjectCreator.pm new file mode 100644 index 00000000000..00e49087393 --- /dev/null +++ b/ACE/MPC/modules/HTMLProjectCreator.pm @@ -0,0 +1,133 @@ +package HTMLProjectCreator; + +# ************************************************************ +# Description : An HTML project creator to display all settings +# Author : Justin Michel & Chad Elliott +# Create Date : 8/25/2003 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use ProjectCreator; +use XMLProjectBase; + +use vars qw(@ISA); +@ISA = qw(XMLProjectBase ProjectCreator); + +# ************************************************************ +# Data Section +# ************************************************************ + +my $style_indent = .5; + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub file_sorter { + #my $self = shift; + #my $left = shift; + #my $right = shift; + return lc($_[1]) cmp lc($_[2]); +} + + +sub label_nodes { + my($self, $hash, $nodes, $level) = @_; + + foreach my $key (sort keys %$hash) { + push(@$nodes, [$level, $key]); + $self->label_nodes($$hash{$key}, $nodes, $level + 1); + } +} + + +sub count_levels { + my($self, $hash, $current, $count) = @_; + + foreach my $key (keys %$hash) { + $self->count_levels($$hash{$key}, $current + 1, $count); + } + $$count = $current if ($current > $$count); +} + + +sub fill_value { + my($self, $name) = @_; + my $value; + + if ($name eq 'inheritance_nodes') { + ## Get the nodes with numeric labels for the level + my @nodes; + $self->label_nodes($self->get_inheritance_tree(), \@nodes, 0); + + ## Push each node onto the value array + $value = []; + for(my $i = 0; $i <= $#nodes; ++$i) { + my $file = $nodes[$i]->[1]; + my $dir = $self->mpc_dirname($file); + my $base = $self->mpc_basename($file); + + ## Relative paths do not work at all in a web browser + $file = $base if ($dir eq '.'); + + my $path = ($base eq $file ? $self->getcwd() . '/' : ''); + my $name; + + if ($i == 0) { + ## If this is the first node, then replace the base filename + ## with the actual project name. + $name = $self->project_name(); + } + else { + ## This is a base project, so we use the basename and + ## remove the file extension. + $name = $base; + $name =~ s/\.[^\.]+$//; + } + + ## Create the div and a tags. + push(@$value, '<a href="file://' . $path . $file . + '" onClick="return popup(this, \'Project File\')" ' . + 'target=_blank>' . + '<div class="tree' . $nodes[$i]->[0] . '">' . + $name . '</div></a>'); + } + } + elsif ($name eq 'tree_styles') { + ## Count the number of levels deep the inheritance goes + my $count = 0; + $self->count_levels($self->get_inheritance_tree(), 0, \$count); + + my $margin = 0; + my $start = 100; + my $max = 255; + my $inc = ($count ne 0 ? int(($max - $start) / $count) : $max); + + ## Push each tree style onto the value array + $value = []; + for(my $i = 0; $i < $count; ++$i) { + push(@$value, ".tree$i { background-color: #" . + sprintf("%02x%02x%02x", 0, $start, $start) . ';' . + ($margin != 0 ? " margin-left: $margin" . 'in;' : '') . + ' }'); + $start += $inc; + $margin += $style_indent; + } + } + + return $value; +} + + +sub project_file_extension { + #my $self = shift; + return '.html'; +} + + +1; diff --git a/ACE/MPC/modules/HTMLWorkspaceCreator.pm b/ACE/MPC/modules/HTMLWorkspaceCreator.pm new file mode 100644 index 00000000000..de4c727bbe6 --- /dev/null +++ b/ACE/MPC/modules/HTMLWorkspaceCreator.pm @@ -0,0 +1,90 @@ +package HTMLWorkspaceCreator; + +# ************************************************************ +# Description : An html workspace creator +# Author : Justin Michel +# Create Date : 8/25/2003 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use HTMLProjectCreator; +use WorkspaceCreator; + +use vars qw(@ISA); +@ISA = qw(WorkspaceCreator); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub workspace_file_extension { + #my $self = shift; + return '_workspace.html'; +} + + +sub pre_workspace { + my($self, $fh) = @_; + my $crlf = $self->crlf(); + + ## Print the header + print $fh '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">', $crlf, + '<html>', $crlf; + + ## Next, goes the workspace comment + $self->print_workspace_comment($fh, + '<!-- $Id$ -->', $crlf, + '<!-- MPC Command: -->', $crlf, + '<!-- ', $self->create_command_line_string($0, @ARGV),' -->', $crlf); + + ## Then, comes the title and the CSS settings. + print $fh '<head>', $crlf, + '<title>', $self->get_workspace_name(), '</title>', $crlf, + ' <style type="text/css">', $crlf, + ' a {font: 12pt bold verdana, lucida; color: white; padding: 3px;}', $crlf, + ' td {font: 12pt bold verdana, lucida; color: white; padding: 3px; background-color: cadetblue;}', $crlf, + ' thead tr td {font: 18pt "trebuchet ms", helvetica; color: white; padding: 3px; background-color: teal;}', $crlf, + ' </style>', $crlf, + '</head>', $crlf, + '<body>', $crlf; +} + + +sub write_comps { + my($self, $fh, $creator) = @_; + my $crlf = $self->crlf(); + + ## Start the table for all of the projects + print $fh "<table style=\"table-layout:fixed\" width=\"400\" " . + "summary=\"MPC Projects\">$crlf" . + "<col style=\"background-color: darkcyan;\">$crlf" . + "<thead>$crlf" . + "<tr><td>Projects In Build Order</td></tr>$crlf" . + "</thead>$crlf" . + "<tbody>$crlf"; + + ## Sort the projects in build order instead of alphabetical order + my $project_info = $self->get_project_info(); + foreach my $project ($self->sort_dependencies($self->get_projects(), 0)) { + print $fh "<tr><td>" . + "<a href='$project'>$$project_info{$project}->[0]</a>" . + "</td></tr>$crlf"; + } + + ## End the table + print $fh "</tbody></table>"; +} + + +sub post_workspace { + my($self, $fh) = @_; + print $fh "</body></html>" . $self->crlf(); +} + + +1; diff --git a/ACE/MPC/modules/MPC.pm b/ACE/MPC/modules/MPC.pm new file mode 100644 index 00000000000..7a99498143d --- /dev/null +++ b/ACE/MPC/modules/MPC.pm @@ -0,0 +1,41 @@ +package MPC; + +# ****************************************************************** +# Description : Instantiate a Driver and run it. This is here to +# maintain backward compatibility. +# Author : Chad Elliott +# Create Date : 1/30/2004 +# ****************************************************************** + +# ****************************************************************** +# Pragma Section +# ****************************************************************** + +use strict; +use Driver; + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub new { + my $class = shift; + my $self = bless {'creators' => [], + }, $class; + return $self; +} + + +sub getCreatorList { + return $_[0]->{'creators'}; +} + + +sub execute { + my($self, $base, $name, $args) = @_; + my $driver = new Driver($base, $name, @{$self->{'creators'}}); + return $driver->run(@$args); +} + + +1; diff --git a/ACE/MPC/modules/MWC.pm b/ACE/MPC/modules/MWC.pm new file mode 100644 index 00000000000..85d589b9bbc --- /dev/null +++ b/ACE/MPC/modules/MWC.pm @@ -0,0 +1,41 @@ +package MWC; + +# ****************************************************************** +# Description : Instantiate a Driver and run it. This is here to +# maintain backward compatibility. +# Author : Chad Elliott +# Create Date : 1/30/2004 +# ****************************************************************** + +# ****************************************************************** +# Pragma Section +# ****************************************************************** + +use strict; +use Driver; + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub new { + my $class = shift; + my $self = bless {'creators' => [], + }, $class; + return $self; +} + + +sub getCreatorList { + return $_[0]->{'creators'}; +} + + +sub execute { + my($self, $base, $name, $args) = @_; + my $driver = new Driver($base, $name, @{$self->{'creators'}}); + return $driver->run(@$args); +} + + +1; diff --git a/ACE/MPC/modules/MakeProjectBase.pm b/ACE/MPC/modules/MakeProjectBase.pm new file mode 100644 index 00000000000..cc84ca8f566 --- /dev/null +++ b/ACE/MPC/modules/MakeProjectBase.pm @@ -0,0 +1,51 @@ +package MakeProjectBase; + +# ************************************************************ +# Description : A Make Project base module +# Author : Chad Elliott +# Create Date : 1/4/2005 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub dollar_special { + #my $self = shift; + return 1; +} + + +sub sort_files { + #my $self = shift; + return (defined $ENV{MPC_ALWAYS_SORT}); +} + + +sub project_file_prefix { + #my $self = shift; + return 'Makefile.'; +} + + +sub get_properties { + my $self = shift; + + ## Get the base class properties and add the properties that we + ## support. + my $props = $self->ProjectCreator::get_properties(); + + ## All projects that use this base class are 'make' based. + $$props{'make'} = 1; + + return $props; +} + + +1; diff --git a/ACE/MPC/modules/MakeProjectCreator.pm b/ACE/MPC/modules/MakeProjectCreator.pm new file mode 100644 index 00000000000..3c589fed6cc --- /dev/null +++ b/ACE/MPC/modules/MakeProjectCreator.pm @@ -0,0 +1,105 @@ +package MakeProjectCreator; + +# ************************************************************ +# Description : A Generic Make Project Creator +# Author : Chad Elliott +# Create Date : 2/18/2003 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use MakeProjectBase; +use ProjectCreator; + +use vars qw(@ISA); +@ISA = qw(MakeProjectBase ProjectCreator); + +# ************************************************************ +# Data Section +# ************************************************************ + +my %info = (Creator::cplusplus => {'dllexe' => 'makeexe', + 'dll' => 'makedll', + 'template' => 'make', + }, + Creator::csharp => {'dllexe' => 'make.net', + 'dll' => 'make.net', + 'template' => 'make.net', + }, + Creator::java => {'dllexe' => 'makeexe', + 'dll' => 'makedll', + 'template' => 'make', + }, + Creator::vb => {'dllexe' => 'make.net', + 'dll' => 'make.net', + 'template' => 'make.net', + }, + ); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub languageSupported { + return defined $info{$_[0]->get_language()}; +} + + +sub escape_spaces { + #my $self = shift; + return 1; +} + + +sub get_dll_exe_template_input_file { + return $info{$_[0]->get_language()}->{'dllexe'}; +} + + +sub get_dll_template_input_file { + return $info{$_[0]->get_language()}->{'dll'}; +} + + +sub get_template { + return $info{$_[0]->get_language()}->{'template'}; +} + +sub fill_value { + my($self, $name) = @_; + + if ($name eq 'compilers') { + ## The default compilers template variable value is determined by the + ## language and directly corresponds to a group of settings in the + ## .mpt file (make.net.mpt for csharp and makedll.mpt for all + ## others). + my $language = $self->get_language(); + if ($language eq Creator::java) { + return 'java'; + } + elsif ($language eq Creator::csharp) { + return 'gmcs'; + } + else { + return 'gcc'; + } + } + elsif ($name eq 'language') { + ## Allow the language to be available to the template. Certain + ## things are not used in make.mpd when the language is java. + return $self->get_language(); + } + elsif ($name eq 'main') { + ## The main is needed when generating the makefiles for use with gcj. + my @sources = $self->get_component_list('source_files', 1); + my $exename = $self->find_main_file(\@sources); + return $exename if (defined $exename); + } + + return undef; +} +1; diff --git a/ACE/MPC/modules/MakeWorkspaceBase.pm b/ACE/MPC/modules/MakeWorkspaceBase.pm new file mode 100644 index 00000000000..35a78667191 --- /dev/null +++ b/ACE/MPC/modules/MakeWorkspaceBase.pm @@ -0,0 +1,343 @@ +package MakeWorkspaceBase; + +# ************************************************************ +# Description : A Make Workspace base module +# Author : Chad Elliott +# Create Date : 11/21/2006 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub targets { + return $_[0]->{'make_targets'}; +} + +sub workspace_file_prefix { + #my $self = shift; + return 'Makefile'; +} + + +sub workspace_file_extension { + #my $self = shift; + return ''; +} + + +sub supports_make_coexistence { + return ($_[0]->workspace_file_extension() ne ''); +} + + +sub workspace_file_name { + my $self = shift; + return $self->get_modified_workspace_name( + $self->workspace_file_prefix(), + $self->make_coexistence() ? + $self->workspace_file_extension() : ''); +} + + +sub workspace_per_project { + #my $self = shift; + return 1; +} + + +sub workspace_preamble { + my($self, $fh, $crlf, $name, $id) = @_; + + ## Optionally print the workspace comment + $self->print_workspace_comment($fh, + '#----------------------------------------------------------------------------', $crlf, + '# ', $name, $crlf, + '#', $crlf, + '# ', $id, $crlf, + '#', $crlf, + '# This file was generated by MPC. Any changes made directly to', $crlf, + '# this file will be lost the next time it is generated.', $crlf, + '#', $crlf, + '# MPC Command:', $crlf, + '# ', $self->create_command_line_string($0, @ARGV), $crlf, + '#', $crlf, + '#----------------------------------------------------------------------------', $crlf, + $crlf); +} + + +sub write_named_targets { + my($self, $fh, $crlf, $targnum, $list, $remain, $targpre, $allpre, $trans, $phony, $andsym, $maxline) = @_; + + ## Save the targets for later + $self->{'make_targets'} = $remain; + + ## Print out the "all" target + if (defined $maxline) { + my $all = 'all:'; + foreach my $project (@$list) { + $all .= " $$trans{$project}"; + } + if (length($all) < $maxline) { + print $fh $crlf, $all; + } + else { + $remain = 'all ' . $remain; + } + } + else { + print $fh $crlf . 'all:'; + foreach my $project (@$list) { + print $fh " $$trans{$project}"; + } + } + + ## Print out all other targets here + print $fh "$crlf$crlf$remain:$crlf"; + $self->write_project_targets($fh, $crlf, + $targpre . '$(@)', $list, $andsym); + + ## Print out each target separately + foreach my $project (@$list) { + print $fh ($phony ? "$crlf.PHONY: $$trans{$project}" : ''), + $crlf, $$trans{$project}, ':'; + if (defined $$targnum{$project}) { + foreach my $number (@{$$targnum{$project}}) { + print $fh " $$trans{$$list[$number]}"; + } + } + print $fh $crlf; + $self->write_project_targets($fh, $crlf, + $targpre . $allpre . 'all', + [ $project ], $andsym); + } + + ## Print out the project_name_list target + print $fh $crlf, "project_name_list:$crlf"; + foreach my $project (sort @$list) { + print $fh "\t\@echo $$trans{$project}$crlf"; + } +} + + +sub post_workspace { + my($self, $wsfh, $creator, $toplevel) = @_; + + if ($toplevel && $self->{'for_eclipse'}) { + my $crlf = $self->crlf(); + my $outdir = $self->get_outdir(); + my $fh = new FileHandle(); + my $outfile = "$outdir/.cdtproject"; + my $pjt = $self->get_eclipse_cdtproject(); + + if (open($fh, ">$outfile")) { + ## We want to set the make command to nmake for the nmake project + ## type. As far as stopping on an error, I don't remember why this + ## is true only for Borland make. + my $cmd = ("$self" =~ /^nmake/i ? 'nmake' : 'make'); + my $stop = ("$self" =~ /^bmake/i ? 'true' : 'false'); + print $fh $$pjt[0]; + foreach my $target ('all', + grep(/^[\w\-]+$/, split(/\s+/, $self->targets()))) { + print $fh ' <target name="', $target, '" path="" targetID="org.eclipse.cdt.make.MakeTargetBuilder">', $crlf, + ' <buildCommand>', $cmd, '</buildCommand>', $crlf, + ' <buildArguments></buildArguments>', $crlf, + ' <buildTarget>', $target, '</buildTarget> ', $crlf, + ' <stopOnError>', $stop, '</stopOnError>', $crlf, + ' <useDefaultCommand>false</useDefaultCommand>', $crlf, + ' </target>', $crlf; + } + print $fh $$pjt[1]; + close($fh); + } + else { + $self->warning("Unable to create $outfile"); + } + + ## Create the eclipse project which is unchanging except for the name + ## of the starting makefile. + $pjt = $self->get_eclipse_project(); + $outfile = "$outdir/.project"; + if (open($fh, ">$outfile")) { + print $fh $$pjt[0], $self->get_workspace_name(), $$pjt[1]; + close($fh); + } + else { + $self->warning("Unable to create $outfile"); + } + } +} + + +sub get_eclipse_cdtproject { + my $self = shift; + if (!defined $self->{'eclipse_cdtproject'}) { + $self->{'eclipse_cdtproject'} = [ +'<?xml version="1.0" encoding="UTF-8"?> +<?eclipse-cdt version="2.0"?> +<cdtproject id="org.eclipse.cdt.make.core.make"> + <extension id="org.eclipse.cdt.core.ELF" point="org.eclipse.cdt.core.BinaryParser"/> + <extension id="org.eclipse.cdt.core.nullindexer" point="org.eclipse.cdt.core.CIndexer"/> + <data> + <item id="scannerConfiguration"> + <autodiscovery enabled="true" problemReportingEnabled="true" selectedProfileId="org.eclipse.cdt.make.core.GCCStandardMakePerProjectProfile"/> + <profile id="org.eclipse.cdt.make.core.GCCStandardMakePerProjectProfile"> + <buildOutputProvider> + <openAction enabled="true" filePath=""/> + <parser enabled="true"/> + </buildOutputProvider> + </profile> + <profile id="org.eclipse.cdt.managedbuilder.core.GCCManagedMakePerProjectProfile"> + <buildOutputProvider> + <openAction enabled="false" filePath=""/> + <parser enabled="false"/> + </buildOutputProvider> + <scannerInfoProvider id="specsFile"> + <runAction arguments="-E -P -v -dD ${plugin_state_location}/${specs_file}" command="gcc" useDefault="true"/> + <parser enabled="false"/> + </scannerInfoProvider> + </profile> + <profile id="org.eclipse.cdt.managedbuilder.core.GCCWinManagedMakePerProjectProfile"> + <buildOutputProvider> + <openAction enabled="false" filePath=""/> + <parser enabled="false"/> + </buildOutputProvider> + <scannerInfoProvider id="specsFile"> + <runAction arguments="-E -P -v -dD ${plugin_state_location}/${specs_file}" command="gcc" useDefault="true"/> + <parser enabled="false"/> + </scannerInfoProvider> + </profile> + <profile id="org.eclipse.cdt.make.core.GCCStandardMakePerFileProfile"> + <buildOutputProvider> + <openAction enabled="false" filePath=""/> + <parser enabled="false"/> + </buildOutputProvider> + <scannerInfoProvider id="makefileGenerator"> + <runAction arguments="-f ${project_name}_scd.mk" command="make" useDefault="true"/> + <parser enabled="false"/> + </scannerInfoProvider> + </profile> + </item> + <item id="org.eclipse.cdt.core.pathentry"> + <pathentry kind="src" path=""/> + <pathentry kind="out" path=""/> + <pathentry kind="con" path="org.eclipse.cdt.make.core.DISCOVERED_SCANNER_INFO"/> + </item> + <item id="org.eclipse.cdt.make.core.buildtargets"> + <buildTargets> +', + +' </buildTargets> + </item> + </data> +</cdtproject> +']; + } + return $self->{'eclipse_cdtproject'}; +} + + +sub get_eclipse_project { + my $self = shift; + if (!defined $self->{'eclipse_project'}) { + $self->{'eclipse_project'} = [ +'<?xml version="1.0" encoding="UTF-8"?> +<projectDescription> + <name>', +'</name> + <comment></comment> + <projects> + </projects> + <buildSpec> + <buildCommand> + <name>org.eclipse.cdt.make.core.makeBuilder</name> + <triggers>clean,full,incremental,</triggers> + <arguments> + <dictionary> + <key>org.eclipse.cdt.make.core.build.arguments</key> + <value></value> + </dictionary> + <dictionary> + <key>org.eclipse.cdt.core.errorOutputParser</key> + <value>org.eclipse.cdt.core.MakeErrorParser;org.eclipse.cdt.core.GCCErrorParser;org.eclipse.cdt.core.GASErrorParser;org.eclipse.cdt.core.GLDErrorParser;org.eclipse.cdt.core.VCErrorParser;</value> + </dictionary> + <dictionary> + <key>org.eclipse.cdt.make.core.enableAutoBuild</key> + <value>false</value> + </dictionary> + <dictionary> + <key>org.eclipse.cdt.make.core.environment</key> + <value></value> + </dictionary> + <dictionary> + <key>org.eclipse.cdt.make.core.enableFullBuild</key> + <value>true</value> + </dictionary> + <dictionary> + <key>org.eclipse.cdt.make.core.build.target.inc</key> + <value>all</value> + </dictionary> + <dictionary> + <key>org.eclipse.cdt.make.core.enabledIncrementalBuild</key> + <value>true</value> + </dictionary> + <dictionary> + <key>org.eclipse.cdt.make.core.build.target.clean</key> + <value>clean</value> + </dictionary> + <dictionary> + <key>org.eclipse.cdt.make.core.build.command</key> + <value>make</value> + </dictionary> + <dictionary> + <key>org.eclipse.cdt.make.core.enableCleanBuild</key> + <value>true</value> + </dictionary> + <dictionary> + <key>org.eclipse.cdt.make.core.append_environment</key> + <value>true</value> + </dictionary> + <dictionary> + <key>org.eclipse.cdt.make.core.build.target.full</key> + <value>clean all</value> + </dictionary> + <dictionary> + <key>org.eclipse.cdt.make.core.useDefaultBuildCmd</key> + <value>true</value> + </dictionary> + <dictionary> + <key>org.eclipse.cdt.make.core.build.target.auto</key> + <value>all</value> + </dictionary> + <dictionary> + <key>org.eclipse.cdt.make.core.stopOnError</key> + <value>false</value> + </dictionary> + </arguments> + </buildCommand> + <buildCommand> + <name>org.eclipse.cdt.make.core.ScannerConfigBuilder</name> + <arguments> + </arguments> + </buildCommand> + </buildSpec> + <natures> + <nature>org.eclipse.cdt.core.cnature</nature> + <nature>org.eclipse.cdt.make.core.makeNature</nature> + <nature>org.eclipse.cdt.make.core.ScannerConfigNature</nature> + <nature>org.eclipse.cdt.core.ccnature</nature> + </natures> +</projectDescription> +']; + } + return $self->{'eclipse_project'}; +} + +1; diff --git a/ACE/MPC/modules/MakeWorkspaceCreator.pm b/ACE/MPC/modules/MakeWorkspaceCreator.pm new file mode 100644 index 00000000000..fe3c0d05c73 --- /dev/null +++ b/ACE/MPC/modules/MakeWorkspaceCreator.pm @@ -0,0 +1,71 @@ +package MakeWorkspaceCreator; + +# ************************************************************ +# Description : A Generic Workspace (Makefile) creator +# Author : Chad Elliott +# Create Date : 2/18/2003 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use MakeProjectCreator; +use MakeWorkspaceBase; +use WorkspaceCreator; + +use vars qw(@ISA); +@ISA = qw(MakeWorkspaceBase WorkspaceCreator); + +# ************************************************************ +# Data Section +# ************************************************************ + +my $targets = 'clean depend generated realclean $(CUSTOM_TARGETS)'; + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub write_project_targets { + my($self, $fh, $crlf, $target, $list) = @_; + + ## Print out a make command for each project + foreach my $project (@$list) { + my $dname = $self->mpc_dirname($project); + my $chdir = ($dname ne '.'); + print $fh "\t\@", + ($chdir ? "cd $dname && " : ''), + "\$(MAKE) -f ", + ($chdir ? $self->mpc_basename($project) : $project), + " $target$crlf"; + } +} + +sub pre_workspace { + my($self, $fh) = @_; + $self->workspace_preamble($fh, $self->crlf(), 'Make Workspace', + '$Id$'); +} + + +sub write_comps { + my($self, $fh) = @_; + my %targnum; + my @list = $self->number_target_deps($self->get_projects(), + $self->get_project_info(), + \%targnum, 0); + + ## Send all the information to our base class method + $self->write_named_targets($fh, $self->crlf(), \%targnum, \@list, + ($self->languageIs(Creator::csharp) ? + 'bundle ' : '') . $targets, '', 'generated ', + $self->project_target_translation(1), 1); +} + + + + +1; diff --git a/ACE/MPC/modules/NMakeProjectCreator.pm b/ACE/MPC/modules/NMakeProjectCreator.pm new file mode 100644 index 00000000000..8371142bdd0 --- /dev/null +++ b/ACE/MPC/modules/NMakeProjectCreator.pm @@ -0,0 +1,65 @@ +package NMakeProjectCreator; + +# ************************************************************ +# Description : An NMake Project Creator +# Author : Chad Elliott +# Create Date : 5/31/2002 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use ProjectCreator; +use WinProjectBase; +use MakeProjectBase; + +use vars qw(@ISA); +@ISA = qw(MakeProjectBase WinProjectBase ProjectCreator); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub project_file_extension { + #my $self = shift; + return '.mak'; +} + + +sub get_dll_exe_template_input_file { + #my $self = shift; + return 'nmakeexe'; +} + + +sub get_dll_template_input_file { + #my $self = shift; + return 'nmakedll'; +} + + +sub get_properties { + my $self = shift; + + ## Create the map of properties that we support. This is a reproduced + ## property from the VCProjectBase and out of laziness I have not made + ## a base project for just this property. + my $props = {'microsoft' => 1}; + + ## Merge in properties from all base projects + foreach my $base (@ISA) { + my $func = $base . '::get_properties'; + my $p = $self->$func(); + foreach my $key (keys %$p) { + $$props{$key} = $$p{$key}; + } + } + + return $props; +} + + +1; diff --git a/ACE/MPC/modules/NMakeWorkspaceCreator.pm b/ACE/MPC/modules/NMakeWorkspaceCreator.pm new file mode 100644 index 00000000000..80e39a898f6 --- /dev/null +++ b/ACE/MPC/modules/NMakeWorkspaceCreator.pm @@ -0,0 +1,108 @@ +package NMakeWorkspaceCreator; + +# ************************************************************ +# Description : A NMake Workspace (Makefile) creator +# Author : Chad Elliott +# Create Date : 6/10/2002 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use NMakeProjectCreator; +use MakeWorkspaceBase; +use WinWorkspaceBase; +use WorkspaceCreator; + +use vars qw(@ISA); +@ISA = qw(MakeWorkspaceBase WinWorkspaceBase WorkspaceCreator); + +# ************************************************************ +# Data Section +# ************************************************************ + +my $targets = 'clean depend generated realclean $(CUSTOM_TARGETS)'; + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub workspace_file_extension { + #my $self = shift; + return '.mak'; +} + + +sub pre_workspace { + my($self, $fh) = @_; + $self->workspace_preamble($fh, $self->crlf(), 'NMAKE Workspace', + '$Id$'); +} + + +sub write_project_targets { + my($self, $fh, $crlf, $target, $list) = @_; + my $cwd = $self->getcwd(); + + ## Print out a make command for each project + foreach my $project (@$list) { + my $dir = $self->mpc_dirname($project); + my $chdir = ($dir ne '.'); + + print $fh ($chdir ? "\t\@cd $dir$crlf\t\@echo Directory: $dir$crlf" : ''), + "\t\@echo Project: ", $self->mpc_basename($project), $crlf, + "\t\$(MAKE) /\$(MAKEFLAGS) /f ", $self->mpc_basename($project), + " $target$crlf", + ($chdir ? "\t\@cd \$(MAKEDIR)$crlf" : ''); + } +} + + +sub write_comps { + my($self, $fh) = @_; + my %targnum; + my $pjs = $self->get_project_info(); + my @list = $self->number_target_deps($self->get_projects(), $pjs, + \%targnum, 0); + my $crlf = $self->crlf(); + my $default = 'Win32 Debug'; + + ## Determine the default configuration. We want to get the Debug + ## configuration (if available). It just so happens that Debug comes + ## before Release so sorting the configurations works in our favor. + foreach my $project (keys %$pjs) { + my($name, $deps, $pguid, $lang, $custom_only, $nocross, $managed, @cfgs) = @{$pjs->{$project}}; + @cfgs = sort @cfgs; + if (defined $cfgs[0]) { + $default = $cfgs[0]; + + ## The configuration comes out in the form that is usable to Visual + ## Studio. We need it to be in the form that was chosen for the + ## nmake configuration. So, we just swap the parts and remove the + ## '|' character. + $default =~ s/(.*)\|(.*)/$2 $1/; + last; + } + } + + ## Print out the content + print $fh '!IF "$(CFG)" == ""', $crlf, + 'CFG=', $default, $crlf, + '!MESSAGE No configuration specified. ', + 'Defaulting to ', $default, '.', $crlf, + '!ENDIF', $crlf, $crlf, + '!IF "$(CUSTOM_TARGETS)" == ""', $crlf, + 'CUSTOM_TARGETS=_EMPTY_TARGET_', $crlf, + '!ENDIF', $crlf; + + ## Send all the information to our base class method + $self->write_named_targets($fh, $crlf, \%targnum, \@list, + $targets, 'CFG="$(CFG)" ', '', + $self->project_target_translation()); +} + + +1; diff --git a/ACE/MPC/modules/Options.pm b/ACE/MPC/modules/Options.pm new file mode 100644 index 00000000000..130bbe56edb --- /dev/null +++ b/ACE/MPC/modules/Options.pm @@ -0,0 +1,602 @@ +package Options; + +# ************************************************************ +# Description : Process mpc command line options +# Author : Chad Elliott +# Create Date : 3/20/2003 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use DirectoryManager; +use StringProcessor; +use ProjectCreator; + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub printUsage { + my $self = shift; + my $msg = shift; + my $base = shift; + my $version = shift; + my @types = @_; + + print STDERR "ERROR: $msg\n" if (defined $msg); + + my $spaces = (' ' x (length($base) + 8)); + print STDERR "$base v$version\n" . + "Usage: $base [-global <file>] [-include <directory>] [-recurse]\n" . + $spaces . "[-ti <dll | lib | dll_exe | lib_exe>:<file>] [-hierarchy]\n" . + $spaces . "[-template <file>] [-relative NAME=VAL] [-base <project>]\n" . + $spaces . "[-noreldefs] [-notoplevel] [-static] [-genins] [-use_env]\n" . + $spaces . "[-value_template <NAME+=VAL | NAME=VAL | NAME-=VAL>]\n" . + $spaces . "[-value_project <NAME+=VAL | NAME=VAL | NAME-=VAL>]\n" . + $spaces . "[-make_coexistence] [-feature_file <file name>] [-gendot]\n" . + $spaces . "[-expand_vars] [-features <feature definitions>]\n" . + $spaces . "[-exclude <directories>] [-name_modifier <pattern>]\n" . + $spaces . "[-apply_project] [-version] [-into <directory>]\n" . + $spaces . "[-gfeature_file <file name>] [-nocomments]\n" . + $spaces . "[-relative_file <file name>] [-for_eclipse]\n" . + $spaces . "[-language <"; + + my $olen = length($spaces) + 12; + my $len = $olen; + my $mlen = 77; + my @keys = sort(Creator::validLanguages()); + for(my $i = 0; $i <= $#keys; $i++) { + my $klen = length($keys[$i]); + $len += $klen; + if ($len > $mlen) { + print STDERR "\n$spaces "; + $len = $olen + $klen; + } + print STDERR $keys[$i]; + if ($i != $#keys) { + print STDERR ' | '; + $len += 3; + } + } + print STDERR ">]\n", + $spaces, "[-type <"; + + $olen = length($spaces) + 8; + $len = $olen; + + ## Sort the project types, but keep those that are the same with different + ## version numbers in the right order (i.e., vc8, vc9, vc10). The vc71 + ## type is a special case and needs to stay betwen vc7 and vc8. + @keys = sort { if ($a ne 'vc71' && $b ne 'vc71' && $a =~ /^([^\d]+)(\d+)$/) { + my($a1, $a2) = ($1, $2); + if ($b =~ /^([^\d]+)(\d+)$/ && $a1 eq $1) { + return $a2 <=> $2; + } + } + return $a cmp $b; + } @types; + for(my $i = 0; $i <= $#keys; $i++) { + my $klen = length($keys[$i]); + $len += $klen; + if ($len > $mlen) { + print STDERR "\n$spaces "; + $len = $olen + $klen; + } + print STDERR $keys[$i]; + if ($i != $#keys) { + print STDERR ' | '; + $len += 3; + } + } + print STDERR ">]\n" . + $spaces . "[files]\n\n"; + + print STDERR +" -base Add <project> as a base project to each generated\n" . +" project file. Do not provide a file extension, the\n" . +" .mpb extension will be tried first; if that fails the\n" . +" .mpc extension will be tried.\n" . +" -exclude Use this option to exclude directories or files when\n" . +" searching for input files.\n" . +" -expand_vars Perform direct expansion, instead of performing relative\n" . +" replacement with either -use_env or -relative options.\n" . +" -feature_file Specifies the feature file to read before processing.\n" . +" The default feature file is default.features under the\n" . +" config directory.\n" . +" -features Specifies the feature list to set before processing.\n" . +" -for_eclipse Generate files for use with eclipse. This is only\n" . +" useful for make based project types.\n" . +" -gendot Generate .dot files for use with Graphviz.\n" . +" -genins Generate .ins files for use with prj_install.pl.\n" . +" -gfeature_file Specifies the global feature file. The\n" . +" default value is global.features under the\n" . +" config directory.\n" . +" -global Specifies the global input file. Values stored\n" . +" within this file are applied to all projects.\n" . +" -hierarchy Generate a workspace in a hierarchical fashion.\n" . +" -include Specifies a directory to search when looking for base\n" . +" projects, template input files and templates. This\n" . +" option can be used multiple times to add directories.\n" . +" -into Place all output files in a mirrored directory\n" . +" structure starting at <directory>. This should be a\n" . +" full path.\n" . +" -language Specify the language preference; possible values are\n", +" [", join(', ', sort(Creator::validLanguages())), "]. The default is\n". +" " . Creator::defaultLanguage() . ".\n", +" -make_coexistence If multiple 'make' based project types are\n" . +" generated, they will be named such that they can coexist.\n" . +" -name_modifier Modify output names. The pattern passed to this\n" . +" parameter will have the '*' portion replaced with the\n" . +" actual output name. Ex. *_Static\n" . +" -apply_project When used in conjunction with -name_modifier, it applies\n" . +" the name modifier to the project name also.\n" . +" -nocomments Do not place comments in the generated files.\n" . +" -noreldefs Do not try to generate default relative definitions.\n" . +" -notoplevel Do not generate the top level target file. Files\n" . +" are still process, but no top level file is created.\n" . +" -recurse Recurse from the current directory and generate from\n" . +" all found input files.\n" . +" -relative Any \$() variable in an mpc file that is matched to NAME\n" . +" is replaced by VAL only if VAL can be made into a\n" . +" relative path based on the current working directory.\n" . +" This option can be used multiple times to add multiple\n" . +" variables.\n" . +" -relative_file Specifies the relative file to read before processing.\n" . +" The default relative file is default.rel under the\n" . +" config directory.\n" . +" -static Specifies that only static projects will be generated.\n" . +" By default, only dynamic projects are generated.\n" . +" -template Specifies the template name (with no extension).\n" . +" -ti Specifies the template input file (with no extension)\n" . +" for the specific type (ex. -ti dll_exe:vc8exe).\n" . +" -type Specifies the type of project file to generate. This\n" . +" option can be used multiple times to generate multiple\n" . +" types. There is no longer a default.\n" . +" -use_env Use environment variables for all uses of \$() instead\n" . +" of the relative replacement values.\n" . +" -value_project This option allows modification of a project variable\n" . +" assignment . Use += to add VAL to the NAME's value.\n" . +" Use -= to subtract and = to override the value.\n" . +" This can be used to introduce new name value pairs to\n" . +" a project. However, it must be a valid project\n" . +" assignment.\n" . +" -value_template This option allows modification of a template input\n" . +" name value pair. Use += to add VAL to the NAME's\n" . +" value. Use -= to subtract and = to override the value.\n" . +" -version Print the MPC version and exit.\n"; +} + + +sub optionError { + #my $self = shift; + #my $str = shift; +} + + +sub completion_command { + my($self, $name, $types) = @_; + my $str = "complete $name " . + "'c/-/(gendot genins global include type template relative " . + "ti static noreldefs notoplevel feature_file use_env " . + "value_template value_project make_coexistence language " . + "hierarchy exclude name_modifier apply_project version " . + "expand_vars gfeature_file nocomments for_eclipse relative_file)/' " . + "'c/dll:/f/' 'c/dll_exe:/f/' 'c/lib_exe:/f/' 'c/lib:/f/' " . + "'n/-ti/(dll lib dll_exe lib_exe)/:' "; + + $str .= "'n/-language/("; + my @keys = sort(Creator::validLanguages()); + for(my $i = 0; $i <= $#keys; $i++) { + $str .= $keys[$i]; + $str .= " " if ($i != $#keys); + } + $str .= ")/' 'n/-type/("; + + @keys = sort keys %$types; + for(my $i = 0; $i <= $#keys; $i++) { + $str .= $keys[$i]; + $str .= " " if ($i != $#keys); + } + $str .= ")/'"; + return $str; +} + + +sub options { + my $self = shift; + my $name = shift; + my $types = shift; + my $defaults = shift; + my @args = @_; + my @include; + my @input; + my @creators; + my @baseprojs; + my %ti; + my %relative; + my %addtemp; + my %addproj; + my @exclude; + my $global; + my $template; + my $feature_f; + my $gfeature_f; + my $relative_f; + my @features; + my $nmodifier; + my $into; + my $hierarchy = 0; + my $language = ($defaults ? Creator::defaultLanguage() : undef); + my $dynamic = ($defaults ? 1 : undef); + my $comments = ($defaults ? 1 : undef); + my $reldefs = ($defaults ? 1 : undef); + my $toplevel = ($defaults ? 1 : undef); + my $use_env = ($defaults ? 0 : undef); + my $expandvars = ($defaults ? 0 : undef); + my $static = ($defaults ? 0 : undef); + my $recurse = ($defaults ? 0 : undef); + my $makeco = ($defaults ? 0 : undef); + my $applypj = ($defaults ? 0 : undef); + my $genins = ($defaults ? 0 : undef); + my $gendot = ($defaults ? 0 : undef); + my $foreclipse = ($defaults ? 0 : undef); + + ## Process the command line arguments + for(my $i = 0; $i <= $#args; $i++) { + my $arg = $args[$i]; + $arg =~ s/^--/-/; + + if ($arg eq '-apply_project') { + $applypj = 1; + } + elsif ($arg eq '-complete') { + print $self->completion_command($name, $types) . "\n"; + return undef; + } + elsif ($arg eq '-base') { + $i++; + if (!defined $args[$i]) { + $self->optionError('-base requires an argument'); + } + else { + push(@baseprojs, $args[$i]); + } + } + elsif ($arg eq '-type') { + $i++; + if (!defined $args[$i]) { + $self->optionError('-type requires an argument'); + } + else { + my $type = lc($args[$i]); + if (defined $types->{$type}) { + my $call = $types->{$type}; + my $found = 0; + foreach my $creator (@creators) { + if ($creator eq $call) { + $found = 1; + last; + } + } + push(@creators, $call) if (!$found); + } + else { + $self->optionError("Invalid type: $args[$i]"); + } + } + } + elsif ($arg eq '-exclude') { + $i++; + if (defined $args[$i]) { + foreach my $exclude (split(',', $args[$i])) { + push(@exclude, DirectoryManager::mpc_glob(undef, $exclude)); + } + } + else { + $self->optionError('-exclude requires a ' . + 'comma separated list argument'); + } + } + elsif ($arg eq '-expand_vars') { + $expandvars = 1; + } + elsif ($arg eq '-feature_file') { + $i++; + $feature_f = $args[$i]; + if (!defined $feature_f) { + $self->optionError('-feature_file requires a file name argument'); + } + } + elsif ($arg eq '-features') { + $i++; + if (defined $args[$i]) { + @features = split(',', $args[$i]); + } + else { + $self->optionError('-features requires a comma separated list argument'); + } + } + elsif ($arg eq '-for_eclipse') { + $foreclipse = 1; + } + elsif ($arg eq '-gfeature_file') { + $i++; + $gfeature_f = $args[$i]; + if (!defined $gfeature_f) { + $self->optionError('-gfeature_file ' . + 'requires a file name argument'); + } + } + elsif ($arg eq '-relative_file') { + $i++; + $relative_f = $args[$i]; + if (!defined $relative_f) { + $self->optionError('-relative_file ' . + 'requires a file name argument'); + } + } + elsif ($arg eq '-gendot') { + $gendot = 1; + } + elsif ($arg eq '-genins') { + $genins = 1; + } + elsif ($arg eq '-global') { + $i++; + $global = $args[$i]; + if (!defined $global) { + $self->optionError('-global requires a file name argument'); + } + } + elsif ($arg eq '-help') { + $self->optionError(); + } + elsif ($arg eq '-hierarchy') { + $hierarchy = 1; + } + elsif ($arg eq '-include') { + $i++; + my $include = $args[$i]; + if (!defined $include) { + $self->optionError('-include requires a directory argument'); + } + else { + ## If the specified include path is relative, expand it based on + ## the current working directory. + if ($include !~ /^[\/\\]/ && + $include !~ /^[A-Za-z]:[\/\\]?/) { + $include = DirectoryManager::getcwd() . '/' . $include; + } + + push(@include, $include); + } + } + elsif ($arg eq '-into') { + $i++; + $into = $args[$i]; + if (!defined $into) { + $self->optionError('-into requires a directory argument'); + } + } + elsif ($arg eq '-language') { + $i++; + $language = $args[$i]; + if (!defined $language) { + $self->optionError('-language requires a language argument'); + } + elsif (!Creator::isValidLanguage($language)) { + $self->optionError("$language is not a valid language"); + } + } + elsif ($arg eq '-make_coexistence') { + $makeco = 1; + } + elsif ($arg eq '-name_modifier') { + $i++; + my $nmod = $args[$i]; + if (!defined $nmod) { + $self->optionError('-name_modifier requires a modifier argument'); + } + else { + $nmodifier = $nmod; + } + } + elsif ($arg eq '-nocomments') { + $comments = 0; + } + elsif ($arg eq '-noreldefs') { + $reldefs = 0; + } + elsif ($arg eq '-notoplevel') { + $toplevel = 0; + } + elsif ($arg eq '-recurse') { + $recurse = 1; + } + elsif ($arg eq '-template') { + $i++; + $template = $args[$i]; + if (!defined $template) { + $self->optionError('-template requires a file name argument'); + } + } + elsif ($arg eq '-relative') { + $i++; + my $rel = $args[$i]; + if (!defined $rel) { + $self->optionError('-relative requires a variable assignment argument'); + } + else { + if ($rel =~ /(\w+)\s*=\s*(.*)/) { + my $name = $1; + my $val = $2; + $val =~ s/^\s+//; + $val =~ s/\s+$//; + + ## If the specified path is relative, expand it based on + ## the current working directory. + if ($val !~ /^[\/\\]/ && + $val !~ /^[A-Za-z]:[\/\\]?/) { + $val = DirectoryManager::getcwd() . '/' . $val; + } + + ## Clean up the path as much as possible. For some reason, + ## File::Spec->canonpath() on Windows doesn't remove trailing + ## /. from the path. + $relative{$name} = File::Spec->canonpath($val); + $relative{$name} =~ s/\\/\//g; + $relative{$name} =~ s!/\.$!!; + } + else { + $self->optionError('Invalid argument to -relative'); + } + } + } + elsif ($arg eq '-ti') { + $i++; + my $tmpi = $args[$i]; + if (!defined $tmpi) { + $self->optionError('-ti requires a template input argument'); + } + else { + if ($tmpi =~ /((dll|lib|dll_exe|lib_exe):)?(.*)/) { + my $key = $2; + my $name = $3; + if (defined $key) { + $ti{$key} = $name; + } + else { + foreach my $type ('dll', 'lib', 'dll_exe', 'lib_exe') { + $ti{$type} = $name; + } + } + } + else { + $self->optionError("Invalid -ti argument: $tmpi"); + } + } + } + elsif ($arg eq '-use_env') { + $use_env = 1; + } + elsif ($arg eq '-value_template') { + $i++; + my $value = $args[$i]; + if (!defined $value) { + $self->optionError('-value_template requires a variable assignment argument'); + } + else { + my @values; + my $pc = new ProjectCreator(); + if ($pc->parse_assignment($value, \@values)) { + $addtemp{$values[1]} = [] if (!defined $addtemp{$values[1]}); + ## The extra parameter (3rd) indicates that this value was + ## specified on the command line. This "extra parameter" is + ## used in ProjectCreator::update_template_variable(). + push(@{$addtemp{$values[1]}}, [$values[0], $values[2], 1]); + + my $keywords = ProjectCreator::getKeywords(); + if (defined $$keywords{$values[1]}) { + $self->warning($values[1] . ' is a project keyword; you ' . + 'should use -value_project instead.'); + } + } + else { + $self->optionError('Invalid argument to -value_template'); + } + } + } + elsif ($arg eq '-value_project') { + $i++; + my $value = $args[$i]; + if (!defined $value) { + $self->optionError('-value_project requires a variable assignment argument'); + } + else { + my @values; + my $pc = new ProjectCreator(); + if ($pc->parse_assignment($value, \@values)) { + $addproj{$values[1]} = [] if (!defined $addproj{$values[1]}); + push(@{$addproj{$values[1]}}, [$values[0], $values[2]]); + } + else { + $self->optionError('Invalid argument to -value_project'); + } + } + } + elsif ($arg eq '-version') { + print 'MPC v', Version::get(), "\n"; + return undef; + } + elsif ($arg eq '-static') { + $static = 1; + $dynamic = 0; + } + elsif ($arg =~ /^-/) { + $self->optionError("Unknown option: $arg"); + } + else { + push(@input, $arg); + } + } + + return {'global' => $global, + 'feature_file' => $feature_f, + 'gfeature_file' => $gfeature_f, + 'relative_file' => $relative_f, + 'features' => \@features, + 'for_eclipse' => $foreclipse, + 'include' => \@include, + 'input' => \@input, + 'comments' => $comments, + 'creators' => \@creators, + 'baseprojs' => \@baseprojs, + 'template' => $template, + 'ti' => \%ti, + 'dynamic' => $dynamic, + 'static' => $static, + 'relative' => \%relative, + 'reldefs' => $reldefs, + 'toplevel' => $toplevel, + 'recurse' => $recurse, + 'addtemp' => \%addtemp, + 'addproj' => \%addproj, + 'make_coexistence' => $makeco, + 'hierarchy' => $hierarchy, + 'exclude' => \@exclude, + 'name_modifier' => $nmodifier, + 'apply_project' => $applypj, + 'gendot' => $gendot, + 'genins' => $genins, + 'into' => $into, + 'language' => $language, + 'use_env' => $use_env, + 'expand_vars' => $expandvars, + }; +} + + +sub is_set { + my($self, $key, $options) = @_; + + if (defined $options->{$key}) { + if (UNIVERSAL::isa($options->{$key}, 'ARRAY')) { + return 'ARRAY' if (defined $options->{$key}->[0]); + } + elsif (UNIVERSAL::isa($options->{$key}, 'HASH')) { + my @keys = keys %{$options->{$key}}; + return 'HASH' if (defined $keys[0]); + } + else { + return 'SCALAR'; + } + } + + return undef; +} + +1; diff --git a/ACE/MPC/modules/OutputMessage.pm b/ACE/MPC/modules/OutputMessage.pm new file mode 100644 index 00000000000..58636c7823f --- /dev/null +++ b/ACE/MPC/modules/OutputMessage.pm @@ -0,0 +1,106 @@ +package OutputMessage; + +# ************************************************************ +# Description : Prints information, warnings and errors. +# Author : Chad Elliott +# Create Date : 2/02/2004 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +# ************************************************************ +# Data Section +# ************************************************************ + +my $debugtag = 'DEBUG: '; +my $infotag = 'INFORMATION: '; +my $warntag = 'WARNING: '; +my $errortag = 'ERROR: '; + +my $debug = 0; +my $information = 0; +my $warnings = 1; +my $diagnostic = 1; +my $details = 1; + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub new { + my $class = shift; + return bless {}, $class; +} + + +sub set_levels { + my $str = shift; + + if (defined $str) { + $debug = ($str =~ /debug\s*=\s*(\d+)/i ? $1 : 0); + $details = ($str =~ /detail(s)?\s*=\s*(\d+)/i ? $2 : 0); + $diagnostic = ($str =~ /diag(nostic)?\s*=\s*(\d+)/i ? $2 : 0); + $information = ($str =~ /info(rmation)?\s*=\s*(\d+)/i ? $2 : 0); + $warnings = ($str =~ /warn(ing)?\s*=\s*(\d+)/i ? $2 : 0); + } +} + +sub split_message { + my($self, $msg, $spc) = @_; + $msg =~ s/\.\s+/.\n$spc/g; + return $msg . "\n"; +} + + +sub details { + if ($details) { + #my($self, $msg) = @_; + print "$_[1]\n"; + } +} + + +sub diagnostic { + if ($diagnostic) { + #my($self, $msg) = @_; + print "$_[1]\n"; + } +} + + +sub debug { + if ($debug) { + #my($self, $msg) = @_; + print "$debugtag$_[1]\n"; + } +} + + +sub information { + if ($information) { + #my($self, $msg) = @_; + print $infotag, $_[0]->split_message($_[1], ' ' x length($infotag)); + } +} + + +sub warning { + if ($warnings) { + #my($self, $msg) = @_; + print $warntag, $_[0]->split_message($_[1], ' ' x length($warntag)); + } +} + + +sub error { + my($self, $msg, $pre) = @_; + print STDERR '', (defined $pre ? "$pre\n" : ''), $errortag, + $self->split_message($msg, ' ' x length($errortag)); +} + + +1; diff --git a/ACE/MPC/modules/Parser.pm b/ACE/MPC/modules/Parser.pm new file mode 100644 index 00000000000..bca6dccddf5 --- /dev/null +++ b/ACE/MPC/modules/Parser.pm @@ -0,0 +1,196 @@ +package Parser; + +# ************************************************************ +# Description : A basic parser that requires a parse_line override +# Author : Chad Elliott +# Create Date : 5/16/2002 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; +use FileHandle; + +use OutputMessage; +use StringProcessor; +use DirectoryManager; + +use vars qw(@ISA); +@ISA = qw(OutputMessage StringProcessor DirectoryManager); + +# ************************************************************ +# Data Section +# ************************************************************ + +my %filecache; + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub new { + my($class, $inc) = @_; + my $self = $class->SUPER::new(); + + ## Set up the internal data members. + $self->{'line_number'} = 0; + $self->{'include'} = $inc; + + return $self; +} + + +sub strip_line { + my($self, $line) = @_; + + ## Keep track of our line number + ++$self->{'line_number'}; + + ## Remove comments and leading and trailing white-space. + $line =~ s/\/\/.*//; + $line =~ s/^\s+//; + $line =~ s/\s+$//; + + return $line; +} + + +sub preprocess_line { + #my $self = shift; + #my $fh = shift; + #my $line = shift; + return $_[0]->strip_line($_[2]); +} + + +sub read_file { + my($self, $input, $cache) = @_; + my $ih = new FileHandle(); + my $status = 1; + my $errorString; + + $self->{'line_number'} = 0; + if (open($ih, $input)) { + $self->debug("Open $input"); + if ($cache) { + ## If we don't have an array for this file, then start one + $filecache{$input} = [] if (!defined $filecache{$input}); + + while(<$ih>) { + ## Preprocess the line + my $line = $self->preprocess_line($ih, $_); + + ## Push the line onto the array for this file + push(@{$filecache{$input}}, $line); + + ## Parse the line + ($status, $errorString) = $self->parse_line($ih, $line); + + ## Stop reading the file if we've encountered an error + last if (!$status); + } + } + else { + ## We're not caching, so we just preprocess and parse in one call. + while(<$ih>) { + ($status, $errorString) = $self->parse_line( + $ih, $self->preprocess_line($ih, $_)); + + ## Stop reading the file if we've encountered an error + last if (!$status); + } + } + $self->debug("Close $input"); + close($ih); + } + else { + $errorString = "Unable to open \"$input\" for reading"; + $status = 0; + } + + return $status, $errorString; +} + + +sub cached_file_read { + my($self, $input) = @_; + my $lines = $filecache{$input}; + + if (defined $lines) { + my $status = 1; + my $error; + $self->{'line_number'} = 0; + foreach my $line (@$lines) { + ++$self->{'line_number'}; + ## Since we're "reading" a cached file, we must pass undef as the + ## file handle to parse_line(). + ($status, $error) = $self->parse_line(undef, $line); + + ## Stop "reading" the file if we've encountered an error + last if (!$status); + } + return $status, $error; + } + + ## We haven't cached this file yet, read it and cache it. + return $self->read_file($input, 1); +} + + +sub get_line_number { + return $_[0]->{'line_number'}; +} + + +sub set_line_number { + my($self, $number) = @_; + $self->{'line_number'} = $number; +} + + +sub slash_to_backslash { + ## This method is here solely for convenience. It's used to make the + ## calling code look cleaner. + my($self, $file) = @_; + $file =~ s/\//\\/g; + return $file; +} + + +sub get_include_path { + return $_[0]->{'include'}; +} + + +sub search_include_path { + my($self, $file) = @_; + + foreach my $include ('.', @{$self->{'include'}}) { + return "$include/$file" if (-r "$include/$file"); + } + + return undef; +} + + +sub escape_regex_special { + my($self, $name) = @_; + $name =~ s/([\+\-\\\$\[\]\(\)\.])/\\$1/g; + return $name; +} + + +# ************************************************************ +# Virtual Methods To Be Overridden +# ************************************************************ + +sub parse_line { + #my $self = shift; + #my $ih = shift; + #my $line = shift; +} + + +1; diff --git a/ACE/MPC/modules/ProjectCreator.pm b/ACE/MPC/modules/ProjectCreator.pm new file mode 100644 index 00000000000..2f68c18183c --- /dev/null +++ b/ACE/MPC/modules/ProjectCreator.pm @@ -0,0 +1,5425 @@ +package ProjectCreator; + +# ************************************************************ +# Description : Base class for all project creators +# Author : Chad Elliott +# Create Date : 3/13/2002 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; +use FileHandle; +use File::Path; + +use Creator; +use TemplateInputReader; +use TemplateParser; +use FeatureParser; +use CommandHelper; + +use vars qw(@ISA); +@ISA = qw(Creator); + +# ************************************************************ +# Data Section +# ************************************************************ + +## The basic extensions known to a project creator +my $BaseClassExtension = 'mpb'; +my $ProjectCreatorExtension = 'mpc'; +my $TemplateExtension = 'mpd'; +my $TemplateInputExtension = 'mpt'; + +## This feature is enabled or disabled depending on whether +## or not the -static option is used. +my $static_libs_feature = 'static_libs_only'; + +## Valid names for assignments within a project +## Bit Meaning +## 0 Preserve the order for additions (1) or invert it (0) +## 1 Add this value to template input value (if there is one) +## 2 Preserve <% %> settings for evaluation within the template +my %validNames = ('after' => 1, + 'avoids' => 3, + 'custom_only' => 1, + 'dllout' => 1, + 'dynamicflags' => 3, + 'exename' => 1, + 'exeout' => 1, + 'includes' => 3, + 'libout' => 1, + 'libpaths' => 3, + 'libs' => 2, + 'lit_libs' => 2, + 'macros' => 3, + 'managed' => 1, + 'pch_header' => 1, + 'pch_source' => 1, + 'postbuild' => 5, + 'postclean' => 5, + 'prebuild' => 5, + 'pure_libs' => 2, + 'recurse' => 1, + 'recursive_includes' => 3, + 'recursive_libpaths' => 3, + 'requires' => 3, + 'sharedname' => 1, + 'staticflags' => 3, + 'staticname' => 1, + 'tagchecks' => 1, + 'tagname' => 1, + 'version' => 1, + 'webapp' => 1, + ); + +## Custom definitions only +## Bit Meaning +## 0 Value is always an array +## 1 Value is an array and name gets 'outputext' converted to 'files' +## 2 Value is always scalar +## 3 Name can also be used in an 'optional' clause +## 4 Needs <%...%> conversion +my %customDefined = ('automatic_in' => 0x04, + 'automatic_out' => 0x04, + 'command' => 0x14, + 'commandflags' => 0x14, + 'dependent' => 0x14, + 'precommand' => 0x14, + 'postcommand' => 0x14, + 'inputext' => 0x01, + 'libpath' => 0x04, + 'output_follows_input' => 0x04, + 'output_option' => 0x14, + 'pch_postrule' => 0x04, + 'pre_extension' => 0x08, + 'source_pre_extension' => 0x08, + 'template_pre_extension' => 0x08, + 'header_pre_extension' => 0x08, + 'inline_pre_extension' => 0x08, + 'documentation_pre_extension' => 0x08, + 'resource_pre_extension' => 0x08, + 'generic_pre_extension' => 0x08, + 'pre_filename' => 0x08, + 'source_pre_filename' => 0x08, + 'template_pre_filename' => 0x08, + 'header_pre_filename' => 0x08, + 'inline_pre_filename' => 0x08, + 'documentation_pre_filename' => 0x08, + 'resource_pre_filename' => 0x08, + 'generic_pre_filename' => 0x08, + 'pre_dirname' => 0x08, + 'source_pre_dirname' => 0x08, + 'template_pre_dirname' => 0x08, + 'header_pre_dirname' => 0x08, + 'inline_pre_dirname' => 0x08, + 'documentation_pre_dirname' => 0x08, + 'resource_pre_dirname' => 0x08, + 'generic_pre_dirname' => 0x08, + 'source_outputext' => 0x0a, + 'template_outputext' => 0x0a, + 'header_outputext' => 0x0a, + 'inline_outputext' => 0x0a, + 'documentation_outputext' => 0x0a, + 'resource_outputext' => 0x0a, + 'generic_outputext' => 0x0a, + ); + +## Custom sections as well as definitions +## Value Meaning +## 0 No modifications +## 1 Needs <%...%> conversion +my %custom = ('command' => 1, + 'commandflags' => 1, + 'dependent' => 1, + 'gendir' => 0, + 'precommand' => 1, + 'postcommand' => 1, + ); + +## All matching assignment arrays will get these keywords +my @default_matching_assignments = ('recurse', + ); + +## Deal with these components in a special way +my %specialComponents = ('header_files' => 1, + 'inline_files' => 1, + 'template_files' => 1, + ); +my %sourceComponents = ('source_files' => 1, + 'template_files' => 1, + ); + +my $defgroup = 'default_group'; +my $grouped_key = 'grouped_'; +my $tikey = '/ti/'; + +## Matches with generic_outputext +my $generic_key = 'generic_files'; + +# ************************************************************ +# C++ Specific Component Settings +# ************************************************************ + +## Resource files tag for C++ +my $cppresource = 'resource_files'; + +## Valid component names within a project along with the valid file extensions +my %cppvc = ('source_files' => [ "\\.cpp", "\\.cxx", "\\.cc", "\\.c", "\\.C", ], + 'template_files' => [ "_T\\.cpp", "_T\\.cxx", "_T\\.cc", "_T\\.c", "_T\\.C", "_t\\.cpp", "_t\\.cxx", "_t\\.cc", "_t\\.c", "_t\\.C" ], + 'header_files' => [ "\\.h", "\\.hpp", "\\.hxx", "\\.hh", ], + 'inline_files' => [ "\\.i", "\\.ipp", "\\.inl", ], + 'documentation_files' => [ "README", "readme", "\\.doc", "\\.txt", "\\.html" ], + $cppresource => [ "\\.rc", ], + ); + +## Exclude these extensions when auto generating the component values +my %cppec = ('source_files' => $cppvc{'template_files'}, + ); + +## These matching assignment arrays will get added, but only to the +## specific project component types. +my %cppma = ('source_files' => ['buildflags', + 'managed', + 'no_pch', + ], + ); + +# ************************************************************ +# C# Specific Component Settings +# ************************************************************ + +## Resource files tag for C# +my $csresource = 'resx_files'; + +## Valid component names within a project along with the valid file extensions +my %csvc = ('source_files' => [ "\\.cs" ], + 'config_files' => [ "\\.config" ], + $csresource => [ "\\.resx", "\\.resources" ], + 'aspx_files' => [ "\\.aspx" ], + 'ico_files' => [ "\\.ico" ], + 'documentation_files' => [ "README", "readme", "\\.doc", "\\.txt", "\\.html" ], + ); + +my %csma = ('source_files' => [ 'dependent_upon', + 'subtype', + ], + $csresource => [ 'dependent_upon', + 'generates_source', + 'subtype', + ], + ); + +# ************************************************************ +# Java Specific Component Settings +# ************************************************************ + +## Valid component names within a project along with the valid file extensions +my %jvc = ('source_files' => [ "\\.java" ], + 'documentation_files' => [ "README", "readme", "\\.doc", "\\.txt", "\\.html" ], + ); + +# ************************************************************ +# Visual Basic Specific Component Settings +# ************************************************************ + +## Resource files tag for VB +my $vbresource = 'resx_files'; + +## Valid component names within a project along with the valid file extensions +my %vbvc = ('source_files' => [ "\\.vb" ], + 'config_files' => [ "\\.config" ], + $vbresource => [ "\\.resx" ], + 'aspx_files' => [ "\\.aspx" ], + 'ico_files' => [ "\\.ico" ], + 'documentation_files' => [ "README", "readme", "\\.doc", "\\.txt", "\\.html" ], + ); + +my %vbma = ('source_files' => [ 'subtype' ], + ); + +# ************************************************************ +# Language Specific Component Settings +# ************************************************************ + +# Index Description +# ----- ----------- +# 0 File types +# 1 Files automatically excluded from source_files +# 2 Assignments available in standard file types +# 3 The entry point for executables +# 4 The language uses a C preprocessor +# 5 Name of the tag for 'resource_files' for this language +# * This is special because it gets treated like source_files in that +# a project with only these files is a library/exe not "custom only". +my %language = (Creator::cplusplus => [ \%cppvc, \%cppec, \%cppma, 'main', + 1, $cppresource ], + + Creator::csharp => [ \%csvc, {}, \%csma, 'Main', 0, + $csresource ], + + Creator::java => [ \%jvc, {}, {}, 'main', 0 ], + + Creator::vb => [ \%vbvc, {}, \%vbma, 'Main', 0, + $vbresource ], + ); +my %mains; + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub new { + 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) = @_; + my $self = $class->SUPER::new($global, $inc, + $template, $ti, $dynamic, $static, + $relative, $addtemp, $addproj, + $progress, $toplevel, $baseprojs, + $feature, $features, + $hierarchy, $nmod, $applypj, + $into, $language, $use_env, + $expandvars, + 'project'); + + $self->{$self->{'type_check'}} = 0; + $self->{'feature_defined'} = 0; + $self->{'features_changed'} = undef; + $self->{'project_info'} = []; + $self->{'lib_locations'} = {}; + $self->{'reading_parent'} = []; + $self->{'dll_exe_template_input'}= {}; + $self->{'lib_exe_template_input'}= {}; + $self->{'lib_template_input'} = {}; + $self->{'dll_template_input'} = {}; + $self->{'flag_overrides'} = {}; + $self->{'custom_special_output'} = {}; + $self->{'custom_special_depend'} = {}; + $self->{'special_supplied'} = {}; + $self->{'pctype'} = $self->extractType("$self"); + $self->{'verbatim'} = {}; + $self->{'verbatim_accessed'} = {$self->{'pctype'} => {}}; + $self->{'defaulted'} = {}; + $self->{'custom_types'} = {}; + $self->{'parents_read'} = {}; + $self->{'inheritance_tree'} = {}; + $self->{'remove_files'} = {}; + $self->{'expanded'} = {}; + $self->{'gfeature_file'} = $gfeature; + $self->{'relative_file'} = $relative_f; + $self->{'feature_parser'} = $self->create_feature_parser($features, + $feature); + $self->{'sort_files'} = $self->sort_files(); + $self->{'source_callback'} = undef; + $self->{'dollar_special'} = $self->dollar_special(); + $self->{'generate_ins'} = $genins; + $self->{'addtemp_state'} = undef; + $self->{'command_subs'} = $self->get_command_subs(); + $self->{'escape_spaces'} = $self->escape_spaces(); + $self->{'current_template'} = undef; + $self->{'make_coexistence'} = $makeco; + + $self->add_default_matching_assignments(); + $self->reset_generating_types(); + + return $self; +} + + +sub is_keyword { + ## Is the name passed in a known keyword for a project. This includes + ## keywords mapped by Define_Custom or Modify_Custom. + my($self, $name) = @_; + return $self->{'valid_names'}->{$name}; +} + + +sub read_global_configuration { + my $self = shift; + my $input = $self->get_global_cfg(); + my $status = 1; + + if (defined $input) { + ## If it doesn't contain a path, search the include path + if ($input !~ /[\/\\]/) { + $input = $self->search_include_path($input); + $input = $self->get_global_cfg() if (!defined $input); + } + + ## Read and parse the global project file + $self->{'reading_global'} = 1; + $status = $self->parse_file($input); + $self->{'reading_global'} = 0; + } + + return $status; +} + + +sub convert_to_template_assignment { + my($self, $name, $value, $calledfrom) = @_; + + ## If the value we are going to set for $name has been used as a + ## scoped template variable, we need to hijack the whole assignment + ## and turn it into a template variable assignment. + my $atemp = $self->get_addtemp(); + foreach my $key (grep(/::$name$/, keys %$atemp)) { + $self->update_template_variable(0, $calledfrom, $key, $value); + } +} + + +sub create_recursive_settings { + my($self, $name, $value, $assign) = @_; + + ## Handle both recursive_includes and recursive_libpaths in one + ## search and replace. + if ($name =~ s/^recursive_//) { + ## This portion of code was lifted directly from Creator::relative() + ## but modified to always expand the variables. We will turn the + ## expanded values back into variables below and once they're passed + ## off to the assignment processing code, they will be turned into + ## relative values (if possible). + if (index($value, '$') >= 0) { + my $ovalue = $value; + my($rel, $how) = $self->get_initial_relative_values(); + $value = $self->expand_variables($value, $rel, 0, undef, 1); + + if ($ovalue eq $value || index($value, '$') >= 0) { + ($rel, $how) = $self->get_secondary_relative_values(); + $value = $self->expand_variables($value, $rel, 0, undef, 1, 1); + } + } + + ## Create an array out of the recursive directory list. Convert all + ## of the relative or full path values back into $() values. + my @dirs = (); + my $elems = $self->create_array($value); + foreach my $elem (@$elems) { + my $dlist = $self->recursive_directory_list($elem, []); + if ($dlist eq '') { + ## This directory doesn't exist, just add the original value + push(@dirs, $elem); + } + else { + ## Create an array out of the directory list and add it to our + ## array. + my $array = $self->create_array($dlist); + push(@dirs, @$array); + } + } + + ## We need to return a string, so we join it all together space + ## separated. + $value = join(' ', $self->back_to_variable(\@dirs)); + } + + return $name, $value; +} + +sub process_assignment { + my($self, $name, $value, $assign, $calledfrom) = @_; + $calledfrom = 0 if (!defined $calledfrom); + + ## See if the name is one of the special "recursive" settings. If so, + ## fix up the value and change the name. + ($name, $value) = $self->create_recursive_settings($name, $value, $assign); + + ## Support the '*' mechanism as in the project name, to allow + ## the user to correctly depend on another project within the same + ## directory. + if (defined $value) { + if ($name eq 'after' && index($value, '*') >= 0) { + $value = $self->fill_type_name($value, + $self->get_default_project_name()); + } + + ## If this particular project type does not consider the dollar sign + ## special and the user has provided two dollarsigns as an escape, we + ## will turn it into a single dollar sign. + if (!$self->{'dollar_special'} && index($value, '$$') >= 0) { + $value =~ s/\$\$/\$/g; + } + + ## If the assignment name is valid and requires parameter (<%...%>) + ## replacement, then do so. + if (defined $self->{'valid_names'}->{$name} && + ($self->{'valid_names'}->{$name} & 0x04) == 0 && + index($value, '<%') >= 0) { + $value = $self->replace_parameters($value, $self->{'command_subs'}); + } + } + + if ($calledfrom == 0) { + $self->convert_to_template_assignment($name, $value, $calledfrom); + } + + ## Call the base process_assigment() after we have modified the name and + ## value. + $self->SUPER::process_assignment($name, $value, $assign); + + ## Support keyword mapping here only at the project level scope. The + ## scoped keyword mapping is done through the parse_scoped_assignment() + ## method. + if (!defined $assign || $assign == $self->get_assignment_hash()) { + my $mapped = $self->{'valid_names'}->{$name}; + if (defined $mapped && UNIVERSAL::isa($mapped, 'ARRAY')) { + $self->parse_scoped_assignment($$mapped[0], 0, + $$mapped[1], $value, + $self->{'generated_exts'}->{$$mapped[0]}); + } + } +} + + +sub process_assignment_add { + my($self, $name, $value, $assign) = @_; + + ## See if the name is one of the special "recursive" settings. If so, + ## fix up the value and change the name. + ($name, $value) = $self->create_recursive_settings($name, $value, $assign); + + return $self->SUPER::process_assignment_add($name, $value, $assign); +} + + +sub process_assignment_sub { + my($self, $name, $value, $assign) = @_; + + ## See if the name is one of the special "recursive" settings. If so, + ## fix up the value and change the name. + ($name, $value) = $self->create_recursive_settings($name, $value, $assign); + + return $self->SUPER::process_assignment_sub($name, $value, $assign); +} + + +sub addition_core { + my($self, $name, $value, $nval, $assign) = @_; + + ## If there is a previous value ($nval) and the keyword is going to be + ## evaled, we need to separate the values with a command separator. + ## This has to be done at the MPC level because it isn't always + ## possible for the user to know if a value has already been added to + ## the keyword (prebuild, postbuild and postclean). + if (defined $nval && + defined $validNames{$name} && ($validNames{$name} & 4)) { + if ($self->preserve_assignment_order($name)) { + $value = '<%cmdsep%> ' . $value; + } + else { + $value .= '<%cmdsep%>'; + } + } + + ## For an addition, we need to see if it is a project keyword being + ## used within a 'specific' section. If it is, we may need to update + ## scoped settings for that variable (which are in essence template + ## variables). + $self->convert_to_template_assignment($name, $value, 1); + + ## Next, we just give everything to the base class method. + $self->SUPER::addition_core($name, $value, $nval, $assign); +} + + +sub subtraction_core { + my($self, $name, $value, $nval, $assign) = @_; + + ## For a subtraction, we need to see if it is a project keyword being + ## used within a 'specific' section. If it is, we may need to update + ## scoped settings for that variable (which are in essence template + ## variables). + $self->convert_to_template_assignment($name, $value, -1); + + ## Next, we just give everything to the base class method. + $self->SUPER::subtraction_core($name, $value, $nval, $assign); +} + + +sub get_assignment_for_modification { + my($self, $name, $assign, $subtraction) = @_; + + ## If we weren't passed an assignment hash, then we need to + ## look one up that may possibly correctly deal with keyword mappings + if (!defined $assign) { + my $mapped = $self->{'valid_names'}->{$name}; + + if (defined $mapped && UNIVERSAL::isa($mapped, 'ARRAY')) { + $name = $$mapped[1]; + $assign = $self->{'generated_exts'}->{$$mapped[0]}; + } + } + + ## Get the assignment value + my $value = $self->get_assignment($name, $assign); + + ## If we are involved in a subtraction, we get back a value and + ## it's a scoped or mapped assignment, then we need to possibly + ## expand any template variables. Otherwise, the subtractions + ## may not work correctly. + if ($subtraction && defined $value && defined $assign) { + $value = $self->relative($value, 1); + } + + return $value; +} + + +sub begin_project { + my($self, $parents) = @_; + my $status = 1; + my $error; + + ## Deal with the inheritance hierarchy first + ## Add in the base projects from the command line + if (!$self->{'reading_global'} && + !defined $self->{'reading_parent'}->[0]) { + my $baseprojs = $self->get_baseprojs(); + + if (defined $parents) { + foreach my $base (@$baseprojs) { + push(@$parents, $base) if (!StringProcessor::fgrep($base, $parents)); + } + } + else { + $parents = $baseprojs; + } + } + + if (defined $parents) { + foreach my $parent (@$parents) { + ## Read in the parent onto ourself + my $file = $self->search_include_path( + "$parent.$BaseClassExtension"); + if (!defined $file) { + $file = $self->search_include_path( + "$parent.$ProjectCreatorExtension"); + } + + if (defined $file) { + if (defined $self->{'reading_parent'}->[0]) { + if (StringProcessor::fgrep($file, $self->{'reading_parent'})) { + $status = 0; + $error = 'Cyclic inheritance detected: ' . $parent; + } + } + + if ($status) { + if (!defined $self->{'parents_read'}->{$file}) { + $self->{'parents_read'}->{$file} = 1; + + ## Push the base project file onto the parent stack + push(@{$self->{'reading_parent'}}, $file); + + ## Collect up some information about the inheritance tree + my $tree = $self->{'current_input'}; + if (!defined $self->{'inheritance_tree'}->{$tree}) { + $self->{'inheritance_tree'}->{$tree} = {}; + } + my $hash = $self->{'inheritance_tree'}->{$tree}; + foreach my $p (@{$self->{'reading_parent'}}) { + $$hash{$p} = {} if (!defined $$hash{$p}); + $hash = $$hash{$p}; + } + + ## Begin reading the parent + $status = $self->parse_file($file); + + ## Take the base project file off of the parent stack + pop(@{$self->{'reading_parent'}}); + + $error = "Invalid parent: $parent" if (!$status); + } + else { + ## The base project has already been read. So, if + ## we are reading the original project (not a parent base + ## project), then the current base project is redundant. + if (!defined $self->{'reading_parent'}->[0]) { + $file =~ s/\.[^\.]+$//; + $self->information('Inheriting from \'' . + $self->mpc_basename($file) . + '\' in ' . $self->{'current_input'} . + ' is redundant at line ' . + $self->get_line_number() . '.'); + } + } + } + } + else { + $status = 0; + $error = "Unable to locate parent: $parent"; + } + } + } + + ## Copy each value from global_assign into assign + if (!$self->{'reading_global'}) { + foreach my $key (keys %{$self->{'global_assign'}}) { + if (!defined $self->{'assign'}->{$key}) { + $self->{'assign'}->{$key} = $self->{'global_assign'}->{$key}; + } + } + } + + return $status, $error; +} + + +sub get_process_project_type { + my($self, $types) = @_; + my $type = ''; + my $defcomp = $self->get_default_component_name(); + + foreach my $t (split(/\s*,\s*/, $types)) { + my $not = ($t =~ s/^!\s*//); + if ($not) { + if ($t eq $self->{'pctype'}) { + $type = ''; + last; + } + else { + $type = $self->{'pctype'}; + } + } + elsif ($t eq $self->{'pctype'} || $t eq $defcomp) { + $type = $t; + last; + } + } + + return $type; +} + + +sub matches_specific_scope { + my($self, $elements) = @_; + + ## First check for properties that correspond to the current project + ## type. Elements that begin with "prop:" indicate a property. + my $list = ''; + my $props = $self->get_properties(); + foreach my $prop (split(/\s*,\s*/, $elements)) { + my $not = ($prop =~ s/^!\s*//); + if ($prop =~/(.+):(.+)/) { + if ($1 eq 'prop') { + $prop = $2; + if ($not) { + return $self->{'pctype'} if (!$$props{$prop}); + } + else { + return $self->{'pctype'} if ($$props{$prop}); + } + } + else { + $self->warning("$prop is not recognized."); + } + } + else { + $list .= ($not ? '!' : '') . $prop . ','; + } + } + + ## If none of the elements match a property, then check the type + ## against the current project type or the default component name + ## (which is what it would be set to if a specific clause is used with + ## out parenthesis). + my $type = $self->get_process_project_type($list); + return $self->{'pctype'} if ($type eq $self->{'pctype'} || + $type eq $self->get_default_component_name()); + + ## Nothing matched + return undef; +} + + +sub parse_line { + my($self, $ih, $line) = @_; + my($status, + $errorString, + @values) = $self->parse_known($line); + + ## parse_known() passes back an array of values + ## that make up the contents of the line parsed. + ## The array can have 0 to 3 items. The first, + ## if defined, is always an identifier of some + ## sort. + + if ($status && defined $values[0]) { + if ($values[0] eq $self->{'grammar_type'}) { + my $name = $values[1]; + my $typecheck = $self->{'type_check'}; + if (defined $name && $name eq '}') { + ## Project Ending + if (!defined $self->{'reading_parent'}->[0] && + !$self->{'reading_global'}) { + ## Fill in all the default values + $self->generate_defaults(); + + ## Perform any additions, subtractions + ## or overrides for the project values. + my $addproj = $self->get_addproj(); + foreach my $ap (keys %$addproj) { + if (defined $self->{'valid_names'}->{$ap}) { + foreach my $val (@{$$addproj{$ap}}) { + if ($$val[0] > 0) { + $self->process_assignment_add($ap, $$val[1]); + } + elsif ($$val[0] < 0) { + $self->process_assignment_sub($ap, $$val[1]); + } + else { + $self->process_assignment($ap, $$val[1]); + } + } + } + else { + $errorString = 'Invalid ' . + "assignment modification name: $ap"; + $status = 0; + } + } + + if ($status) { + ## Generate default target names after all source files are added + ## and after we've added in all of the options from the + ## command line. If the user set exename on the command line + ## and no "main" is found, sharedname will be set too and + ## most templates do not handle that well. + $self->generate_default_target_names(); + + ## End of project; Write out the file. + ($status, $errorString) = $self->write_project(); + + ## write_project() can return 0 for error, 1 for project + ## was written and 2 for project was skipped + if ($status == 1) { + ## Save the library name and location + foreach my $name ('sharedname', 'staticname') { + my $val = $self->get_assignment($name); + if (defined $val) { + my $cwd = $self->getcwd(); + my $start = $self->getstartdir(); + my $amount = 0; + if ($cwd eq $start) { + $amount = length($start); + } + elsif (index($cwd, $start) == 0) { + $amount = length($start) + 1; + } + $self->{'lib_locations'}->{$val} = + substr($cwd, $amount); + last; + } + } + + ## Check for unused verbatim markers + foreach my $key (keys %{$self->{'verbatim'}}) { + if (defined $self->{'verbatim_accessed'}->{$key}) { + foreach my $ikey (keys %{$self->{'verbatim'}->{$key}}) { + if (!defined $self->{'verbatim_accessed'}->{$key}->{$ikey}) { + $self->warning("Marker $ikey does not exist."); + } + } + } + } + } + + ## Reset all of the project specific data + foreach my $key (keys %{$self->{'valid_components'}}) { + delete $self->{$key}; + $self->{'defaulted'}->{$key} = 0; + } + if (defined $self->{'addtemp_state'}) { + $self->restore_state($self->{'addtemp_state'}, 'addtemp'); + $self->{'addtemp_state'} = undef; + } + $self->{'assign'} = {}; + $self->{'verbatim'} = {}; + $self->{'verbatim_accessed'} = {$self->{'pctype'} => {}}; + $self->{'special_supplied'} = {}; + $self->{'flag_overrides'} = {}; + $self->{'parents_read'} = {}; + $self->{'inheritance_tree'} = {}; + $self->{'remove_files'} = {}; + $self->{'custom_special_output'} = {}; + $self->{'custom_special_depend'} = {}; + $self->{'expanded'} = {}; + $self->reset_generating_types(); + } + } + $self->{$typecheck} = 0; + } + else { + ## Project Beginning + ($status, $errorString) = $self->begin_project($values[2]); + + ## Set up the default project name + if ($status) { + if (defined $name) { + if ($name =~ /[\/\\]/) { + $status = 0; + $errorString = 'Projects can not have a slash ' . + 'or a back slash in the name'; + } + else { + ## We should only set the project name if we are not + ## reading in a parent project. + if (!defined $self->{'reading_parent'}->[0]) { + $name =~ s/^\(\s*//; + $name =~ s/\s*\)$//; + $name = $self->transform_file_name($name); + + ## Replace any *'s with the default name + if (index($name, '*') >= 0) { + $name = $self->fill_type_name( + $name, + $self->get_default_project_name()); + } + + $self->set_project_name($name); + } + else { + $self->warning("Ignoring project name " . + "$name in a base project."); + } + } + } + } + + ## Signify that we have a valid project + $self->{$typecheck} = 1 if ($status); + } + } + elsif ($values[0] eq '0') { + ## $values[1] = name; $values[2] = value + if (defined $self->{'valid_names'}->{$values[1]}) { + $self->process_assignment($values[1], $values[2]); + } + else { + $errorString = "Invalid assignment name: '$values[1]'"; + $status = 0; + } + } + elsif ($values[0] eq '1') { + ## $values[1] = name; $values[2] = value + if (defined $self->{'valid_names'}->{$values[1]}) { + $self->process_assignment_add($values[1], $values[2]); + } + else { + $errorString = "Invalid addition name: $values[1]"; + $status = 0; + } + } + elsif ($values[0] eq '-1') { + ## $values[1] = name; $values[2] = value + if (defined $self->{'valid_names'}->{$values[1]}) { + $self->process_assignment_sub($values[1], $values[2]); + } + else { + $errorString = "Invalid subtraction name: $values[1]"; + $status = 0; + } + } + elsif ($values[0] eq 'component') { + my $comp = $values[1]; + my $name = $values[2]; + my $vc = $self->{'valid_components'}; + + if (defined $$vc{$comp}) { + ($status, $errorString) = $self->parse_components($ih, $comp, $name); + } + else { + if ($comp eq 'verbatim') { + my($type, $loc, $add) = split(/\s*,\s*/, $name); + ($status, $errorString) = $self->parse_verbatim($ih, $type, + $loc, $add); + } + elsif ($comp eq 'specific') { + my $type = $self->matches_specific_scope($name); + if (defined $type) { + ($status, $errorString) = $self->parse_scope( + $ih, $comp, $type, + $self->{'valid_names'}, + $self->get_assignment_hash(), + {}); + } + else { + ## We still need to parse the scope, but we will be + ## throwing away whatever is processed. However, it + ## could still be invalid code that will cause an error. + ($status, $errorString) = $self->parse_scope( + $ih, $comp, undef, + $self->{'valid_names'}, + undef, + $self->get_assignment_hash()); + } + } + elsif ($comp eq 'define_custom') { + ($status, $errorString) = $self->parse_define_custom($ih, $name); + } + elsif ($comp eq 'modify_custom') { + ($status, $errorString) = $self->parse_define_custom($ih, $name, 1); + } + elsif ($comp eq 'expand') { + $self->{'parsing_expand'} = 1; + ($status, $errorString) = $self->parse_scope($ih, $comp, $name); + $self->{'parsing_expand'} = undef; + } + else { + $errorString = "Invalid component name: $comp"; + $status = 0; + } + } + } + elsif ($values[0] eq 'feature') { + $self->{'feature_defined'} = 1; + ($status, $errorString) = $self->process_feature($ih, + $values[1], + $values[2]); + if ($status && $self->{'feature_defined'}) { + $errorString = "Did not find the end of the feature"; + $status = 0; + } + } + else { + $errorString = "Unrecognized line: $line"; + $status = 0; + } + } + elsif ($status == -1) { + $status = 0; + } + + return $status, $errorString; +} + + +sub parse_scoped_assignment { + my($self, $tag, $type, $name, $value, $flags) = @_; + + ## Map the assignment name on a scoped assignment + my $mapped = $self->{'valid_names'}->{$name}; + if (defined $mapped && UNIVERSAL::isa($mapped, 'ARRAY')) { + $name = $$mapped[1]; + } + + if (defined $self->{'matching_assignments'}->{$tag} && + StringProcessor::fgrep($name, $self->{'matching_assignments'}->{$tag})) { + my $over = {}; + if (defined $self->{'flag_overrides'}->{$tag}) { + $over = $self->{'flag_overrides'}->{$tag}; + } + else { + $self->{'flag_overrides'}->{$tag} = $over; + } + + if ($type == 0) { + $self->process_assignment($name, $value, $flags); + } + elsif ($type == 1) { + ## If there is no value in $$flags, then we need to get + ## the outer scope value and put it in there. + if (!defined $self->get_assignment($name, $flags)) { + my $outer = $self->get_assignment($name); + $self->process_assignment($name, $outer, $flags); + } + $self->process_assignment_add($name, $value, $flags); + } + elsif ($type == -1) { + ## If there is no value in $$flags, then we need to get + ## the outer scope value and put it in there. + if (!defined $self->get_assignment($name, $flags)) { + my $outer = $self->get_assignment($name); + $self->process_assignment($name, $outer, $flags); + } + $self->process_assignment_sub($name, $value, $flags); + } + return 1; + } + + return 0; +} + + +sub update_template_variable { + my $self = shift; + my $check = shift; + my @values = @_; + + ## Save the addtemp state if we haven't done so before + if (!defined $self->{'addtemp_state'}) { + my %state = $self->save_state('addtemp'); + $self->{'addtemp_state'} = \%state; + } + + ## If the name that is used within a specific is a mapped keyword + ## then we need to translate it into the mapped keyword as it will + ## be used by the TemplateParser. + my $name; + if ($values[1] =~ /(.*::)(.*)/) { + my $base = $1; + my $mapped = $self->{'valid_names'}->{$2}; + if (defined $mapped && UNIVERSAL::isa($mapped, 'ARRAY')) { + $name = $values[1]; + $values[1] = $base . 'custom_type->' . $$mapped[1]; + } + } + + ## Now modify the addtemp values + my $atemp = $self->get_addtemp(); + $self->information("'$values[1]' was used as a template modifier."); + + if ($check && !defined $atemp->{$values[1]}) { + $name = $values[1] if (!defined $name); + if ($name =~ s/.*:://) { + my $value = $self->get_assignment($name); + ## Regardless of whether there was and assignment value, we need to + ## look at the template value of the base so that modification of a + ## scoped variable includes the base values. + if (defined $atemp->{$name}) { + foreach my $arr (@{$atemp->{$name}}) { + my @copy = @$arr; + push(@{$atemp->{$values[1]}}, \@copy); + } + } + unshift(@{$atemp->{$values[1]}}, + [0, $value, undef, $name]) if (defined $value); + } + } + + ## Subsitute all pseudo variables for the project specific characters. + $values[2] = $self->replace_parameters($values[2], $self->{'command_subs'}) + if (index($values[2], '<%') >= 0); + + if (defined $atemp->{$values[1]}) { + ## If there are template variable settings, then we need to add + ## this new one to the end of the settings that did not come from + ## the command line. That way, adjust_value() does not need to + ## sort the values (and have knowledge about which came from the + ## command line and which didn't). + my $max = scalar(@{$atemp->{$values[1]}}); + for(my $i = 0; $i < $max; $i++) { + if ($atemp->{$values[1]}->[$i]->[2]) { + splice(@{$atemp->{$values[1]}}, $i, 0, + [$values[0], $values[2], undef, $name]); + return; + } + } + } + else { + $atemp->{$values[1]} = []; + } + + ## If the variable name is not scoped, we need to look through existing + ## scoped variables that match the base. If we find one, we need to + ## propagate this value into the scoped settings. + if (index($values[1], '::') == -1) { + $name = $values[1] if (!defined $name); + foreach my $key (keys %$atemp) { + if ($key ne $name) { + foreach my $entry (@{$atemp->{$key}}) { + if ($$entry[3] eq $name) { + push(@{$atemp->{$key}}, [$values[0], $values[2], undef, $name]); + last; + } + } + } + } + } + + ## 0: (0 set, 1 add, -1 subtract) + ## 1: The text value + ## 2: (true set on command line, false set in project) + ## 3: The original variable name if it's scoped or mapped + push(@{$atemp->{$values[1]}}, [$values[0], $values[2], undef, $name]); +} + + +sub handle_unknown_assignment { + my $self = shift; + my $type = shift; + my @values = @_; + + ## Unknown assignments within a 'specific' section are handled as + ## template value modifications. These are handled exactly as the + ## -value_template option in Options.pm. + + ## If $type is not defined, then we are skipping this section + $self->update_template_variable(1, @values) if (defined $type); + + return 1, undef; +} + + +sub handle_scoped_unknown { + my($self, $fh, $type, $flags, $line) = @_; + + if (defined $type && $self->{'parsing_expand'}) { + if ($type eq $self->get_default_component_name()) { + return 0, 'Can not set expansion in this context'; + } + else { + if (!defined $self->{'expanded'}->{$type}) { + my $undef = $self->replace_env_vars(\$line); + if (!$undef) { + ## This is a special concession for Windows. It will not allow + ## you to set an empty environment variable. If an empty + ## double quoted string is found, we will assume that the user + ## wanted an empty string. + $line = '' if ($line eq '""'); + + $self->{'expanded'}->{$type} = $line; + } + } + return 1, undef; + } + } + + ## If the type is not defined, then this is something other than an + ## assignment in a 'specific' section and should be flagged as an error + return 0, "Unrecognized line: $line"; +} + +sub process_component_line { + my($self, $tag, $line, $flags, + $grname, $current, $excarr, $comps, $count) = @_; + my $status = 1; + my $error; + my %exclude; + my @values; + + ## If this returns true, then we've found an assignment + if ($self->parse_assignment($line, \@values)) { + $status = $self->parse_scoped_assignment($tag, @values, $flags); + if (!$status) { + $error = 'Unknown keyword: ' . $values[1]; + } + } + else { + ## If we successfully remove a '!' from the front, then + ## the file(s) listed are to be excluded + my $rem = ($line =~ s/^\^\s*//); + my $exc = $rem || ($line =~ s/^!\s*//); + + ## Convert any $(...) in this line before we process any + ## wild card characters. If we do not, scoped assignments will + ## not work nor will we get the correct wild carded file list. + ## We also need to make sure that any back slashes are converted to + ## slashes to ensure that later flag_overrides checks will happen + ## correctly. + $line = $self->relative($line); + $line =~ s/\\/\//g if ($self->{'convert_slashes'}); + + ## Now look for specially listed files. + ## Regular expressions are very slow. Searching the line twice with + ## index() is 328 times faster than searching with just the regular + ## expression when it doesn't match (which is likely to be the case). + if ((index($line, '>>') >= 0 || index($line, '<<') >= 0) && + $line =~ /(.*)\s+(>>|<<)\s+(.*)/) { + $line = $1; + my $oop = $2; + my $iop = ($oop eq '>>' ? '<<' : '>>'); + my $out = ($oop eq '>>' ? $3 : undef); + my $dep = ($oop eq '<<' ? $3 : undef); + + $line =~ s/\s+$//; + if (index($line, $iop) >= 0 && $line =~ /(.*)\s+$iop\s+(.*)/) { + $line = $1; + $out = $2 if ($iop eq '>>'); + $dep = $2 if ($iop eq '<<'); + $line =~ s/\s+$//; + } + + ## Check for both possible error conditions + if (index($line, $oop) >= 0) { + $status = 0; + $error = "Duplicate $oop used"; + } + elsif (index($line, $iop) >= 0) { + $status = 0; + $error = "Duplicate $iop used"; + } + + ## Keys used internally to MPC need to be in forward slash format. + my $key = $line; + $key =~ s/\\/\//g if ($self->{'convert_slashes'}); + if (defined $out) { + if (!defined $self->{'custom_special_output'}->{$tag}) { + $self->{'custom_special_output'}->{$tag} = {}; + } + ## We can not convert slashes here as we do for dependencies + ## (below). The files specified here need to retain the forward + ## slashes as they are used elsewhere. + $self->{'custom_special_output'}->{$tag}->{$key} = $self->create_array($out); + } + if (defined $dep) { + $self->{'custom_special_depend'}->{$key} = $self->create_array($dep); + if ($self->{'convert_slashes'}) { + foreach my $depfile (@{$self->{'custom_special_depend'}->{$key}}) { + $depfile =~ s/\//\\/g; + } + } + } + } + + ## If there is a command helper, we need to add the output files + ## here. It is possible that helper determined output files are + ## the only files added by this component type. + my $cmdHelper = CommandHelper::get($tag); + if (defined $cmdHelper) { + my $key = $line; + $key =~ s/\\/\//g if ($self->{'convert_slashes'}); + my $cmdflags = $$flags{'commandflags'}; + my $add_out = $cmdHelper->get_output($key, $cmdflags); + push(@{$self->{'custom_special_output'}->{$tag}->{$key}}, @$add_out); + } + + ## Set up the files array. If the line contains a wild card + ## character use CORE::glob() to get the files specified. + my @files; + if ($line =~ /^"([^"]+)"$/) { + push(@files, $1); + } + ## Don't glob the line if we're wanting to remove the file. Wait + ## until later to do the wildcard expansion (in remove_excluded). + elsif (!$rem && $line =~ /[\?\*\[\]]/) { + @files = $self->mpc_glob($line); + } + else { + push(@files, $line); + } + + ## If we want to remove these files at the end too, then + ## add them to our remove_files hash array. + if ($rem) { + if (!defined $self->{'remove_files'}->{$tag}) { + $self->{'remove_files'}->{$tag} = {}; + } + foreach my $file (@files) { + $self->{'remove_files'}->{$tag}->{$file} = 1; + } + } + + ## If we're excluding these files, then put them in the hash + if ($exc) { + $$grname = $current; + @exclude{@files} = (@files); + push(@$excarr, @files); + } + else { + ## Set the flag overrides for each file + my $over = $self->{'flag_overrides'}->{$tag}; + if (defined $over) { + foreach my $file (@files) { + $$over{$file} = $flags; + } + } + + foreach my $file (@files) { + ## Add the file if we're not excluding it + push(@{$$comps{$current}}, $file) if (!defined $exclude{$file}); + + ## The user listed a file explicitly, whether we + ## excluded it or not. + ++$$count; + } + } + } + + return $status, $error; +} + + +sub parse_conditional { + my($self, $fh, $types, $tag, $flags, + $grname, $current, $exclude, $comps, $count) = @_; + my $status = 1; + my $error; + my $type = $self->matches_specific_scope($types); + my $add = (defined $type ? 1 : 0); + + while(<$fh>) { + my $line = $self->preprocess_line($fh, $_); + + if ($line eq '') { + } + elsif ($line =~ /^}\s*else\s*{$/) { + $add ^= 1; + } + elsif ($line =~ /^}$/) { + last; + } + elsif ($add) { + ($status, $error) = $self->process_component_line( + $tag, $line, $flags, + $grname, $current, + $exclude, $comps, $count); + last if (!$status); + } + } + + return $status, $error; +} + +sub parse_components { + my($self, $fh, $tag, $name) = @_; + my $current = $defgroup; + my $status = 1; + my $error; + my $names = {}; + my $comps = {}; + my $set; + my %flags; + my @exclude; + my $custom = defined $self->{'generated_exts'}->{$tag}; + my $grtag = $grouped_key . $tag; + my $grname; + + if ($custom) { + ## For the custom scoped assignments, we want to put a copy of + ## the original custom defined values in our flags associative array. + foreach my $key (keys %custom) { + if (defined $self->{'generated_exts'}->{$tag}->{$key}) { + $flags{$key} = $self->{'generated_exts'}->{$tag}->{$key}; + } + } + } + + if (defined $self->{$tag}) { + $names = $self->{$tag}; + } + else { + $self->{$tag} = $names; + } + if (defined $$names{$name}) { + $comps = $$names{$name}; + } + else { + $$names{$name} = $comps; + } + $$comps{$current} = [] if (!defined $$comps{$current}); + + my $count = 0; + while(<$fh>) { + my $line = $self->preprocess_line($fh, $_); + + if ($line eq '') { + } + elsif ($line =~ /^(\w+)\s*{$/) { + if (!$set) { + $current = $1; + $set = 1; + $$comps{$current} = [] if (!defined $$comps{$current}); + } + else { + $status = 0; + $error = 'Can not nest groups'; + last; + } + } + elsif ($line =~ /^conditional\s*(\(([^\)]+)\))\s*{$/) { + ($status, $error) = $self->parse_conditional( + $fh, $2, $tag, \%flags, \$grname, + $current, \@exclude, $comps, + \$count); + last if (!$status); + } + elsif ($line =~ /^}$/) { + if (!defined $$comps{$current}->[0] && !defined $exclude[0]) { + ## The default components name was never used + ## so we remove it from the components + delete $$comps{$current}; + } + else { + ## It was used, so we need to add that name to + ## the set of group names unless it's already been added. + $self->process_assignment_add($grtag, $current); + } + if ($set) { + $current = $defgroup; + $set = undef; + } + else { + ## We are at the end of a component. If the only group + ## we added was the default group, then we need to remove + ## the group setting altogether. + my $groups = $self->get_assignment($grtag); + if (defined $groups) { + my $grarray = $self->create_array($groups); + if (scalar(@$grarray) == 1 && $$grarray[0] eq $defgroup) { + $self->process_assignment($grtag, undef); + } + } + + ## This is not an error, + ## this is the end of the components + last; + } + } + else { + ($status, $error) = $self->process_component_line($tag, $line, \%flags, + \$grname, $current, + \@exclude, $comps, + \$count); + last if (!$status); + } + } + + ## If this is a "special" component, we need to see if the + ## user provided all directories. If they have, then we need to + ## store an array of directories that the user supplied. Otherwise, + ## we just store a 1. + if (defined $specialComponents{$tag}) { + my @dirs; + foreach my $name (keys %$names) { + my $comps = $$names{$name}; + foreach my $comp (keys %$comps) { + foreach my $item (@{$$comps{$comp}}) { + if (-d $item) { + push(@dirs, $item); + } + else { + @dirs = (); + last; + } + } + } + } + if (defined $dirs[0]) { + $self->{'special_supplied'}->{$tag} = \@dirs; + } + else { + $self->{'special_supplied'}->{$tag} = 1; + } + } + + ## If we didn't encounter an error, didn't have any files explicitly + ## listed and we attempted to exclude files, then we need to find the + ## set of files that don't match the excluded files and add them. + if ($status && defined $exclude[0] && defined $grname) { + my $alldir = $self->get_assignment('recurse') || $flags{'recurse'}; + my %checked; + my @files; + foreach my $exc (@exclude) { + my $dname = $self->mpc_dirname($exc); + if (!defined $checked{$dname}) { + $checked{$dname} = 1; + push(@files, $self->generate_default_file_list($dname, + \@exclude, + undef, $alldir)); + } + } + + $self->sift_files(\@files, + $self->{'valid_components'}->{$tag}, + $self->get_assignment('pch_header'), + $self->get_assignment('pch_source'), + $tag, + $$comps{$grname}); + } + + return $status, $error; +} + + +sub parse_verbatim { + my($self, $fh, $type, $loc, $add) = @_; + + if (!defined $loc) { + return 0, 'You must provide a location parameter to verbatim'; + } + + ## All types are lower case + $type = lc($type); + + if (!defined $self->{'verbatim'}->{$type}) { + $self->{'verbatim'}->{$type} = {}; + } + + ## Instead of always creating a new array for a particular type and + ## location, create a new array if there isn't one already or the user + ## does not want to add to the existing verbatim settings. + $self->{'verbatim'}->{$type}->{$loc} = [] + if (!$add || !defined $self->{'verbatim'}->{$type}->{$loc}); + my $array = $self->{'verbatim'}->{$type}->{$loc}; + + while(<$fh>) { + my $line = $self->preprocess_line($fh, $_); + + ## This is not an error, + ## this is the end of the verbatim + last if ($line =~ /^}$/); + push(@$array, $line); + } + + return 1, undef; +} + + +sub process_feature { + my($self, $fh, $names, $parents) = @_; + my $status = 1; + my $error; + + my $requires = ''; + my $avoids = ''; + foreach my $name (@$names) { + if ($name =~ /^!\s*(.*)$/) { + $avoids .= ' ' if ($avoids ne ''); + $avoids .= $1; + } + else { + $requires .= ' ' if ($requires ne ''); + $requires .= $name; + } + } + + if ($self->check_features($requires, $avoids)) { + ## The required features are enabled, so we say that + ## a project has been defined and we allow the parser to + ## find the data held within the feature. + ($status, $error) = $self->begin_project($parents); + if ($status) { + $self->{'feature_defined'} = 0; + $self->{$self->{'type_check'}} = 1; + } + } + else { + ## Otherwise, we read in all the lines until we find the + ## closing brace for the feature and it appears to the parser + ## that nothing was defined. + my $curly = 1; + while(<$fh>) { + my $line = $self->preprocess_line($fh, $_); + + ## This is a very simplistic way of finding the end of + ## the feature definition. It will work as long as no spurious + ## open curly braces are counted. + ++$curly if ($line =~ /{$/); + --$curly if ($line =~ /^}/); + + if ($curly == 0) { + $self->{'feature_defined'} = 0; + last; + } + } + } + + return $status, $error; +} + + +sub process_array_assignment { + my($self, $aref, $type, $array) = @_; + + if (!defined $$aref || $type == 0) { + if ($type != -1) { + $$aref = $array; + } + } + else { + if ($type == 1) { + push(@{$$aref}, @$array); + } + elsif ($type == -1) { + my $count = scalar(@{$$aref}); + for(my $i = 0; $i < $count; ++$i) { + if (StringProcessor::fgrep($$aref->[$i], $array)) { + splice(@{$$aref}, $i, 1); + --$i; + --$count; + } + } + } + } +} + + +sub parse_define_custom { + my($self, $fh, $tag, $modify) = @_; + + ## Make the tag something _files + $tag = lc($tag) . '_files'; + + ## We can not have a custom type named "generic" + return 0, "$tag is reserved" if ($tag eq $generic_key); + + if (defined $self->{'valid_components'}->{$tag}) { + if (!$modify) { + return 0, "$tag has already been defined"; + } + } + elsif ($modify) { + return 0, "$tag has not yet been defined and can not be modified"; + } + + my $status = 0; + my $errorString = "Unable to process $tag"; + + ## Update the custom_types assignment + $self->process_assignment_add('custom_types', $tag) if (!$modify); + + if (!defined $self->{'matching_assignments'}->{$tag}) { + my @keys = keys %custom; + push(@keys, @default_matching_assignments); + $self->{'matching_assignments'}->{$tag} = \@keys; + } + + my $optname; + my $inscope = 0; + while(<$fh>) { + my $line = $self->preprocess_line($fh, $_); + + if ($line eq '') { + } + elsif ($line =~ /optional\s*\(([^\)]+)\)\s*{/) { + $optname = $1; + $optname =~ s/^\s+//; + $optname =~ s/\s+$//; + if (defined $customDefined{$optname} && + ($customDefined{$optname} & 0x08) != 0) { + ++$inscope; + if ($inscope != 1) { + $status = 0; + $errorString = 'Can not nest \'optional\' sections'; + last; + } + } + else { + $status = 0; + $errorString = "Invalid optional name: $optname"; + last; + } + } + elsif ($inscope) { + if ($line =~ /^}$/) { + $optname = undef; + --$inscope; + } + else { + if ($line =~ /(\w+)\s*\(([^\)]+)\)\s*(\+)?=\s*(.*)/) { + my $name = lc($1); + my $opt = $2; + my $add = $3; + my @val = split(/\s*,\s*/, $4); + + ## Fix $opt spacing + $opt =~ s/(\&\&|\|\|)/ $1 /g; + $opt =~ s/!\s+/!/g; + + ## Set up the 'optional' hash table + if (!$add || !defined $self->{'generated_exts'}->{$tag}-> + {'optional'}->{$optname}->{$name}->{$opt}) { + $self->{'generated_exts'}->{$tag}-> + {'optional'}->{$optname}->{$name}->{$opt} = \@val; + } + else { + push(@{$self->{'generated_exts'}->{$tag}->{'optional'}-> + {$optname}->{$name}->{$opt}}, @val); + } + } + else { + $status = 0; + $errorString = "Unrecognized optional line: $line"; + last; + } + } + } + elsif ($line =~ /^}$/) { + $status = 1; + $errorString = undef; + + ## Propagate the custom defined values into the mapped values + foreach my $key (keys %{$self->{'valid_names'}}) { + if (UNIVERSAL::isa($self->{'valid_names'}->{$key}, 'ARRAY')) { + my $value = $self->{'generated_exts'}->{$tag}->{ + $self->{'valid_names'}->{$key}->[1]}; + + ## Bypass the process_assignment() defined in this class + ## to avoid unwanted keyword mapping. + $self->SUPER::process_assignment($key, $value) if (defined $value); + } + } + + ## Set some defaults (if they haven't already been set) + if (!defined $self->{'generated_exts'}->{$tag}->{'pre_filename'}) { + $self->{'generated_exts'}->{$tag}->{'pre_filename'} = [ '' ]; + } + if (!defined $self->{'generated_exts'}->{$tag}->{'pre_dirname'}) { + $self->{'generated_exts'}->{$tag}->{'pre_dirname'} = [ '' ]; + } + if (!defined $self->{'generated_exts'}->{$tag}->{'pre_extension'}) { + $self->{'generated_exts'}->{$tag}->{'pre_extension'} = [ '' ]; + } + if (!defined $self->{'generated_exts'}->{$tag}->{'automatic_in'}) { + $self->{'generated_exts'}->{$tag}->{'automatic_in'} = 1; + } + if (!defined $self->{'generated_exts'}->{$tag}->{'automatic_out'}) { + $self->{'generated_exts'}->{$tag}->{'automatic_out'} = 1; + } + if (!defined $self->{'generated_exts'}->{$tag}->{'output_follows_input'}) { + $self->{'generated_exts'}->{$tag}->{'output_follows_input'} = 1; + } + if (!defined $self->{'valid_components'}->{$tag}) { + $self->{'valid_components'}->{$tag} = []; + } + last; + } + else { + my @values; + ## If this returns true, then we've found an assignment + if ($self->parse_assignment($line, \@values)) { + my($type, $name, $value) = @values; + ## The 'automatic' keyword has always contained two distinct + ## functions. The first is to automatically add input files of + ## the specified extension. And the second is to automatically + ## add generated files to the right components. It has now been + ## split into separate functionality and we map the 'automatic' + ## keyword to the two new ones here. + my $ok = 1; + my @names = $name eq 'automatic' ? + ('automatic_in', 'automatic_out') : $name; + foreach $name (@names) { + if (defined $customDefined{$name}) { + if (($customDefined{$name} & 0x01) != 0) { + $value = $self->escape_regex_special($value); + my @array = split(/\s*,\s*/, $value); + $self->process_array_assignment( + \$self->{'valid_components'}->{$tag}, $type, \@array); + } + else { + if (!defined $self->{'generated_exts'}->{$tag}) { + $self->{'generated_exts'}->{$tag} = {}; + } + ## Try to convert the value into a relative path + $value = $self->relative($value); + + if (($customDefined{$name} & 0x04) != 0) { + if ($type == 0) { + $self->process_assignment( + $name, $value, + $self->{'generated_exts'}->{$tag}); + } + elsif ($type == 1) { + $self->process_assignment_add( + $name, $value, + $self->{'generated_exts'}->{$tag}); + } + elsif ($type == -1) { + $self->process_assignment_sub( + $name, $value, + $self->{'generated_exts'}->{$tag}); + } + } + else { + if (($customDefined{$name} & 0x02) != 0) { + ## Transform the name from something outputext to + ## something files. We expect this to match the + ## names of valid_assignments. + $name =~ s/outputext/files/g; + } + + ## Get it ready for regular expressions + $value = $self->escape_regex_special($value); + + ## Split the value into an array using a comma as the + ## separator. If there are no elements in the array we're + ## going to add an empty element to the array. This way, + ## assignments of blank values are useful. + my @array = split(/\s*,\s*/, $value); + push(@array, '') if ($#array == -1); + + ## Process the array assignment after adjusting the values + $self->process_array_assignment( + \$self->{'generated_exts'}->{$tag}->{$name}, + $type, \@array); + } + } + } + else { + $ok = 0; + $status = 0; + $errorString = "Invalid assignment name: '$name'"; + last; + } + } + + ## $status is zero until the end of the define custom block, so + ## we can't use it for this check. + last if (!$ok); + } + elsif ($line =~ /^keyword\s+(\w+)(?:\s*=\s*(\w+)?)?/) { + ## Check for keyword mapping here + my $newkey = $1; + my $mapkey = $2; + if (defined $self->{'valid_names'}->{$newkey}) { + $status = 0; + $errorString = "Cannot map $newkey onto an " . + "existing keyword"; + last; + } + elsif (!defined $mapkey) { + $self->{'valid_names'}->{$newkey} = 1; + } + elsif ($newkey ne $mapkey) { + if (defined $customDefined{$mapkey}) { + $self->{'valid_names'}->{$newkey} = [ $tag, $mapkey ]; + } + else { + $status = 0; + $errorString = "Cannot map $newkey to an " . + "undefined custom keyword: $mapkey"; + last; + } + } + else { + $status = 0; + $errorString = "Cannot map $newkey to $mapkey"; + last; + } + } + else { + $status = 0; + $errorString = "Unrecognized line: $line"; + last; + } + } + } + + return $status, $errorString; +} + + +sub back_to_variable { + my($self, $values) = @_; + my $cwd = $self->getcwd(); + my $case_tolerant = $self->case_insensitive(); + my @values = (); + + ## Get both of the relative value hash maps and put them in an array + my @rels = (); + my($rel, $how) = $self->get_initial_relative_values(); + push(@rels, $rel); + ($rel, $how) = $self->get_secondary_relative_values(); + push(@rels, $rel); + + ## Go through each value and try to convert it to a variable setting + foreach my $ovalue (@$values) { + ## Fix up the value, replacing '.' with the current working + ## directory. + my $value = $ovalue; + $value =~ s/\\/\//g; + if ($value eq '.') { + $value = $cwd; + } + else { + $value =~ s/^.\//$cwd\//; + } + my $valuelen = length($value); + + ## Go through each relative value hash map and see if any of the + ## values match the value that we're currently inspecting. + my $found = undef; + foreach my $rel (@rels) { + foreach my $key (keys %$rel) { + ## Get the relative replacement value and convert back-slashes + my $val = $$rel{$key}; + $val =~ s/\\/\//g; + + ## We only need to check for reverse replacement if the length + ## of the value is greater than or equal to the length of our + ## replacement value. + my $vlen = length($val); + if ($valuelen >= $vlen) { + ## Cut the string down by the length of the replacement value + my $lval = substr($value, 0, $vlen); + + ## Check for equivalence, taking into account file system + ## case-insenitivity. + if ($case_tolerant) { + $found = (lc($lval) eq lc($val)); + } + else { + $found = ($lval eq $val); + } + + ## If they match, replace the value and save it in our array. + if ($found) { + substr($value, 0, length($val)) = "\$($key)"; + push(@values, $value); + last; + } + } + } + + ## Once it's been found, there's no reason to continue on through + ## the relative hash maps. + last if ($found); + } + + push(@values, $ovalue) if (!$found); + } + + return @values; +} + + +sub remove_duplicate_addition { + my($self, $name, $value, $nval) = @_; + + if (defined $nval) { + ## If we are modifying the libs, libpaths, macros or includes + ## assignment with either addition or subtraction, we are going to + ## perform a little fix on the value to avoid multiple + ## libraries and to try to insure the correct linking order + if ($name eq 'macros' || $name eq 'libpaths' || + $name eq 'includes' || $name =~ /libs$/ || + index($name, $grouped_key) == 0) { + my $allowed = ''; + my %parts; + + ## Convert the array into keys for a hash table + @parts{@{$self->create_array($nval)}} = (); + + ## In order to ensure that duplicates are correctly removed, we + ## need to get the modified assignment value before we attempt to + ## do so. + $value = $self->modify_assignment_value($name, $value); + foreach my $val (@{$self->create_array($value)}) { + if (!exists $parts{$val}) { + ## We need to supply quotes if there is a space in the value or + ## a variable. The variable may contain spaces. + my $qt = ($val =~ /\s/ || $val =~ /\$\(.+\)/ ? '"' : ''); + $allowed .= $qt . $val . $qt . ' '; + } + } + $allowed =~ s/\s+$//; + return $allowed; + } + } + + return $value; +} + + +sub read_template_input { + my($self, $tkey) = @_; + my $status = 1; + my $errorString; + my $file; + my $tag; + my $ti = $self->get_ti_override(); + my $lang = $self->get_language(); + my $override; + + if ($self->exe_target()) { + if ($self->get_static() == 1) { + $tag = 'lib_exe_template_input'; + ## Check for the TemplateInputReader for the template key provided. + if (!defined $self->{$tag}->{$lang}->{$tkey}) { + if (defined $$ti{'lib_exe'}) { + $file = $$ti{'lib_exe'}; + $override = 1; + } + else { + $file = $self->get_lib_exe_template_input_file($tkey); + } + } + } + else { + $tag = 'dll_exe_template_input'; + ## Check for the TemplateInputReader for the template key provided. + if (!defined $self->{$tag}->{$lang}->{$tkey}) { + if (defined $$ti{'dll_exe'}) { + $file = $$ti{'dll_exe'}; + $override = 1; + } + else { + $file = $self->get_dll_exe_template_input_file($tkey); + } + } + } + } + else { + if ($self->get_static() == 1) { + $tag = 'lib_template_input'; + ## Check for the TemplateInputReader for the template key provided. + if (!defined $self->{$tag}->{$lang}->{$tkey}) { + if (defined $$ti{'lib'}) { + $file = $$ti{'lib'}; + $override = 1; + } + else { + $file = $self->get_lib_template_input_file($tkey); + } + } + } + else { + $tag = 'dll_template_input'; + ## Check for the TemplateInputReader for the template key provided. + if (!defined $self->{$tag}->{$lang}->{$tkey}) { + if (defined $$ti{'dll'}) { + $file = $$ti{'dll'}; + $override = 1; + } + else { + $file = $self->get_dll_template_input_file($tkey); + } + } + } + } + + if (defined $self->{$tag}->{$lang}->{$tkey}) { + ## We have a TemplateInputReader for this template key, so we need + ## to set the entry corresponding to $tikey to it for use in the + ## get_template_input() method. + $self->{$tag}->{$lang}->{$tikey} = $self->{$tag}->{$lang}->{$tkey}; + } + else { + ## We haven't read this file yet, so we will create the template + ## input reader and store it in the entry for the template key + ## ($tkey) and the template input key ($tikey). + my $ti = new TemplateInputReader($self->get_include_path()); + $self->{$tag}->{$lang}->{$tkey} = $ti; + $self->{$tag}->{$lang}->{$tikey} = $ti; + + ## Process the template input file + if (defined $file) { + my $tfile = $self->search_include_path("$file.$TemplateInputExtension"); + if (defined $tfile) { + ($status, $errorString) = $ti->read_file($tfile); + } + else { + ## Not finding a template input file is only an error if the user + ## specifically provided a template input file override. + if ($override) { + $status = 0; + $errorString = "Unable to locate template input file: $file"; + } + } + } + + ## Now that we've read in the template input file, set up our + ## automatic template variables. + if ($self->{'make_coexistence'}) { + $ti->parse_line(undef, + "make_coexistence = $self->{'make_coexistence'}"); + } + } + + ## We do this regardless of whether or not this parser is cached or + ## not. If the features have changed (through a workspace cmdline + ## setting), we need to reflect it. + if ($status) { + ## Put the features into the template input set + my $features = $self->{'feature_parser'}->get_names(); + $self->{$tag}->{$lang}->{$tikey}->parse_line(undef, + "features = @$features"); + } + + return $status, $errorString; +} + + +sub already_added { + my($self, $array, $name) = @_; + + ## This method expects that the file name will be unix style + $name =~ s/\\/\//g if ($self->{'convert_slashes'}); + + ## Remove the leading ./ + $name =~ s/^\.\///; + my $dsname = "./$name"; + + foreach my $file (@$array) { + return 1 if ($file eq $name || $file eq $dsname); + } + + return 0; +} + + +sub get_applied_custom_keyword { + my($self, $name, $type, $file) = @_; + + if (defined $self->{'flag_overrides'}->{$type} && + defined $self->{'flag_overrides'}->{$type}->{$file} && + defined $self->{'flag_overrides'}->{$type}->{$file}->{$name}) { + return $self->relative( + $self->{'flag_overrides'}->{$type}->{$file}->{$name}, 1); + } + + return $self->relative($self->get_assignment( + $name, + $self->{'generated_exts'}->{$type}), 1); +} + + +sub evaluate_optional_option { + my($self, $opt, $value) = @_; + + if ($opt =~ /^!\s*(.*)/) { + return (!exists $$value{$1} ? 1 : 0); + } + else { + return (exists $$value{$opt} ? 1 : 0); + } +} + + +sub process_optional_option { + my($self, $opt, $value) = @_; + my $status; + my @parts = grep(!/^$/, split(/\s+/, $opt)); + my $pcount = scalar(@parts); + + for(my $i = 0; $i < $pcount; $i++) { + if ($parts[$i] eq '&&' || $parts[$i] eq '||') { + if (defined $status) { + if (defined $parts[$i + 1]) { + if ($parts[$i] eq '&&') { + $status &&= $self->evaluate_optional_option($parts[$i + 1], + $value); + } + else { + ## We are coming into an '||', if status is already true + ## then we can leave immediately + last if ($status); + + $status ||= $self->evaluate_optional_option($parts[$i + 1], + $value); + } + } + else { + $self->warning("Expected token in optional after $parts[$i]"); + } + } + else { + $self->warning("Unexpected token in optional: $parts[$i]"); + } + ++$i; + } + else { + if (!defined $status) { + $status = $self->evaluate_optional_option($parts[$i], $value); + } + else { + $self->warning("Unexpected token in optional: $parts[$i]"); + } + } + } + + return $status; +} + + +sub add_optional_filename_portion { + my($self, $gentype, $tag, $file, $array) = @_; + + if (defined $self->{'generated_exts'}->{$gentype}->{'optional'}->{$tag}) { + foreach my $name (keys %{$self->{'generated_exts'}->{$gentype}->{'optional'}->{$tag}}) { + foreach my $opt (keys %{$self->{'generated_exts'}->{$gentype}->{'optional'}->{$tag}->{$name}}) { + ## Get the name value + my $value = $self->get_applied_custom_keyword($name, + $gentype, $file); + + ## Convert the value into a hash map for easy lookup + my %values; + @values{split(/\s+/, $value)} = () if (defined $value); + + ## See if the option or options are contained in the value. We + ## need to call this even if $value is not defined due to the + ## ability to negate optional parameters. + if ($self->process_optional_option($opt, \%values)) { + ## Add the optional portion + push(@$array, @{$self->{'generated_exts'}->{$gentype}->{'optional'}->{$tag}->{$name}->{$opt}}); + } + } + } + } +} + + +sub get_pre_keyword_array { + my($self, $keyword, $gentype, $tag, $file) = @_; + + ## Get the general pre extension array. + ## $self->{'generated_exts'}->{$gentype}->{$keyword} is guaranteed to + ## be defined due to the defaulting that is done in + ## parse_define_custom() and the only three calls to this method use + ## valid $keyword values. + my @array = @{$self->{'generated_exts'}->{$gentype}->{$keyword}}; + + ## Add the component specific pre extension array + my @additional; + $tag =~ s/files$/$keyword/; + if (defined $self->{'generated_exts'}->{$gentype}->{$tag}) { + push(@additional, @{$self->{'generated_exts'}->{$gentype}->{$tag}}); + } + + ## Add in any optional portion to the array + foreach my $itag ($keyword, $tag) { + $self->add_optional_filename_portion($gentype, $itag, + $file, \@additional); + } + + ## If the current array only has the default, + ## then we need to remove it + if (defined $additional[0]) { + if ($#array == 0 && $array[0] eq '') { + pop(@array); + } + push(@array, @additional); + } + + return @array; +} + + +sub add_explicit_output { + my($self, $file, $type, $tag, $array, $arrs) = @_; + + if (defined $self->{'custom_special_output'}->{$type} && + defined $self->{'custom_special_output'}->{$type}->{$file}) { + if (defined $self->{'valid_components'}->{$tag}) { + my @files; + foreach my $check (@{$self->{'custom_special_output'}->{$type}->{$file}}) { + foreach my $regext (@{$self->{'valid_components'}->{$tag}}) { + if ($check =~ /$regext$/) { + my $add = 1; + if ($tag eq 'source_files') { + foreach my $tregext (@{$self->{'valid_components'}->{'template_files'}}) { + if ($check =~ /$tregext$/) { + $add = undef; + last; + } + } + } + if ($add) { + ## If gendir was specified, then we need to account for that + my $dir = ''; + if (defined $self->{'flag_overrides'}->{$type} && + defined $self->{'flag_overrides'}->{$type}->{$file} && + defined $self->{'flag_overrides'}->{$type}->{$file}->{'gendir'} && + $self->{'flag_overrides'}->{$type}->{$file}->{'gendir'} ne '.') { + $dir = $self->{'flag_overrides'}->{$type}->{$file}->{'gendir'} . '/'; + $dir =~ s/\\/\//g if ($self->{'convert_slashes'}); + } + + push(@files, "$dir$check"); + last; + } + } + } + } + if (defined $files[0]) { + if ($arrs) { + push(@$array, \@files); + } + else { + push(@$array, @files); + } + } + } + } +} + +sub generated_filenames { + my($self, $part, $type, $tag, $file, $noext, $arrs) = @_; + + ## A custom type is not allowed to generate it's own input files + return () if ($type eq $tag); + + ## See if the type for which we are generating ($tag) is also a custom + ## file type. If it is, we need to do some massaging. + my $otag = $tag; + if (defined $self->{'generated_exts'}->{$tag}) { + ## If the custom type ($type) doesn't specify that it generates + ## generic files, we need to see if there is a command helper for + ## this type and see what sort of output it knows about. + my $inputexts = $self->{'generated_exts'}->{$type}->{$generic_key}; + if (!defined $inputexts) { + my $cmdHelper = CommandHelper::get($type); + $inputexts = $cmdHelper->get_outputexts() if (defined $cmdHelper); + } + + ## We will need to use 'generic_files' instead of $tag if $tag is + ## defined in 'generated_exts', but only for the type that will + ## actually generate the right type of generic file. + my $good; + if (defined $inputexts) { + foreach my $inputext (@$inputexts) { + my $ext = $inputext; + $ext =~ s/\\//g; + foreach my $extreg (@{$self->{'valid_components'}->{$tag}}) { + if ($ext =~ /$extreg$/) { + $tag = $generic_key; + $good = 1; + last; + } + } + last if ($good); + } + } + return () if (!$good); + } + + my @pearr = $self->get_pre_keyword_array('pre_extension', + $type, $tag, $file); + my @pfarr = $self->get_pre_keyword_array('pre_filename', + $type, $tag, $file); + my @pdarr = $self->get_pre_keyword_array('pre_dirname', + $type, $tag, $file); + my @exts = (defined $self->{'generated_exts'}->{$type}->{$tag} ? + @{$self->{'generated_exts'}->{$type}->{$tag}} : ()); + + if (!defined $exts[0]) { + my $backtag = $tag; + if ($backtag =~ s/files$/outputext/) { + $self->add_optional_filename_portion($type, $backtag, + $file, \@exts); + } + } + + my @array; + if (!defined $exts[0] && $#pearr == 0 && $#pfarr == 0 && $#pdarr == 0 && + $pearr[0] eq '' && $pfarr[0] eq '' && $pdarr[0] eq '') { + ## If both arrays are defined to be the defaults, then there + ## is nothing for us to do. + } + else { + my $dir = ''; + my $base; + + ## Correctly deal with pre filename and directories + if ($part =~ /(.*[\/\\])([^\/\\]+)$/) { + ## Split the directory and base name of the file. Only set the + ## directory if the output follows the input directory. + $dir = $1 + if ($self->{'generated_exts'}->{$type}->{'output_follows_input'}); + $base = $2; + } + else { + $base = $part; + } + + ## If gendir was specified, then we need to account for that + if (defined $self->{'flag_overrides'}->{$type} && + defined $self->{'flag_overrides'}->{$type}->{$file} && + defined $self->{'flag_overrides'}->{$type}->{$file}->{'gendir'}) { + if ($self->{'flag_overrides'}->{$type}->{$file}->{'gendir'} eq '.') { + $dir = ''; + } + else { + $dir = $self->{'flag_overrides'}->{$type}->{$file}->{'gendir'} . '/'; + $dir =~ s/\\/\//g if ($self->{'convert_slashes'}); + } + } + + ## Loop through creating all of the possible file names + foreach my $pe (@pearr) { + my @genfile; + $pe =~ s/\\\././g; + foreach my $pf (@pfarr) { + $pf =~ s/\\\././g; + foreach my $pd (@pdarr) { + if ($noext) { + push(@genfile, "$pd$dir$pf$base$pe"); + } + else { + foreach my $ext (@exts) { + $ext =~ s/\\\././g; + push(@genfile, "$pd$dir$pf$base$pe$ext"); + } + } + } + } + if ($arrs) { + push(@array, \@genfile); + } + else { + push(@array, @genfile); + } + } + } + + ## Now add the explicit output. We need to use the original tag value + ## ($otag) so that we can find the custom output files. + $self->add_explicit_output($file, $type, $otag, \@array, $arrs); + return @array; +} + + +sub add_generated_files { + my($self, $gentype, $tag, $group, $arr) = @_; + + ## This method is called by list_default_generated. It performs the + ## actual file insertion and grouping. + + ## Get the generated filenames + my @added; + foreach my $file (keys %$arr) { + foreach my $gen ($self->generated_filenames($$arr{$file}, $gentype, + $tag, $file, 1)) { + $self->list_generated_file($gentype, $tag, \@added, $gen, $$arr{$file}); + } + } + + if (defined $added[0]) { + my $names = $self->{$tag}; + + ## Get all files in one list and save the directory + ## and component group in a hashed array. + my @all; + my %dircomp; + foreach my $name (keys %$names) { + foreach my $key (keys %{$$names{$name}}) { + push(@all, @{$$names{$name}->{$key}}); + foreach my $file (@{$$names{$name}->{$key}}) { + $dircomp{$self->mpc_dirname($file)} = $key; + } + } + } + + ## Create a small array of only the files we want to add. + ## We put them all together so we can keep them in order when + ## we put them at the front of the main file list. + my @oktoadd; + foreach my $file (@added) { + push(@oktoadd, $file) if (!$self->already_added(\@all, $file)); + } + + ## If we have files to add, make sure we add them to a group + ## that has the same directory location as the files we're adding. + if (defined $oktoadd[0]) { + my $key = (defined $group ? $group : + $dircomp{$self->mpc_dirname($oktoadd[0])}); + if (!defined $key) { + my $check = $oktoadd[0]; + foreach my $regext (@{$self->{'valid_components'}->{$tag}}) { + last if ($check =~ s/$regext$//); + } + foreach my $vc (keys %{$self->{'valid_components'}}) { + ## If this component name does not match the component name for + ## which we are adding files and there are components defined + ## for it, we will look to see if we can find a matching group + ## name. We have to make sure that we do not use the hash map + ## ($self->{$vc}) unless it's defined. Doing so will + ## automatically create the map and that will cause MPC to + ## think that the user provided the empty setting (when it + ## wasn't). + if ($vc ne $tag && defined $self->{$vc}) { + foreach my $name (keys %{$self->{$vc}}) { + foreach my $ckey (keys %{$self->{$vc}->{$name}}) { + if ($ckey ne $defgroup) { + foreach my $ofile (@{$self->{$vc}->{$name}->{$ckey}}) { + my $file = $ofile; + foreach my $regext (@{$self->{'valid_components'}->{$vc}}) { + last if ($file =~ s/$regext$//); + } + if ($file eq $check) { + $key = $ckey; + last; + } + } + } + last if (defined $key); + } + } + last if (defined $key); + } + } + $key = $defgroup if (!defined $key); + } + foreach my $name (keys %$names) { + if (!defined $$names{$name}->{$key}) { + if ($key ne $defgroup && + defined $$names{$name}->{$defgroup} && + defined $$names{$name}->{$defgroup}->[0]) { + $self->process_assignment_add($grouped_key . $tag, $defgroup); + } + $$names{$name}->{$key} = []; + $self->process_assignment_add($grouped_key . $tag, $key); + } + unshift(@{$$names{$name}->{$key}}, @oktoadd); + } + } + } +} + + +sub search_for_entry { + my($self, $file, $marray, $preproc) = @_; + my $name; + my $fh = new FileHandle(); + + if (open($fh, $file)) { + my $poundifed = 0; + my $commented = 0; + + while(<$fh>) { + ## Remove c++ style comments + $_ =~ s/\/\/.*// if (!$commented); + + ## Remove one line c style comments + $_ =~ s/\/\*.*\*\///g; + + if ($commented) { + if (/\*\//) { + ## Found the end of a multi-line c style comment + --$commented; + } + } + else { + if (/\/\*/) { + ## Found the beginning of a multi-line c style comment + ++$commented; + } + elsif ($preproc) { + ## If the current language supports a c preprocessor, we + ## will perform a minimal check for #if 0 + if (/#\s*if\s+0/) { + ## Found the beginning of a #if 0 + ++$poundifed; + } + elsif ($poundifed) { + if (/#\s*if/) { + ## We need to keep track of any other #if directives + ## to be sure that when we see an #endif we don't + ## count the wrong one. + ++$poundifed; + } + elsif (/#\s*endif/) { + ## Found a #endif, so decrement our count + --$poundifed; + } + } + } + } + + ## Check for main; Make sure it's not #if 0'ed and not commented out + if (!$poundifed && !$commented) { + my $found = undef; + foreach my $main (@$marray) { + if (/\s+$main\s*\(/ || /^\s*$main\s*\(/) { + ## If we've found a main, set the exename to the basename + ## of the cpp file with the extension removed + $name = $self->mpc_basename($file); + $name =~ s/\.[^\.]+$//; + $found = 1; + last; + } + last if ($found); + } + } + } + close($fh); + } + return $name; +} + + +sub find_main_file { + my($self, $sources) = @_; + my $lang = $self->get_language(); + my @main = $language{$lang}->[3]; + my $preproc = $language{$lang}->[4]; + + ## If additional main's have been supplied by the user for this + ## language type, then just push them onto the array. + push(@main, @{$mains{$lang}}) if (defined $mains{$lang}); + + ## Now search each source file until we've found a main function. + foreach my $file (@$sources) { + my $exename = $self->search_for_entry($file, \@main, $preproc); + return $exename if (defined $exename); + } + + return undef; +} + + +sub generate_default_target_names { + my $self = shift; + + ## If this is a custom_only project, we need not waste time setting the + ## sharedname, staticname or exename. Searching all of the files for a + ## main function is very time consuming and unnecessary. + return undef if ($self->get_assignment('custom_only')); + + if (!$self->exe_target()) { + my $sharedname = $self->get_assignment('sharedname'); + my $staticname = $self->get_assignment('staticname'); + my $shared_empty; + + if (defined $sharedname) { + if ($sharedname eq '') { + $shared_empty = 1; + $sharedname = undef; + $self->process_assignment('sharedname', $sharedname); + } + elsif (!defined $staticname) { + $staticname = $sharedname; + $self->process_assignment('staticname', $staticname); + } + } + if (defined $staticname && !$shared_empty && !defined $sharedname) { + $sharedname = $staticname; + $self->process_assignment('sharedname', $sharedname); + } + + ## If it's neither an exe or library target, we will search + ## through the source files for a main() + if (!$self->lib_target()) { + ## Set the exename assignment + my @sources = $self->get_component_list('source_files', 1); + my $exename = $self->find_main_file(\@sources); + $self->process_assignment('exename', $exename) if (defined $exename); + + ## If we still don't have a project type, then we will + ## default to a library if there are source or resource files + if (!defined $exename) { + if (!defined $sources[0]) { + @sources = $self->get_component_list($self->get_resource_tag(), 1); + } + if (defined $sources[0]) { + if (!$shared_empty) { + $self->process_assignment('sharedname', + $self->{'unmodified_project_name'}); + } + $self->process_assignment('staticname', + $self->{'unmodified_project_name'}); + } + } + } + } + + ## If we are generating only static projects, then we need to + ## unset the sharedname, so that we can insure that projects of + ## various types only generate static targets. + if ($self->get_static() == 1) { + my $sharedname = $self->get_assignment('sharedname'); + if (defined $sharedname) { + $self->process_assignment('sharedname', undef); + } + } + + ## Check for the use of an asterisk in the name + foreach my $key ('exename', 'sharedname', 'staticname') { + my $value = $self->get_assignment($key); + if (defined $value && index($value, '*') >= 0) { + $value = $self->fill_type_name($value, + $self->{'unmodified_project_name'}); + $self->process_assignment($key, $value); + } + } +} + + +sub generate_default_pch_filenames { + my($self, $files) = @_; + my $pchhdef = (defined $self->get_assignment('pch_header')); + my $pchcdef = (defined $self->get_assignment('pch_source')); + + if (!$pchhdef || !$pchcdef) { + my $pname = $self->get_assignment('project_name'); + my $hcount = 0; + my $ccount = 0; + my $hmatching; + my $cmatching; + foreach my $file (@$files) { + ## If the file doesn't even contain _pch, then there's no point + ## in looping through all of the extensions + if (index($file, '_pch') >= 0) { + if (!$pchhdef) { + foreach my $ext (@{$self->{'valid_components'}->{'header_files'}}) { + if ($file =~ /(.*_pch$ext)$/) { + $self->process_assignment('pch_header', $1); + ++$hcount; + $hmatching = $file if (index($file, $pname) >= 0); + last; + } + } + } + if (!$pchcdef) { + foreach my $ext (@{$self->{'valid_components'}->{'source_files'}}) { + if ($file =~ /(.*_pch$ext)$/) { + $self->process_assignment('pch_source', $1); + ++$ccount; + $cmatching = $file if (index($file, $pname) >= 0); + last; + } + } + } + } + } + if (!$pchhdef && $hcount > 1 && defined $hmatching) { + $self->process_assignment('pch_header', $hmatching); + } + if (!$pchcdef && $ccount > 1 && defined $cmatching) { + $self->process_assignment('pch_source', $cmatching); + } + } +} + + +sub fix_pch_filenames { + my $self = shift; + + ## Unset the precompiled header settings if they are set but empty + foreach my $type ('pch_header', 'pch_source') { + my $pch = $self->get_assignment($type); + $self->process_assignment($type, undef) if (defined $pch && $pch eq ''); + } +} + + +sub remove_extra_pch_listings { + my $self = shift; + my @pchs = ('pch_header', 'pch_source'); + my @tags = ('header_files', 'source_files'); + + for(my $j = 0; $j < 2; ++$j) { + my $pch = $self->get_assignment($pchs[$j]); + + if (defined $pch) { + ## If we are converting slashes, then we need to + ## convert the pch file back to forward slashes + $pch =~ s/\\/\//g if ($self->{'convert_slashes'}); + + ## Find out which files are duplicated + my $names = $self->{$tags[$j]}; + foreach my $name (keys %$names) { + my $comps = $$names{$name}; + foreach my $key (keys %$comps) { + my $array = $$comps{$key}; + my $count = scalar(@$array); + for(my $i = 0; $i < $count; ++$i) { + if ($pch eq $$array[$i]) { + splice(@$array, $i, 1); + --$count; + } + } + } + } + } + } +} + + +sub sift_files { + my($self, $files, $exts, $pchh, $pchc, $tag, $array, $alldir) = @_; + my @saved; + my $havec = (defined $self->{'exclude_components'}->{$tag}); + + ## The special actions taken based on $saverc only applies to + ## C++ resource files. + my $saverc = (!$alldir && $tag eq $self->get_resource_tag() && + $self->languageIs(Creator::cplusplus)); + + foreach my $ext (@$exts) { + foreach my $file (grep(/$ext$/, @$files)) { + ## Always exclude the precompiled header and cpp + if ((!defined $pchh || $file ne $pchh) && + (!defined $pchc || $file ne $pchc)) { + if ($havec) { + my $exclude = 0; + foreach my $exc (@{$self->{'exclude_components'}->{$tag}}) { + if ($file =~ /$exc$/) { + $exclude = 1; + last; + } + } + next if ($exclude); + } + elsif ($saverc) { + ## Save these files for later. There may + ## be more than one and we want to try and + ## find the one that corresponds to this project + push(@saved, $file); + next; + } + + push(@$array, $file) if (!$self->already_added($array, $file)); + } + } + } + + ## Now deal with the saved files + if (defined $saved[0]) { + if (!defined $saved[1]) { + ## Theres only one rc file, take it + push(@$array, $saved[0]); + } + else { + my $pjname = $self->escape_regex_special( + $self->transform_file_name( + $self->get_assignment('project_name'))); + ## Use a case insensitive search. + ## After all, this is a Windows specific file type. + foreach my $save (@saved) { + if ($save =~ /$pjname/i) { + if (!$self->already_added($array, $save)) { + push(@$array, $save); + } + } + } + } + } +} + + +sub sift_default_file_list { + my($self, $tag, $file, $built, $exts, $recurse, $pchh, $pchc) = @_; + my $alldir = $recurse || + (defined $self->{'flag_overrides'}->{$tag} && + defined $self->{'flag_overrides'}->{$tag}->{$file} && + $self->{'flag_overrides'}->{$tag}->{$file}->{'recurse'}); + my @gen = $self->generate_default_file_list($file, [], undef, $alldir); + + $self->sift_files(\@gen, $exts, $pchh, $pchc, $tag, $built, $alldir); +} + + +sub correct_generated_files { + my($self, $defcomp, $exts, $tag, $array) = @_; + + if (defined $sourceComponents{$tag}) { + my $grtag = $grouped_key . $tag; + foreach my $gentype (keys %{$self->{'generated_exts'}}) { + ## If we are not automatically adding generated output, then we + ## need to skip this component type. + next if (!$self->{'generated_exts'}->{$gentype}->{'automatic_out'}); + + ## If we are auto-generating the source_files, then + ## we need to make sure that any generated source + ## files that are added are put at the front of the list. + my $newgroup; + my @input; + + ## If I call keys %{$self->{$gentype}} using perl 5.6.1 + ## it returns nothing. I have to put it in an + ## intermediate variable to ensure that I get the keys. + my $names = $self->{$gentype}; + foreach my $name (keys %$names) { + foreach my $key (keys %{$$names{$name}}) { + push(@input, @{$$names{$name}->{$key}}); + $newgroup = $key if ($key ne $defgroup); + } + } + + if (defined $input[0]) { + my @front; + my @copy = @$array; + + @$array = (); + foreach my $input (@input) { + my $part = $self->remove_wanted_extension( + $input, + $self->{'valid_components'}->{$gentype}); + + my @files = $self->generated_filenames($part, $gentype, + $tag, $input); + if (defined $copy[0]) { + my $found = 0; + foreach my $file (@files) { + for(my $i = 0; $i < scalar(@copy); $i++) { + my $re = $self->escape_regex_special($copy[$i]); + if ($file eq $copy[$i] || $file =~ /[\/\\]$re$/) { + ## No need to check for previously added files + ## here since there are none. + $found = 1; + push(@front, $file); + splice(@copy, $i, 1); + last; + } + } + last if ($found); + } + if (!$found) { + ## The first file listed in @files is the preferred + ## extension for the custom command. Take the first + ## file extension and see if it matches one in the accepted + ## extensions. + if (defined $files[0]) { + my $ext; + if ($files[0] =~ /.*(\.[^\.]+)$/) { + $ext = $self->escape_regex_special($1); + } + if (defined $ext) { + ## If it doesn't match one of the accepted extensions, + ## then just use the first extension from the type for + ## which we are generating. + $ext = $$exts[0] if (!StringProcessor::fgrep($ext, $exts)); + } + + ## Add all the files that match the chosen extension + foreach my $file (@files) { + push(@front, $file) if ($file =~ /$ext$/); + } + } + } + } + else { + my $ext = $$exts[0]; + foreach my $file (@files) { + push(@front, $file) if ($file =~ /$ext$/); + } + } + } + if (defined $copy[0]) { + ## No need to check for previously added files + ## here since there are none. + push(@$array, @copy); + if (defined $self->get_assignment($grtag)) { + $self->process_assignment_add($grtag, $defgroup); + } + } + if (defined $front[0]) { + if (defined $newgroup) { + if (defined $copy[0]) { + $self->process_assignment_add($grtag, $defgroup); + } + if (!defined $self->{$tag}->{$defcomp}->{$newgroup}) { + $self->{$tag}->{$defcomp}->{$newgroup} = \@front; + } + else { + push(@{$self->{$tag}->{$defcomp}->{$newgroup}}, @front); + } + $self->process_assignment_add($grtag, $newgroup); + } + else { + unshift(@$array, @front); + } + } + } + } + } +} + + +sub generate_default_components { + my($self, $files, $passed) = @_; + my $genext = $self->{'generated_exts'}; + my @gc = reverse sort { $self->sort_generated_types($a, $b) + } keys %$genext; + my @tags = (defined $passed ? $passed : + (@gc, keys %{$language{$self->get_language()}->[0]})); + my $pchh = $self->get_assignment('pch_header'); + my $pchc = $self->get_assignment('pch_source'); + my $recurse = $self->get_assignment('recurse'); + my $defcomp = $self->get_default_component_name(); + my $flo = $self->{'flag_overrides'}; + my $cmdflags = 'commandflags'; + + ## The order of @tags does make a difference in the way that generated + ## files get added. Hence the sort call on the generate_exts keys to + ## ensure that user defined types come first. They are reverse sorted + ## using the custom sort function to ensure that user defined types + ## that rely on other user defined types for input files are processed + ## first. + foreach my $tag (@tags) { + if (!defined $genext->{$tag} || + $genext->{$tag}->{'automatic_in'}) { + my $exts = $self->{'valid_components'}->{$tag}; + if (defined $$exts[0]) { + if (defined $self->{$tag}) { + ## If the tag is defined, then process directories + my $names = $self->{$tag}; + foreach my $name (keys %$names) { + my $comps = $$names{$name}; + foreach my $comp (keys %$comps) { + my $array = $$comps{$comp}; + if (defined $passed) { + $self->sift_files($files, $exts, $pchh, $pchc, $tag, $array); + } + else { + my @built; + my $alldirs = 1; + foreach my $file (@$array) { + if (-d $file) { + my @portion; + $self->sift_default_file_list($tag, $file, \@portion, + $exts, $recurse, $pchh, $pchc); + + ## Since the file was actually a directory, we will + ## need to propagate the flag overrides (if there are + ## any) to the newly located files. + if (defined $flo->{$tag} && + defined $flo->{$tag}->{$file}) { + foreach my $built (@portion) { + $flo->{$tag}->{$built} = $flo->{$tag}->{$file}; + } + } + + ## Always push the @portion array onto the back of + ## @built. + push(@built, @portion); + } + else { + $alldirs = undef; + if (!$self->already_added(\@built, $file)) { + push(@built, $file); + } + } + } + if ($alldirs) { + $self->correct_generated_files($defcomp, $exts, + $tag, \@built); + } + $$comps{$comp} = \@built; + } + } + } + } + else { + ## Generate default values for undefined tags + $self->{$tag} = {}; + my $comps = {}; + $self->{$tag}->{$defcomp} = $comps; + $$comps{$defgroup} = []; + my $array = $$comps{$defgroup}; + + $self->{'defaulted'}->{$tag} = 1; + + if (!defined $specialComponents{$tag}) { + $self->sift_files($files, $exts, $pchh, $pchc, $tag, $array); + $self->correct_generated_files($defcomp, $exts, $tag, $array); + } + } + + ## If the type that we're generating defaults for ($tag) is a + ## custom type, then we need to see if other custom types + ## ($gentype) will generate files that will be used as input. It + ## has to be done here so that the built-in types will have all + ## of the possible input files that they can. + if (defined $genext->{$tag}) { + foreach my $gentype (keys %{$genext}) { + if ($gentype ne $tag) { + $self->list_default_generated($gentype, [$tag]); + } + } + + ## Now that we have the files for this type ($tag), we need to + ## locate a command helper for the custom command and see if it + ## knows about any additional output files based on the file + ## name. + my $cmdHelper = CommandHelper::get($tag); + if (defined $cmdHelper) { + my $names = $self->{$tag}; + foreach my $name (keys %$names) { + my $comps = $$names{$name}; + foreach my $comp (keys %$comps) { + my $array = $$comps{$comp}; + foreach my $file (@$array) { + my $flags = defined $flo->{$tag}->{$file} ? + $flo->{$tag}->{$file}->{$cmdflags} : + $genext->{$tag}->{$cmdflags}; + my $add_out = $cmdHelper->get_output($file, $flags); + push(@{$self->{'custom_special_output'}->{$tag}->{$file}}, + @$add_out); + } + } + } + } + } + } + } + } +} + + +sub remove_duplicated_files { + my($self, $dest, $source) = @_; + my @slist = $self->get_component_list($source, 1); + + ## There's no point in going on if there's nothing in this component + ## list. + return undef if ($#slist == -1); + + ## Convert the array into keys for a hash table + my %shash; + @shash{@slist} = (); + + ## Find out which source files are listed + my $names = $self->{$dest}; + foreach my $name (keys %$names) { + foreach my $key (keys %{$$names{$name}}) { + my $array = $$names{$name}->{$key}; + my $count = scalar(@$array); + for(my $i = 0; $i < $count; ++$i) { + ## Is the source file in the component array? + if (exists $shash{$$array[$i]}) { + ## Remove the element and fix the index and count + splice(@$array, $i, 1); + --$count; + --$i; + } + } + } + } +} + + +sub generated_source_listed { + my($self, $gent, $tag, $arr, $sext) = @_; + my $names = $self->{$tag}; + + ## Find out which generated source files are listed + foreach my $name (keys %$names) { + my $comps = $$names{$name}; + foreach my $key (keys %$comps) { + foreach my $val (@{$$comps{$key}}) { + foreach my $i (keys %$arr) { + ## If $gent doesn't cause $tag files to be generated, then we + ## can just return a non-zero value to short-circuit attempting + ## to add generated files after the caller continues. + my @gfiles = $self->generated_filenames($$arr{$i}, $gent, $tag, $i); + return 2 if ($#gfiles == -1); + + foreach my $re (@gfiles) { + $re = $self->escape_regex_special($re); + return 1 if ($val =~ /$re$/); + } + } + } + } + } + + return 0; +} + + +sub list_default_generated { + my($self, $gentype, $tags) = @_; + + ## This method is called when the user has custom input files and has + ## provided source files. If the user defaults the component (i.e. + ## source_files, resource_files, etc.) they are filled in by the + ## generate_default_components method. + + if (defined $self->{'generated_exts'}->{$gentype} && + $self->{'generated_exts'}->{$gentype}->{'automatic_out'}) { + ## After all source and headers have been defaulted, see if we + ## need to add the generated files + if (defined $self->{$gentype}) { + ## Build up the list of files + my %arr; + my $names = $self->{$gentype}; + my $group; + foreach my $name (keys %$names) { + foreach my $key (keys %{$$names{$name}}) { + my $array = $$names{$name}->{$key}; + + ## Take the last group name we encounter + $group = $key if ($key ne $defgroup); + + foreach my $val (@$array) { + $arr{$val} = $self->remove_wanted_extension( + $val, + $self->{'valid_components'}->{$gentype}); + } + } + } + + foreach my $type (@$tags) { + ## Do not add generated files if they are "special" + ## unless they haven't been explicitly supplied. + if ($gentype ne $type && + (!$specialComponents{$type} || + (!$self->{'special_supplied'}->{$type} || + UNIVERSAL::isa($self->{'special_supplied'}->{$type}, 'ARRAY')))) { + if (!$self->generated_source_listed( + $gentype, $type, \%arr, + $self->{'valid_components'}->{$gentype})) { + $self->add_generated_files($gentype, $type, $group, \%arr); + } + } + } + } + } +} + + +sub prepend_gendir { + my($self, $created, $ofile, $gentype) = @_; + my $key; + + if (defined $self->{'flag_overrides'}->{$gentype}) { + foreach my $ext (@{$self->{'valid_components'}->{$gentype}}) { + my $e = $ext; + $e =~ s/\\//g; + $key = "$ofile$e"; + + last if (defined $self->{'flag_overrides'}->{$gentype}->{$key}); + $key = undef; + } + + if (defined $key) { + if (StringProcessor::fgrep('gendir', + $self->{'matching_assignments'}->{$gentype})) { + my $dir = $self->{'flag_overrides'}->{$gentype}->{$key}->{'gendir'}; + if (defined $dir) { + ## Convert the file to unix style for basename + if ($self->{'convert_slashes'}) { + $created =~ s/\\/\//g; + $dir =~ s/\\/\//g; + } + return ($dir eq '.' ? '' : "$dir/") . $self->mpc_basename($created); + } + } + } + } + + return $created; +} + + +sub list_generated_file { + my($self, $gentype, $tag, $array, $file, $ofile) = @_; + my $count = 0; + + ## Go through each file listed in our original type and attempt to find + ## out if it is the generated file we may need to add ($file). + foreach my $gen ($self->get_component_list($gentype, 1)) { + my $input = $gen; + + ## Take the file and see if it contains an extension that our + ## generating type ($gentype) knows about. If it does, remove it and + ## stop looking for the extension. + foreach my $ext (@{$self->{'valid_components'}->{$gentype}}) { + ## Remove the extension. + ## If it works, then we can exit this loop. + last if ($gen =~ s/$ext$//); + } + + ## If the user provided file does not match any of the + ## extensions specified by the custom definition, we need + ## to remove the extension or else this file will not be + ## added to the project. + $gen =~ s/\.[^\.]+$// if ($gen eq $input); + + ## See if we need to add the file. We always need to check since the + ## output file may have absolutely nothing in common with the input + ## file. + foreach my $created ($self->generated_filenames($gen, $gentype, + $tag, $input)) { + ## $gen is a file that has a custom definition that generates + ## files of the type $tag. The $file passed in is of type + ## $gentype and, as far as I can tell, $created will always be + ## longer or of the same length of $file. It doesn't really + ## matter if $file contains a '.' or not. + if (index($created, $file) != -1) { + if (defined $ofile) { + $created = $self->prepend_gendir($created, $ofile, $gentype); + } + if (!$self->already_added($array, $created)) { + push(@$array, $created); + ++$count; + } + last; + } + } + } + + return $count; +} + + +sub add_corresponding_component_files { + my($self, $filecomp, $tag) = @_; + my $grname = $grouped_key . $tag; + + ## Create a hash array keyed off of the existing files of the type + ## that we plan on adding. + my $fexist = 0; + my %scfiles; + my $names = $self->{$tag}; + foreach my $name (keys %$names) { + ## Check to see if files exist in the default group + if (defined $$names{$name}->{$defgroup} && + defined $$names{$name}->{$defgroup}->[0]) { + $fexist = 1; + } + foreach my $comp (keys %{$$names{$name}}) { + @scfiles{@{$$names{$name}->{$comp}}} = (); + } + } + + ## Create an array of extensions for the files we want to add + my @exts; + foreach my $ext (@{$self->{'valid_components'}->{$tag}}) { + push(@exts, $ext); + $exts[$#exts] =~ s/\\//g; + } + + ## Check each file against a possible new file addition + my $adddefaultgroup = 0; + my $oktoadddefault = 0; + foreach my $sfile (keys %$filecomp) { + my $found = 0; + foreach my $ext (@exts) { + if (exists $scfiles{"$sfile$ext"}) { + $found = 1; + last; + } + } + + if (!$found) { + ## Get the array of files for the selected component name + my $array = []; + my $comp = $$filecomp{$sfile}; + foreach my $name (keys %$names) { + if (defined $$names{$name}->{$comp}) { + $array = $$names{$name}->{$comp}; + } + } + + ## First, see if it will be generated so that we can correctly + ## deal with 'gendir' settings. + foreach my $gentype (keys %{$self->{'generated_exts'}}) { + $found += $self->list_generated_file($gentype, $tag, $array, $sfile); + } + + ## Next check to see if the file exists + if (!$found) { + foreach my $ext (@exts) { + if (-r "$sfile$ext") { + my $file = "$sfile$ext"; + if (!$self->already_added($array, $file)) { + push(@$array, $file); + ++$found; + } + last; + } + } + } + + ## If we have any files at all in the component array, check + ## to see if we need to add a new group name + if (defined $$array[0]) { + if ($comp eq $defgroup) { + $adddefaultgroup = 1; + } + else { + my $grval = $self->get_assignment($grname); + if (!defined $grval || + !StringProcessor::fgrep($comp, $self->create_array($grval))) { + $self->process_assignment_add($grname, $comp); + } + $oktoadddefault = 1; + $adddefaultgroup |= $fexist; + } + + ## Put the array back into the component list + if ($found) { + foreach my $name (keys %$names) { + $$names{$name}->{$comp} = $array; + } + } + } + } + } + + ## We only need to add the default group name if we wanted to + ## add the default group when adding new files and we added a group + ## by some other name. Otherwise, defaulted files would always be + ## in a group, which is not what we want. + if ($adddefaultgroup && $oktoadddefault) { + $self->process_assignment_add($grname, $defgroup); + } +} + + +sub get_default_project_name { + my $self = shift; + my $name = $self->{'current_input'}; + + if ($name eq '') { + $name = $self->transform_file_name($self->base_directory()); + } + else { + ## Since files on UNIX can have back slashes, we transform them + ## into underscores. + $name =~ s/\\/_/g; + + ## Convert the name to a usable name + $name = $self->transform_file_name($name); + + ## Take off the extension + $name =~ s/\.[^\.]+$//; + } + + return $name; +} + + +sub remove_excluded { + my $self = shift; + my @tags = @_; + + ## Process each file type and remove the excluded files + foreach my $tag (@tags) { + my $names = $self->{$tag}; + foreach my $name (keys %$names) { + foreach my $comp (keys %{$$names{$name}}) { + my $count = scalar(@{$$names{$name}->{$comp}}); + for(my $i = 0; $i < $count; ++$i) { + my $file = $$names{$name}->{$comp}->[$i]; + if (defined $self->{'remove_files'}->{$tag}->{$file}) { + splice(@{$$names{$name}->{$comp}}, $i, 1); + --$i; + --$count; + } + else { + ## The file does not match exactly with one of the files to + ## remove. Look for wildcard specifications in the files to + ## be removed and perform the removal if one of them matches + ## the current file. + foreach my $key (keys %{$self->{'remove_files'}->{$tag}}) { + if ($key =~ /[\*\?\[\]]/) { + my $regex = $key; + $regex =~ s/\./\\./g; + $regex =~ s/\*/\.\*/g; + $regex =~ s/\?/\./g; + if ($file =~ /^$regex$/) { + splice(@{$$names{$name}->{$comp}}, $i, 1); + --$i; + --$count; + last; + } + } + } + } + } + } + } + delete $self->{'remove_files'}->{$tag}; + } +} + + +sub sort_generated_types { + ## We need to sort the custom component types such that a custom type + ## that generates input for another custom type comes first in the + ## list. + my($self, $left, $right, $norecurse) = @_; + foreach my $key (keys %{$self->{'generated_exts'}->{$left}}) { + if ($key =~ /_files$/) { + foreach my $regex (@{$self->{'generated_exts'}->{$left}->{$key}}) { + my $ext = $regex; + $ext =~ s/\\//g; + foreach my $vreg (@{$self->{'valid_components'}->{$right}}) { + return -1 if ($ext =~ /$vreg$/); + } + } + } + } + if (!$norecurse && $self->sort_generated_types($right, $left, 1) == -1) { + return 1; + } + + return 0; +} + +sub generate_defaults { + my $self = shift; + + ## Generate default project name + if (!defined $self->get_assignment('project_name')) { + $self->set_project_name($self->get_default_project_name()); + } + + ## Generate the default pch file names (if needed) + my @files = $self->generate_default_file_list( + '.', [], + undef, $self->get_assignment('recurse')); + $self->generate_default_pch_filenames(\@files); + + ## If the pch file names are empty strings then we need to fix that + $self->fix_pch_filenames(); + + ## Generate default components, but %specialComponents + ## are skipped in the initial default components generation + $self->generate_default_components(\@files); + + ## Remove source files that are also listed in the template files + ## If we do not do this, then generated projects can be invalid. + $self->remove_duplicated_files('source_files', 'template_files'); + + ## If pch files are listed in header_files or source_files more than + ## once, we need to remove the extras + $self->remove_extra_pch_listings(); + + ## Generate the default generated list of files only if we defaulted + ## the generated file list. I want to ensure that source_files comes + ## first in the list to pick up group information (since source_files + ## are most likely going to be grouped than anything else). + my @vc = sort { return -1 if $a eq 'source_files'; + return 1 if $b eq 'source_files'; + return $b cmp $a; } keys %{$self->{'valid_components'}}; + my @gvc = sort { $self->sort_generated_types($a, $b) + } keys %{$self->{'generated_exts'}}; + foreach my $gentype (@gvc) { + $self->list_default_generated($gentype, \@vc); + } + + ## Now that all of the source files have been added + ## we need to remove those that have need to be removed + $self->remove_excluded('source_files'); + + ## Collect up all of the source files that have already been listed + ## with the extension removed for use directly below. + my %sourcecomp; + foreach my $sourcetag (keys %sourceComponents) { + my $names = $self->{$sourcetag}; + foreach my $name (keys %$names) { + foreach my $comp (keys %{$$names{$name}}) { + foreach my $sfile (@{$$names{$name}->{$comp}}) { + my $mod = $sfile; + $mod =~ s/\.[^\.]+$//; + $sourcecomp{$mod} = $comp; + } + } + } + } + + ## Add %specialComponents files based on the + ## source_components (i.e. .h and .i or .inl based on .cpp) + foreach my $tag (keys %specialComponents) { + $self->add_corresponding_component_files(\%sourcecomp, $tag); + } + + ## Now, if the %specialComponents are still empty + ## then take any file that matches the components extension + foreach my $tag (keys %specialComponents) { + if (!$self->{'special_supplied'}->{$tag} || + UNIVERSAL::isa($self->{'special_supplied'}->{$tag}, 'ARRAY')) { + my $names = $self->{$tag}; + if (defined $names) { + ## We only want to generate default components if we have + ## defaulted the source files or we have no files listed + ## in the current special component. + my $ok = $self->{'defaulted'}->{'source_files'}; + if (!$ok) { + my @all; + foreach my $name (keys %$names) { + foreach my $key (keys %{$$names{$name}}) { + push(@all, @{$$names{$name}->{$key}}); + } + } + $ok = (!defined $all[0]); + } + if ($ok) { + ## If the "special" type was supplied and it was all + ## directories, we need to use those directories to generate + ## the default components instead of the current directory. + my $fileref = \@files; + if (defined $self->{'special_supplied'}->{$tag} && + UNIVERSAL::isa($self->{'special_supplied'}->{$tag}, 'ARRAY')) { + my @special; + foreach my $dir (@{$self->{'special_supplied'}->{$tag}}) { + push(@special, $self->generate_default_file_list( + $dir, [], undef, + $self->get_assignment('recurse'))); + } + $fileref = \@special; + } + $self->generate_default_components($fileref, $tag); + } + } + } + } + + ## Now that all of the other files have been added + ## we need to remove those that have need to be removed + my @rmkeys = keys %{$self->{'remove_files'}}; + $self->remove_excluded(@rmkeys) if (defined $rmkeys[0]); + + ## Tie custom files together if need be. This currently only applies + ## to types with command helpers. At some point, if it is found to be + ## desirous, we could extend the MPC syntax somehow to support this + ## sort of thing manually. + my $dep = 'dependent'; + foreach my $gentype (@gvc) { + my $cmdHelper = CommandHelper::get($gentype); + if (defined $cmdHelper) { + ## There has to be at least two files files in order for + ## something to be tied together. + my @files = $self->get_component_list($gentype, 1); + if ($#files >= 1) { + foreach my $file (@files) { + my $part = $self->remove_wanted_extension( + $file, $self->{'valid_components'}->{$gentype}); + my($tied, $vc) = $cmdHelper->get_tied($file, \@files); + foreach my $tie (@$tied) { + my @gen; + if (!defined $vc) { + foreach $vc (@vc) { + @gen = $self->generated_filenames($part, $gentype, + $vc, $file); + last if ($#gen >= 0); + } + } + + ## We have a tied file, now we need to actually perform + ## the tieing of the two. We will do this by saying that + ## the output of the original is necessary for the + ## processing of the tied file. + @gen = $self->generated_filenames($part, $gentype, + $vc, $file) if (!$gen[0]); + + ## We have found a set of files that are generated + ## based on the component type of the original file + ## ($gentype), so we just add the first one and + ## we're done. + my $first = $gen[0]; + $self->{'flag_overrides'}->{$gentype}->{$tie}->{$dep} = + $self->{'generated_exts'}->{$gentype}->{$dep} + if (!defined $self->{'flag_overrides'}->{$gentype}->{$tie}->{$dep}); + + $self->{'flag_overrides'}->{$gentype}->{$tie}->{$dep} .= " $first" + if (!defined $self->{'flag_overrides'}->{$gentype}->{$tie}->{$dep} || + $self->{'flag_overrides'}->{$gentype}->{$tie}->{$dep} !~ /\b$first\b/); + } + } + } + } + } +} + + +sub set_project_name { + my($self, $name) = @_; + + ## Save the unmodified project name so that when we + ## need to determine the default target name, we can use + ## what is expected by the user. + $self->{'unmodified_project_name'} = $name; + + ## If we are applying the name modifier to the project + ## then we will modify the project name + if ($self->get_apply_project()) { + my $nmod = $self->get_name_modifier(); + + if (defined $nmod) { + $nmod =~ s/\*/$name/g; + $name = $nmod; + } + } + + ## Set the project_name assignment so that the TemplateParser + ## can get the project name. + $self->process_assignment('project_name', $name); +} + + +sub project_name { + return $_[0]->get_assignment('project_name'); +} + + +sub lib_target { + my $self = shift; + return (defined $self->get_assignment('sharedname') || + defined $self->get_assignment('staticname')); +} + + +sub exe_target { + return (defined $_[0]->get_assignment('exename')); +} + + +sub get_component_list { + my($self, $tag, $noconvert) = @_; + my $names = $self->{$tag}; + my @list; + + foreach my $name (keys %$names) { + foreach my $key (keys %{$$names{$name}}) { + push(@list, @{$$names{$name}->{$key}}); + } + } + + ## By default, if 'convert_slashes' is true, then we convert slashes + ## to backslashes. There are cases where we do not want to convert + ## the slashes, in that case get_component_list() was called with + ## an additional parameter indicating this. + if (!$noconvert && $self->{'convert_slashes'}) { + foreach my $item (@list) { + $item =~ s/\//\\/g; + } + } + + if ($self->{'sort_files'}) { + @list = sort { $self->file_sorter($a, $b) } @list; + } + + return @list; +} + + +sub check_custom_output { + my($self, $based, $cinput, $ainput, $type, $comps) = @_; + my @outputs; + + foreach my $array ($self->generated_filenames($cinput, $based, + $type, $ainput, 0, 1)) { + foreach my $built (@$array) { + if (@$comps == 0) { + push(@outputs, $built); + last; + } + elsif (defined $specialComponents{$type} && + (!$self->{'special_supplied'}->{$type} || + UNIVERSAL::isa($self->{'special_supplied'}->{$type}, 'ARRAY'))) { + push(@outputs, $built); + last; + } + else { + my $base = $built; + $base =~ s/\\/\//g if ($self->{'convert_slashes'}); + my $re = $self->escape_regex_special($self->mpc_basename($base)); + foreach my $c (@$comps) { + ## We only match if the built file name matches from + ## beginning to end or from a slash to the end. + if ($c =~ /^$re$/ || $c =~ /[\/\\]$re$/) { + push(@outputs, $built); + last; + } + } + } + } + } + + return @outputs; +} + + +sub get_special_value { + my $self = shift; + my $type = shift; + my $cmd = shift; + my $based = shift; + my @params = @_; + + ## These names (held in $type) are variables that contain various + ## commands that will be used in templates within the context of a + ## foreach (e.g., <%custom_type->input_files%> or <%feature->value%>). + if ($type eq 'feature') { + return $self->get_feature_value($cmd, $based); + } + elsif (index($type, 'custom_type') == 0) { + return $self->get_custom_value($cmd, $based, @params); + } + elsif (index($type, $grouped_key) == 0) { + return $self->get_grouped_value($type, $cmd, $based); + } + + return undef; +} + + +sub get_feature_value { + my($self, $cmd, $based) = @_; + + if ($cmd eq 'value') { + my $val = $self->{'feature_parser'}->get_value($based); + if (defined $val && $val != 0) { + return 1; + } + } + + return undef; +} + + +sub get_grouped_value { + my($self, $type, $cmd, $based) = @_; + my $value; + + ## Make it all lower case + $type = lc($type); + + ## Remove the grouped_ part + $type =~ s/^$grouped_key//; + + ## Add the s if it isn't there + $type .= 's' if ($type !~ /s$/); + + my $names = $self->{$type}; + if ($cmd eq 'files') { + foreach my $name (keys %$names) { + my $comps = $$names{$name}; + my @keys = keys %$comps; + if (StringProcessor::fgrep($based, \@keys)) { + if ($self->{'convert_slashes'}) { + my @converted; + foreach my $file (@{$$comps{$based}}) { + push(@converted, $self->slash_to_backslash($file)); + } + $value = \@converted; + } + else { + $value = $$comps{$based}; + } + if ($self->{'sort_files'}) { + my @sorted = sort { $self->file_sorter($a, $b) } @$value; + $value = \@sorted; + } + } + } + } + elsif ($cmd eq 'component_name') { + ## If there is more than one name, then we will need + ## to deal with that at a later time. + foreach my $name (keys %$names) { + $value = $name; + } + } + + return $value; +} + + +sub get_command_subs { + my $self = shift; + my %valid; + + ## Add the built-in OS compatibility commands + if (UNIVERSAL::isa($self, 'WinProjectBase') || + $self->use_win_compatibility_commands()) { + $valid{'cat'} = 'type'; + $valid{'cmp'} = 'fc'; + $valid{'cp'} = 'copy /y'; + $valid{'mkdir'} = 'mkdir'; + $valid{'mv'} = 'move /y'; + $valid{'os'} = 'win32'; + $valid{'rm'} = 'del /f/s/q'; + $valid{'rmdir'} = 'rmdir /s/q'; + $valid{'nul'} = 'nul'; + $valid{'slash'} = '\\'; + $valid{'bat'} = '.bat'; + $valid{'cmd'} = '.cmd'; + $valid{'exe'} = '.exe'; + } + else { + $valid{'cat'} = 'cat'; + $valid{'cmp'} = 'cmp'; + $valid{'cp'} = 'cp -f'; + $valid{'mkdir'} = 'mkdir -p'; + $valid{'mv'} = 'mv -f'; + $valid{'os'} = 'unix'; + $valid{'rm'} = 'rm -rf'; + $valid{'rmdir'} = 'rm -rf'; + $valid{'nul'} = '/dev/null'; + $valid{'slash'} = '/'; + $valid{'bat'} = ''; + $valid{'cmd'} = ''; + $valid{'exe'} = ''; + } + + ## Add the project specific compatibility commands + $valid{'gt'} = $self->get_gt_symbol(); + $valid{'lt'} = $self->get_lt_symbol(); + $valid{'and'} = $self->get_and_symbol(); + $valid{'or'} = $self->get_or_symbol(); + $valid{'quote'} = $self->get_quote_symbol(); + $valid{'equote'} = $self->get_escaped_quote_symbol(); + $valid{'crlf'} = $self->crlf(); + $valid{'cmdsep'} = $self->get_cmdsep_symbol(); + $valid{'temporary'} = 'temp.$$$$.' . int(rand(0xffffffff)); + $valid{'prj_type'} = $self->{'pctype'}; + + return \%valid; +} + + +sub replace_parameters { + my($self, $str, $valid, $nowarn, $input, $output, $always_clear) = @_; + + my %saved; + my $count = 0; + while ($str =~ /<%(\w+)(\(\w+\))?%>/) { + my $name = $1; + my $modifier = $2; + if (defined $modifier) { + my $tmp = $name; + $name = $modifier; + $name =~ s/[\(\)]//g; + $modifier = $tmp; + } + + ## Support both pseudo variables and project settings + if (defined $$valid{$name} || $self->is_keyword($name)) { + ## If the pseudo variable is defined or the project setting has a + ## value, then we'll need to do the replacement. However, if it's + ## a project keyword and it's not defined, we will need to delay + ## the replacement until later (unless $always_clear is true). + my $replace; + my $clear = $always_clear; + if (defined $$valid{$name}) { + $replace = $$valid{$name}; + } + elsif ($self->is_keyword($name)) { + $replace = $self->get_assignment($name); + } + + ## Perform the modification and replacement here + if (defined $replace) { + if (defined $modifier) { + if ($modifier eq 'noextension') { + $replace =~ s/\.[^\.]+$//; + } + else { + $self->warning("Unknown parameter modifier $modifier."); + } + } + $str =~ s/<%\w+(\(\w+\))?%>/$replace/; + } + elsif ($clear) { + ## We need to clear out this variable usage. + $str =~ s/<%\w+(\(\w+\))?%>//; + } + else { + ## Save this variable usage to be put back after we're done + ## processing the string. + my $key = "\1" . $count++ . "\1"; + if ($str =~ s/(<%\w+(\(\w+\))?%>)/$key/) { + $saved{$key} = $1; + } + } + } + else { + $str =~ s/<%\w+(\(\w+\))?%>//; + + ## We only want to warn the user that we did not recognize the + ## pseudo template parameter if there was an input and an output + ## file passed to this function. If this variable was used + ## without the parenthesis (as in an if statement), then we don't + ## want to warn the user. + if (defined $input && defined $output) { + if (!defined $$nowarn{$name}) { + $self->warning("<%$name%> was not recognized."); + } + + ## If we didn't recognize the pseudo template parameter then + ## we don't want to return anything back. + return undef; + } + } + } + + ## Replace the saved variables so that they may be replaced (or + ## removed) later on. + foreach my $key (keys %saved) { + $str =~ s/$key/$saved{$key}/; + } + return $str; +} + + +sub convert_command_parameters { + my($self, $ktype, $str, $input, $output) = @_; + my %nowarn; + my %valid = %{$self->{'command_subs'}}; + + ## Add in the values that change for every call to this function + $valid{'temporary'} = 'temp.$$$$.' . int(rand(0xffffffff)); + + if (defined $input) { + $valid{'input'} = $input; + $valid{'input_basename'} = $self->mpc_basename($input); + $valid{'input_dirname'} = $self->mpc_dirname($input); + $valid{'input_noext'} = $input; + + ## An input file doesn't always have an extension. If there isn't + ## one, then we need to set the 'input_ext' field to an empty string + ## ($1 will not necessarily have a valid value). + if ($valid{'input_noext'} =~ s/(\.[^\.]+)$//) { + $valid{'input_ext'} = $1; + } + else { + $valid{'input_ext'} = ''; + } + + ## Check for the gendir setting associated with this input file. We + ## have to check at so many levels so we don't inadvertantly create + ## intermediate hash tables. + if (defined $self->{'flag_overrides'}->{$ktype} && + defined $self->{'flag_overrides'}->{$ktype}->{$input} && + $self->{'flag_overrides'}->{$ktype}->{$input}->{'gendir'}) { + $valid{'gendir'} = $self->{'flag_overrides'}->{$ktype}->{$input}->{'gendir'}; + } + } + + ## If there is no gendir setting, just set it to the current directory. + $valid{'gendir'} = '.' if (!defined $valid{'gendir'}); + + if (defined $output) { + my $first = 1; + $valid{'output'} = "@$output"; + foreach my $out (@$output) { + ## An output file doesn't always have an extension. If there isn't + ## one, then we need to set the 'output_ext' field to an empty + ## string ($1 will not necessarily have a valid value). + my $noext = $out; + if ($noext =~ s/(\.[^\.]+)$//) { + $valid{'output_ext'} = $1; + } + else { + $valid{'output_ext'} = ''; + } + $valid{'output_noext'} .= (!$first ? ' ' : '') . $noext; + + ## In order to call basename or dirname, we must make sure that the + ## directory separators are forward slashes. + my $file = $out; + $file =~ s/\\/\//g if ($self->{'convert_slashes'}); + $valid{'output_basename'} .= (!$first ? ' ' : '') . + $self->mpc_basename($file); + $valid{'output_dirname'} .= (!$first ? ' ' : '') . + $self->mpc_dirname($file); + $first = 0; + } + } + + ## Add in the specific types of output files + if (defined $output) { + foreach my $type (keys %{$self->{'valid_components'}}) { + my $key = $type; + $key =~ s/s$//gi; + $nowarn{$key} = 1; + $nowarn{$key . '_noext'} = 1; + foreach my $ext (@{$self->{'valid_components'}->{$type}}) { + foreach my $out (@$output) { + if ($out =~ /$ext$/) { + $valid{$key} = $out; + $valid{$key . '_noext'} = $out; + $valid{$key . '_noext'} =~ s/$ext$//; + last; + } + } + } + } + } + + return $self->replace_parameters($str, \%valid, \%nowarn, $input, $output, 1); +} + + +sub get_custom_value { + my $self = shift; + my $cmd = shift; + my $based = shift; + my @params = @_; + my $value; + + if ($cmd eq 'input_files') { + ## Get the component list for the component type + my @array = $self->get_component_list($based); + + ## Check for directories in the component list. If the component + ## type is not automatic, we may have directories here and will need + ## to get the file list for that type. + my $once; + for(my $i = 0; $i < scalar(@array); ++$i) { + if (-d $array[$i]) { + if (!defined $once) { + $once = {'recurse' => $self->get_assignment('recurse'), + 'pchh' => $self->get_assignment('pch_header'), + 'pchc' => $self->get_assignment('pch_source'), + }; + } + my @built; + $self->sift_default_file_list($based, $array[$i], \@built, + $self->{'valid_components'}->{$based}, + $$once{'recurse'}, + $$once{'pchh'}, $$once{'pchc'}); + splice(@array, $i, 1, @built); + $i += $#built; + } + } + + $value = \@array; + + $self->{'custom_output_files'} = {}; + my %vcomps; + foreach my $vc (keys %{$self->{'valid_components'}}) { + my @comps = $self->get_component_list($vc); + $vcomps{$vc} = \@comps; + } + $vcomps{$generic_key} = []; + + foreach my $input (@array) { + my @outputs; + my $ainput = $input; + my $cinput = $input; + + ## Remove the extension + $cinput =~ s/\.[^\.]+$//; + + ## If we are converting slashes, + ## change them back for this parameter + $ainput =~ s/\\/\//g if ($self->{'convert_slashes'}); + + ## Add all of the output files. We can not add $generic_key to the + ## list here (as it used to be). It may have been handled by + ## generated_filenames. + foreach my $vc (keys %{$self->{'valid_components'}}) { + ## The output of multiple components could be input for the + ## current component type ($based). We need to avoid adding + ## duplicates here. + foreach my $file ($self->check_custom_output( + $based, $cinput, $ainput, $vc, $vcomps{$vc})) { + push(@outputs, $file) if (!StringProcessor::fgrep($file, \@outputs)); + } + } + foreach my $file ($self->check_custom_output($based, $cinput, + $ainput, $generic_key, + $vcomps{$generic_key})) { + push(@outputs, $file) if (!StringProcessor::fgrep($file, \@outputs)); + } + + ## Add specially listed files avoiding duplicates. We don't want + ## to add these files if gendir is set to something besides . + if (defined $self->{'custom_special_output'}->{$based} && + defined $self->{'custom_special_output'}->{$based}->{$ainput} && + (!defined $self->{'flag_overrides'}->{$based} || + !defined $self->{'flag_overrides'}->{$based}->{$ainput} || + !defined $self->{'flag_overrides'}->{$based}->{$ainput}->{'gendir'} || + $self->{'flag_overrides'}->{$based}->{$ainput}->{'gendir'} eq '.')) { + foreach my $file (@{$self->{'custom_special_output'}->{$based}->{$ainput}}) { + push(@outputs, $file) if (!StringProcessor::fgrep($file, \@outputs)); + } + } + + if ($self->{'convert_slashes'}) { + foreach my $output (@outputs) { + $output =~ s/\//\\/g; + } + } + if ($self->{'sort_files'}) { + @outputs = sort { $self->file_sorter($a, $b) } @outputs; + } + $self->{'custom_output_files'}->{$input} = \@outputs; + } + } + elsif ($cmd eq 'output_files') { + # Generate output files based on $based + if (defined $self->{'custom_output_files'}) { + $value = $self->{'custom_output_files'}->{$based}; + } + } + elsif ($cmd eq 'source_output_files') { + # Generate source output files based on $based + if (defined $self->{'custom_output_files'}) { + $value = []; + foreach my $file (@{$self->{'custom_output_files'}->{$based}}) { + foreach my $ext (@{$self->{'valid_components'}->{'source_files'}}) { + if ($file =~ /$ext$/) { + ## We've found a file that matches one of the source file + ## extensions. Now we have to make sure that it doesn't + ## match a template file extension. + my $matched = 0; + foreach my $text (@{$self->{'valid_components'}->{'template_files'}}) { + if ($file =~ /$text$/) { + $matched = 1; + last; + } + } + push(@$value, $file) if (!$matched); + last; + } + } + } + } + } + elsif ($cmd eq 'non_source_output_files') { + # Generate non source output files based on $based + if (defined $self->{'custom_output_files'}) { + $value = []; + foreach my $file (@{$self->{'custom_output_files'}->{$based}}) { + my $source = 0; + foreach my $ext (@{$self->{'valid_components'}->{'source_files'}}) { + if ($file =~ /$ext$/) { + $source = 1; + ## We've found a file that matches one of the source file + ## extensions. Now we have to make sure that it doesn't + ## match a template file extension. + foreach my $text (@{$self->{'valid_components'}->{'template_files'}}) { + if ($file =~ /$text$/) { + $source = 0; + last; + } + } + last if ($source); + } + } + push(@$value, $file) if (!$source); + } + } + } + elsif ($cmd eq 'inputexts') { + my @array = @{$self->{'valid_components'}->{$based}}; + foreach my $val (@array) { + $val =~ s/\\\.//g; + } + $value = \@array; + } + elsif ($cmd eq 'dependencies') { + ## If we are converting slashes, change them back for this parameter + $based =~ s/\\/\//g if ($self->{'convert_slashes'}); + $value = $self->{'custom_special_depend'}->{$based}; + } + elsif (defined $customDefined{$cmd}) { + $value = $self->get_assignment($cmd, + $self->{'generated_exts'}->{$based}); + if (defined $value && ($customDefined{$cmd} & 0x14) != 0) { + $value = $self->convert_command_parameters($based, $value, @params); + } + } + + return $value; +} + + +sub check_features { + my($self, $requires, $avoids, $info) = @_; + my $status = 1; + my $why; + + if (defined $requires) { + foreach my $require (split(/\s+/, $requires)) { + my $fval = $self->{'feature_parser'}->get_value($require); + + ## By default, if the feature is not listed, then it is enabled. + if (defined $fval && !$fval) { + $why = "requires $require"; + $status = 0; + last; + } + + ## For automakes sake, if we're to this point the feature is + ## enabled and we will set it in the feature parser explicitly + if (!defined $fval) { + $self->{'feature_parser'}->parse_line(undef, "$require = 1"); + } + } + } + + ## If it passes the requires, then check the avoids + if ($status) { + if (defined $avoids) { + foreach my $avoid (split(/\s+/, $avoids)) { + my $fval = $self->{'feature_parser'}->get_value($avoid); + + ## By default, if the feature is not listed, then it is enabled. + if (!defined $fval || $fval) { + $why = "avoids $avoid"; + $status = 0; + last; + } + } + } + } + + if ($info && !$status) { + $self->details("Skipping " . $self->get_assignment('project_name') . + " ($self->{'current_input'}), it $why."); + } + + return $status; +} + + +sub need_to_write_project { + my $self = shift; + my $count = 0; + + ## We always write a project if the user has provided a verbatim. + ## We have no idea what that verbatim clause does, so we need to just + ## do what the user tells us to do. + return 1 if (defined $self->{'verbatim'}->{$self->{'pctype'}}); + + ## The order here is important, we must check for source or resource + ## files first and then for custom input files. + foreach my $key ('source_files', $self->get_resource_tag(), + keys %{$self->{'generated_exts'}}) { + my $names = $self->{$key}; + foreach my $name (keys %$names) { + foreach my $key (keys %{$names->{$name}}) { + ## See if the project contains a file that corresponds to this + ## component name. + if (defined $names->{$name}->{$key}->[0]) { + if ($count >= 2) { + ## Return 2 if we have found a custom input file (and thus no + ## source or resource files due to the foreach order). + return 2; + } + ## We have either source files or resource files, we need to + ## see if this project creator supports the current language. + ## If it doesn't then we don't need to create the project. + elsif ($self->languageSupported()) { + ## Return 1 if we have found a source file or a resource file. + return 1; + } + } + } + } + $count++; + } + + ## Indicate that there is no need to write the project + return 0; +} + + +sub write_output_file { + my($self, $webapp) = @_; + my $status = 0; + my $error; + my $tover = $self->get_template_override(); + my @templates = $self->get_template(); + + ## The template override will override all templates + @templates = ($tover) if (defined $tover); + + foreach my $template (@templates) { + ## Save the template name for use as a key for various function calls + $self->{'current_template'} = $template; + + ## Create the output file name based on the project name and the + ## template that we're currently using. + my $name = $self->transform_file_name( + $self->project_file_name(undef, + $self->{'current_template'})); + + ## If the template files does not end in the template extension + ## then we will add it on. + if ($template !~ /$TemplateExtension$/) { + $template .= '.' . $TemplateExtension; + } + + ## If the template file does not contain a path, then we + ## will search through the include paths for it. + my $tfile; + if ($template =~ /[\/\\]/i) { + $tfile = $template; + } + else { + $tfile = $self->search_include_path($template); + } + + if (defined $tfile) { + ## Read in the template values for the specific target and project + ## type. The template input file we get may depend upon the + ## current template that we're using. + ($status, $error) = $self->read_template_input( + $self->{'current_template'}); + last if (!$status); + + my $tp = new TemplateParser($self); + + ## Set the project_file assignment for the template parser + $self->process_assignment('project_file', $name); + + ($status, $error) = $tp->parse_file($tfile); + last if (!$status); + + if (defined $self->{'source_callback'}) { + my $cb = $self->{'source_callback'}; + my $pjname = $self->get_assignment('project_name'); + my @list = $self->get_component_list('source_files'); + if (UNIVERSAL::isa($cb, 'ARRAY')) { + my @copy = @$cb; + my $s = shift(@copy); + &$s(@copy, $name, $pjname, \@list); + } + elsif (UNIVERSAL::isa($cb, 'CODE')) { + &$cb($name, $pjname, \@list); + } + else { + $self->warning("Ignoring callback: $cb."); + } + } + + if ($self->get_toplevel()) { + my $outdir = $self->get_outdir(); + my $oname = $name; + + $name = "$outdir/$name"; + + my $fh = new FileHandle(); + my $dir = $self->mpc_dirname($name); + + mkpath($dir, 0, 0777) if ($dir ne '.'); + + if ($webapp) { + ## At this point in time, webapps do not get a project file, + ## but they do appear in the workspace + } + elsif ($self->compare_output()) { + ## First write the output to a temporary file + my $tmp = "$outdir/MPC$>.$$"; + my $different = 1; + if (open($fh, ">$tmp")) { + my $lines = $tp->get_lines(); + foreach my $line (@$lines) { + print $fh $line; + } + close($fh); + + $different = 0 if (!$self->files_are_different($name, $tmp)); + } + else { + $error = "Unable to open $tmp for output."; + $status = 0; + last; + } + + ## If they are different, then rename the temporary file + if ($different) { + unlink($name); + if (rename($tmp, $name)) { + $self->post_file_creation($name); + } + else { + $error = "Unable to open $name for output."; + $status = 0; + last; + } + } + else { + ## We will pretend that we wrote the file + unlink($tmp); + } + } + else { + if (open($fh, ">$name")) { + my $lines = $tp->get_lines(); + foreach my $line (@$lines) { + print $fh $line; + } + close($fh); + $self->post_file_creation($name); + } + else { + $error = "Unable to open $name for output."; + $status = 0; + last; + } + } + + ## There may be more than one template associated with this + ## project creator. If there is, we can only add one generated + ## file and we rely on the project creator to tell us which + ## template generates the file that we need to track. + $self->add_file_written($oname) + if ($self->file_visible($self->{'current_template'})); + } + } + else { + $error = "Unable to locate the template file: $template."; + $status = 0; + last; + } + } + return $status, $error; +} + + +sub write_install_file { + my $self = shift; + my $fh = new FileHandle(); + my $insfile = $self->transform_file_name( + $self->get_assignment('project_name')) . + '.ins'; + my $outdir = $self->get_outdir(); + + $insfile = "$outdir/$insfile"; + + unlink($insfile); + if (open($fh, ">$insfile")) { + foreach my $vc (keys %{$self->{'valid_components'}}) { + my $names = $self->{$vc}; + foreach my $name (keys %$names) { + foreach my $key (keys %{$$names{$name}}) { + my $array = $$names{$name}->{$key}; + if (defined $$array[0]) { + print $fh "$vc:\n"; + foreach my $file (@$array) { + print $fh "$file\n"; + } + print $fh "\n"; + } + } + } + } + if ($self->exe_target()) { + my $exeout = $self->get_assignment('exeout'); + print $fh "exe_output:\n", + (defined $exeout ? $self->relative($exeout) : ''), + ' ', $self->get_assignment('exename'), "\n"; + } + elsif ($self->lib_target()) { + my $shared = $self->get_assignment('sharedname'); + my $static = $self->get_assignment('staticname'); + my $dllout = $self->relative($self->get_assignment('dllout')); + my $libout = $self->relative($self->get_assignment('libout')); + + print $fh "lib_output:\n"; + + if (defined $shared && $shared ne '') { + print $fh (defined $dllout ? $dllout : $libout), " $shared\n"; + } + if ((defined $static && $static ne '') && + (defined $dllout || !defined $shared || + (defined $shared && $shared ne $static))) { + print $fh "$libout $static\n"; + } + } + + close($fh); + return 1, undef; + } + + return 0, 'Unable write to ' . $insfile; +} + + +sub write_project { + my $self = shift; + my $status = 2; + my $error; + my $progress = $self->get_progress_callback(); + + &$progress() if (defined $progress); + + if ($self->check_features($self->get_assignment('requires'), + $self->get_assignment('avoids'), + 1)) { + my $webapp = $self->get_assignment('webapp'); + my $ntwp = $self->need_to_write_project(); + if ($webapp || $ntwp) { + if ($webapp && !$self->webapp_supported()) { + $self->warning("Web Applications are not supported by this type."); + } + else { + ## A return value of 2 from need_to_write_project() indicates + ## that the only reason that we need to write the project is that + ## there are custom input files (i.e., no source or resource + ## files). + $self->process_assignment('custom_only', '1') if ($ntwp == 2); + + if ($self->get_assignment('custom_only')) { + $self->remove_non_custom_settings(); + } + + if ($self->{'escape_spaces'}) { + foreach my $name ('exename', 'sharedname', 'staticname', + 'exeout', 'dllout', 'libout') { + my $value = $self->get_assignment($name); + if (defined $value && $value =~ s/(\s)/\\$1/g) { + $self->process_assignment($name, $value); + } + } + foreach my $key (keys %{$self->{'valid_components'}}) { + my $names = $self->{$key}; + foreach my $name (keys %$names) { + foreach my $key (keys %{$$names{$name}}) { + foreach my $file (@{$$names{$name}->{$key}}) { + $file =~ s/(\s)/\\$1/g; + } + } + } + } + } + + ## We don't need to pass a file name here. write_output_file() + ## will determine the file name for itself. + ($status, $error) = $self->write_output_file($webapp); + + ## Write the .ins file if the user requested it and we were + ## successful. + if ($self->{'generate_ins'} && $status) { + ($status, $error) = $self->write_install_file(); + } + } + } + elsif ($self->warn_useless_project()) { + my $msg = $self->transform_file_name($self->project_file_name()) . + " has no useful targets."; + + if ($self->{'current_input'} eq '') { + $self->information($msg); + } + else { + $self->warning($msg); + } + } + } + + return $status, $error; +} + + +sub get_project_info { + return $_[0]->{'project_info'}; +} + + +sub get_lib_locations { + return $_[0]->{'lib_locations'}; +} + + +sub get_inheritance_tree { + return $_[0]->{'inheritance_tree'}; +} + + +sub set_component_extensions { + my $self = shift; + my $vc = $self->{'valid_components'}; + my $ec = $self->{'exclude_components'}; + + foreach my $key (keys %$vc) { + my $ov = $self->override_valid_component_extensions($key, + @{$$vc{$key}}); + $$vc{$key} = $ov if (defined $ov); + } + + foreach my $key (keys %$ec) { + my $ov = $self->override_exclude_component_extensions($key, + @{$$ec{$key}}); + $$ec{$key} = $ov if (defined $ov); + } +} + + +sub get_component_extensions { + my($self, $comp) = @_; + my @ext; + if (defined $self->{'valid_components'}->{$comp}) { + ## Build up an array of extensions. Since they are stored as regular + ## expressions, we need to remove the escaped period to provide the + ## minimal amount of text for each extension to provide maximum + ## flexibility within the project template. + foreach my $re (@{$self->{'valid_components'}->{$comp}}) { + push(@ext, $re); + $ext[$#ext] =~ s/\\\.//; + } + } + return @ext; +} + + +sub set_source_listing_callback { + my($self, $cb) = @_; + $self->{'source_callback'} = $cb; +} + + +sub reset_values { + my $self = shift; + + ## Only put data structures that need to be cleared + ## out when the mpc file is done being read, not at the + ## end of each project within the mpc file. Those go in + ## the closing curly brace section of parse_line(). + $self->{'project_info'} = []; + $self->{'lib_locations'} = {}; + $self->reset_generating_types(); +} + + +sub add_default_matching_assignments { + my $self = shift; + my $lang = $self->get_language(); + + foreach my $key (keys %{$language{$lang}->[0]}) { + push(@{$language{$lang}->[2]->{$key}}, @default_matching_assignments) + if (!StringProcessor::fgrep($default_matching_assignments[0], + $language{$lang}->[2]->{$key})); + } +} + + +sub reset_generating_types { + my $self = shift; + my $lang = $self->get_language(); + my %reset = ('valid_components' => $language{$lang}->[0], + 'custom_only_removed' => $language{$lang}->[0], + 'exclude_components' => $language{$lang}->[1], + 'matching_assignments' => $language{$lang}->[2], + 'generated_exts' => {}, + 'valid_names' => \%validNames, + ); + + foreach my $r (keys %reset) { + $self->{$r} = {}; + foreach my $key (keys %{$reset{$r}}) { + $self->{$r}->{$key} = $reset{$r}->{$key}; + } + } + + $self->{'custom_types'} = {}; + + ## Allow subclasses to override the default extensions + $self->set_component_extensions(); +} + + +sub get_template_input { + my $self = shift; + my $lang = $self->get_language(); + + ## This follows along the same logic as read_template_input() by + ## checking for exe target and then defaulting to a lib target + if ($self->exe_target()) { + if ($self->get_static() == 1) { + return $self->{'lib_exe_template_input'}->{$lang}->{$tikey}; + } + else { + return $self->{'dll_exe_template_input'}->{$lang}->{$tikey}; + } + } + + if ($self->get_static() == 1) { + return $self->{'lib_template_input'}->{$lang}->{$tikey}; + } + + return $self->{'dll_template_input'}->{$lang}->{$tikey}; +} + + +sub update_project_info { + my($self, $tparser, $append, $names, $sep) = @_; + my $value = ''; + $sep = '' if (!defined $sep); + + ## Append the values of all names into one string + my $ncount = scalar(@$names) - 1; + for(my $i = 0; $i <= $ncount; $i++) { + $value .= $self->translate_value( + $$names[$i], + $tparser->get_value_with_default($$names[$i])); + $value .= $sep if ($i != $ncount); + } + + ## There may be more than one template associated with this project + ## creator. If there is, we can only add one generated file and we + ## rely on the project creator to tell us which template generates the + ## file that we need to track. + if ($self->file_visible($self->{'current_template'})) { + ## If we already have an array, take the one off the top. Otherwise, + ## create a new one which will be added below. + my $arr = ($append && defined $self->{'project_info'}->[0] ? + pop(@{$self->{'project_info'}}) : []); + + ## Set up the hash table when we are starting a new project_info + $self->{'project_info_hash_table'} = {} if (!$append); + + ## If we haven't seen this value yet, put it on the array + if (!defined $self->{'project_info_hash_table'}->{"@$names $value"}) { + $self->{'project_info_hash_table'}->{"@$names $value"} = 1; + push(@$arr, $value); + } + + ## Always push the array back onto the project_info + push(@{$self->{'project_info'}}, $arr); + } + + return $value; +} + + +sub adjust_value { + my($self, $names, $value, $tp) = @_; + my $atemp = $self->get_addtemp(); + + ## Perform any additions, subtractions + ## or overrides for the template values. + foreach my $name (@$names) { + if (defined $name && defined $atemp->{lc($name)}) { + my $lname = lc($name); + my $base = $lname; + $base =~ s/.*:://; + + ## If the template variable is a complex name, then we need to make + ## sure that the mapped value belongs to the correct type based on + ## the base of the complex name. The $tp (TemplateParser) variable + ## will, in the majority of all calls to this method, be defined so + ## it is checked second to avoid checking it if the name isn't + ## complex. + if ($base =~ /(.+)\->/ && defined $tp) { + my $v = $tp->get_value($1); + if (defined $v) { + my $found = undef; + foreach my $val (@{$atemp->{$lname}}) { + if (defined $$val[3]) { + my $mapped = $self->{'valid_names'}->{$$val[3]}; + if (defined $mapped && UNIVERSAL::isa($mapped, 'ARRAY')) { + $found = 1 if ($v ne $$mapped[0]); + } + last; + } + } + next if ($found); + } + } + + my $replace = (defined $self->{'valid_names'}->{$base} && + ($self->{'valid_names'}->{$base} & 0x04) == 0); + foreach my $val (@{$atemp->{$lname}}) { + if ($replace && index($$val[1], '<%') >= 0) { + $$val[1] = $self->replace_parameters($$val[1], + $self->{'command_subs'}); + } + my $arr = $self->create_array($$val[1]); + if ($$val[0] > 0) { + if (!defined $value) { + $value = ''; + } + if (UNIVERSAL::isa($value, 'ARRAY')) { + ## Avoid adding duplicates. If the existing array contains + ## the value already, remove it from the newly created array. + for(my $i = 0; $i < scalar(@$value); $i++) { + if (StringProcessor::fgrep($$value[$i], $arr)) { + splice(@$value, $i, 1); + $i--; + } + } + + ## We need to make $value a new array reference ($arr) + ## to avoid modifying the array reference pointed to by $value + unshift(@$arr, @$value); + $value = $arr; + } + else { + $value .= " $$val[1]"; + } + } + elsif ($$val[0] < 0) { + if (defined $value) { + my $parts; + if (UNIVERSAL::isa($value, 'ARRAY')) { + $parts = $value; + } + else { + $parts = $self->create_array($value); + } + + $value = []; + foreach my $part (@$parts) { + if ($part ne '') { + push(@$value, $part) if (!StringProcessor::fgrep($part, $arr)); + } + } + } + } + else { + ## If the user set the variable to empty, then we need to + ## set the value to undef + $value = (defined $$arr[0] ? $arr : undef); + } + } + last; + } + } + + return $value; +} + + +sub get_verbatim { + my($self, $marker) = @_; + my $str; + my $thash = $self->{'verbatim'}->{$self->{'pctype'}}; + + if (defined $thash) { + if (defined $thash->{$marker}) { + my $crlf = $self->crlf(); + foreach my $line (@{$thash->{$marker}}) { + $str = '' if (!defined $str); + $str .= $self->process_special($line) . $crlf; + } + if (defined $str) { + $str .= $crlf; + $self->{'verbatim_accessed'}->{$self->{'pctype'}}->{$marker} = 1; + } + } + } + + return $str; +} + + +sub generate_recursive_input_list { + my($self, $dir, $exclude) = @_; + return $self->extension_recursive_input_list($dir, + $exclude, + $ProjectCreatorExtension); +} + + +sub get_modified_project_file_name { + my($self, $name, $ext) = @_; + my $nmod = $self->get_name_modifier(); + + ## We don't apply the name modifier to the project file + ## name if we have already applied it to the project name + ## since the project file name comes from the project name. + if (defined $nmod && !$self->get_apply_project()) { + $nmod =~ s/\*/$name/g; + $name = $nmod; + } + return "$name$ext"; +} + + +sub get_valid_names { + return $_[0]->{'valid_names'}; +} + + +sub get_feature_parser { + return $_[0]->{'feature_parser'}; +} + + +sub preserve_assignment_order { + my($self, $name) = @_; + my $mapped = $self->{'valid_names'}->{$name}; + + ## Only return the value stored in the valid_names hash map if it's + ## defined and it's not an array reference. The array reference is + ## a keyword mapping and all mapped keywords should have preserved + ## assignment order. + if (defined $mapped && !UNIVERSAL::isa($mapped, 'ARRAY')) { + return ($mapped & 1); + } + + return 1; +} + + +sub add_to_template_input_value { + my($self, $name) = @_; + my $mapped = $self->{'valid_names'}->{$name}; + + ## Only return the value stored in the valid_names hash map if it's + ## defined and it's not an array reference. The array reference is + ## a keyword mapping and no mapped keywords should be added to + ## template input variables. + if (defined $mapped && !UNIVERSAL::isa($mapped, 'ARRAY')) { + return ($mapped & 2); + } + + return 0; +} + + +sub dependency_combined_static_library { + #my $self = shift; + return defined $ENV{MPC_DEPENDENCY_COMBINED_STATIC_LIBRARY}; +} + + +sub translate_value { + my($self, $key, $val) = @_; + + if ($key eq 'after' && $val ne '') { + my $arr = $self->create_array($val); + $val = ''; + + if ($self->require_dependencies()) { + foreach my $entry (@$arr) { + if ($self->get_apply_project()) { + my $nmod = $self->get_name_modifier(); + if (defined $nmod) { + $nmod =~ s/\*/$entry/g; + $entry = $nmod; + } + } + $val .= '"' . ($self->dependency_is_filename() ? + $self->project_file_name($entry) : $entry) . '" '; + } + $val =~ s/\s+$//; + } + } + return $val; +} + + +sub requires_parameters { + #my $self = shift; + #my $name = shift; + return $custom{$_[1]}; +} + + +sub project_file_name { + my($self, $name, $template) = @_; + + ## Fill in the name if one wasn't provided + $name = $self->get_assignment('project_name') if (!defined $name); + + return $self->get_modified_project_file_name( + $self->project_file_prefix() . $name, + $self->project_file_extension()); +} + + +sub remove_non_custom_settings { + my $self = shift; + + ## Remove any files that may have automatically been added + ## to this project + foreach my $key (keys %{$self->{'custom_only_removed'}}) { + $self->{$key} = {}; + } + + ## Unset the exename, sharedname and staticname + $self->process_assignment('exename', undef); + $self->process_assignment('sharedname', undef); + $self->process_assignment('staticname', undef); +} + + +sub remove_wanted_extension { + my($self, $name, $array) = @_; + + foreach my $wanted (@$array) { + return $name if ($name =~ s/$wanted$//); + } + + ## If the user provided file does not match any of the + ## extensions specified by the custom definition, we need + ## to remove the extension or else this file will not be + ## added to the project. + $name =~ s/\.[^\.]+$//; + return $name; +} + + +sub resolve_alias { + if (index($_[1], 'install') >= 0) { + my $resolved = $_[1]; + if ($resolved =~ s/(.*::)install$/$1exeout/) { + } + elsif ($resolved eq 'install') { + $resolved = 'exeout'; + } + return $resolved; + } + return $_[1]; +} + + +sub create_feature_parser { + my($self, $features, $feature) = @_; + my $gfeature = $self->{'gfeature_file'}; + my $typefeaturef = (defined $gfeature ? + $self->mpc_dirname($gfeature) . '/' : '') . + $self->{'pctype'} . '.features'; + $typefeaturef = undef if (! -r $typefeaturef); + if (defined $feature && $feature !~ /[\/\\]/i) { + my $searched = $self->search_include_path($feature); + $feature = $searched if (defined $searched); + } + my $fp = new FeatureParser($features, + $gfeature, + $typefeaturef, + $feature); + + my $slo = $fp->get_value($static_libs_feature); + if (!defined $slo) { + my $sval = $self->get_static() || 0; + $fp->parse_line(undef, + $static_libs_feature . ' = ' . $sval); + } + + return $fp; +} + + +sub restore_state_helper { + my($self, $skey, $old, $new) = @_; + + if ($skey eq 'feature_file') { + if ($self->{'features_changed'} || + !(!defined $old && !defined $new || + (defined $old && defined $new && $old eq $new))) { + ## Create a new feature parser. This relies on the fact that + ## 'features' is restored first in restore_state(). + $self->{'feature_parser'} = $self->create_feature_parser( + $self->get_features(), $new); + $self->{'features_changed'} = undef; + } + } + elsif ($skey eq 'ti') { + my $lang = $self->get_language(); + my @keys = keys %$old; + @keys = keys %$new if (!defined $keys[0]); + foreach my $key (@keys) { + if (!defined $$old{$key} || !defined $$new{$key} || + $$old{$key} ne $$new{$key}) { + ## Clear out the template input reader that we're currently set + ## to use. + $self->{$key . '_template_input'}->{$lang}->{$tikey} = undef; + } + } + } + elsif ($skey eq 'features') { + ## If the user has changed the 'features' setting, then we need to + ## make sure that we create a new feature parser regardless of + ## whether or not the feature file has changed. + $self->{'features_changed'} = ("@$old" ne "@$new"); + } + elsif ($skey eq 'language') { + if ($old ne $new) { + $self->add_default_matching_assignments(); + } + } +} + + +sub get_initial_relative_values { + return $_[0]->{'expanded'}, 1; +} + +sub add_main_function { + my $langmain = shift; + + ## See if a language was supplied. + if ($langmain =~ /([^:]+):(.+)/) { + ## If the language supplied is not one that we know about, return an + ## error message. + return 'Invalid language: ' . $1 if (!defined $language{$1}); + + ## Otherwise, add it to the list for the language. + push(@{$mains{$1}}, $2); + } + else { + ## No language was supplied, so add the main to all of the languages + ## that we support. + foreach my $lang (keys %language) { + push(@{$mains{$lang}}, $langmain); + } + } + + ## Return no error message. + return undef; +} + +sub get_resource_tag { + my $self = shift; + my $lang = $self->get_language(); + + ## Not all entries in the %language map have a resource tag. + ## For this, we will just return the tag for C++ since it probably + ## doesn't really matter anyway. + return defined $language{$lang}->[5] ? $language{$lang}->[5] : $cppresource; +} + +# ************************************************************ +# Accessors used by support scripts +# ************************************************************ + +sub getKeywords { + return \%validNames; +} + +sub getValidComponents { + my $language = shift; + return (defined $language{$language} ? $language{$language}->[0] : undef); +} + +# ************************************************************ +# Virtual Methods To Be Overridden +# ************************************************************ + +sub languageSupported { + #my $self = shift; + return $_[0]->get_language() eq Creator::cplusplus; +} + +sub file_visible { + #my($self, $template) = @_; + return 1; +} + +sub webapp_supported { + #my $self = shift; + return 0; +} + + +sub use_win_compatibility_commands { + #my $self = shift; + return $ENV{MPC_USE_WIN_COMMANDS}; +} + + +sub post_file_creation { + #my $self = shift; + #my $file = shift; +} + + +sub escape_spaces { + #my $self = shift; + return 0; +} + + +sub validated_directory { + my($self, $dir) = @_; + return $dir; +} + +sub get_quote_symbol { + #my $self = shift; + return '"'; +} + +sub get_escaped_quote_symbol { + #my $self = shift; + return '\\\"'; +} + +sub get_gt_symbol { + #my $self = shift; + return '>'; +} + + +sub get_lt_symbol { + #my $self = shift; + return '<'; +} + + +sub get_and_symbol { + #my $self = shift; + return '&&'; +} + + +sub get_or_symbol { + #my $self = shift; + return '||'; +} + + +sub get_cmdsep_symbol { + #my $self = shift; + return ';'; +} + + +sub dollar_special { + #my $self = shift; + return 0; +} + + +sub expand_variables_from_template_values { + #my $self = shift; + return 1; +} + + +sub require_dependencies { + #my $self = shift; + return 1; +} + + +sub dependency_is_filename { + #my $self = shift; + return 1; +} + + +sub fill_value { + #my $self = shift; + #my $name = shift; + return undef; +} + + +sub project_file_prefix { + #my $self = shift; + return ''; +} + + +sub project_file_extension { + #my $self = shift; + return ''; +} + + +sub override_valid_component_extensions { + #my $self = shift; + #my $comp = shift; + return undef; +} + + +sub override_exclude_component_extensions { + #my $self = shift; + #my $comp = shift; + return undef; +} + + +sub get_dll_exe_template_input_file { + #my($self, $tkey) = @_; + return undef; +} + + +sub get_lib_exe_template_input_file { + my($self, $tkey) = @_; + return $self->get_dll_exe_template_input_file($tkey); +} + + +sub get_lib_template_input_file { + my($self, $tkey) = @_; + return $self->get_dll_template_input_file($tkey); +} + + +sub get_dll_template_input_file { + #my($self, $tkey) = @_; + return undef; +} + + +sub get_template { + return $_[0]->{'pctype'}; +} + +sub requires_forward_slashes { + return 0; +} + +sub warn_useless_project { + return 1; +} + +sub get_properties { + my $self = shift; + return {'static' => $self->get_static(), + $self->get_language() => 1}; +} + +1; diff --git a/ACE/MPC/modules/SLEProjectCreator.pm b/ACE/MPC/modules/SLEProjectCreator.pm new file mode 100644 index 00000000000..2a1508beb29 --- /dev/null +++ b/ACE/MPC/modules/SLEProjectCreator.pm @@ -0,0 +1,43 @@ +package SLEProjectCreator; + +# ************************************************************ +# Description : The SLE Project Creator +# Author : Johnny Willemsen +# Create Date : 3/23/2003 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use ProjectCreator; +use XMLProjectBase; + +use vars qw(@ISA); +@ISA = qw(XMLProjectBase ProjectCreator); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub project_file_extension { + #my $self = shift; + return '.vpj'; +} + + +sub get_dll_exe_template_input_file { + #my $self = shift; + return 'sleexe'; +} + + +sub get_dll_template_input_file { + #my $self = shift; + return 'sledll'; +} + + +1; diff --git a/ACE/MPC/modules/SLEWorkspaceCreator.pm b/ACE/MPC/modules/SLEWorkspaceCreator.pm new file mode 100644 index 00000000000..52ee2691a0b --- /dev/null +++ b/ACE/MPC/modules/SLEWorkspaceCreator.pm @@ -0,0 +1,65 @@ +package SLEWorkspaceCreator; + +# ************************************************************ +# Description : The SLE Workspace Creator +# Author : Johnny Willemsen +# Create Date : 3/23/2004 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use SLEProjectCreator; +use WorkspaceCreator; + +use vars qw(@ISA); +@ISA = qw(WorkspaceCreator); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + + +sub compare_output { + #my $self = shift; + return 1; +} + + +sub workspace_file_extension { + #my $self = shift; + return '.vpw'; +} + + +sub pre_workspace { + my($self, $fh) = @_; + my $crlf = $self->crlf(); + + print $fh "<!DOCTYPE Workspace SYSTEM \"http://www.slickedit.com/dtd/vse/8.1/vpw.dtd\">$crlf" . + "<Workspace Version=\"8.1\" VendorName=\"SlickEdit\">$crlf"; +} + + +sub write_comps { + my($self, $fh) = @_; + my $crlf = $self->crlf(); + + print $fh "\t<Projects>$crlf"; + foreach my $project ($self->sort_dependencies($self->get_projects(), 0)) { + print $fh "\t\t<Project File=\"$project\"/>$crlf"; + } + print $fh "\t</Projects>$crlf"; +} + + +sub post_workspace { + my($self, $fh) = @_; + print $fh '</Workspace>' . $self->crlf(); +} + + +1; diff --git a/ACE/MPC/modules/StringProcessor.pm b/ACE/MPC/modules/StringProcessor.pm new file mode 100644 index 00000000000..fc08e97fd2b --- /dev/null +++ b/ACE/MPC/modules/StringProcessor.pm @@ -0,0 +1,133 @@ +package StringProcessor; + +# ************************************************************ +# Description : Perform various algorithms on strings +# Author : Chad Elliott +# Create Date : 3/07/2003 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub parse_assignment { + my($self, $line, $values) = @_; + + ## In MPC, a scope can have spaces in it. However, it can not end + ## in a space. + if ($line =~ /^((\w+[\s\w]+\w::)*\w+)\s*([\-+]?=)\s*(.*)?/) { + my $op = ($3 eq '+=' ? 1 : $3 eq '-=' ? -1 : 0); + push(@$values, $op, $self->resolve_alias(lc($1)), $4); + return 1; + } + + return 0; +} + + +sub extractType { + my($self, $name) = @_; + my $type = $name; + + if ($name =~ /(.*)(Project|Workspace)Creator/) { + $type = $1; + } + + return lc($type); +} + + +sub process_special { + my($self, $line) = @_; + + ## Replace all escaped double quotes and escaped backslashes + ## with special characters + my $escaped = ($line =~ s/\\\\/\01/g); + $escaped |= ($line =~ s/\\"/\02/g); + + ## Un-escape all other characters + $line =~ s/\\(.)/$1/g; + + ## Remove any non-escaped double quotes + $line =~ s/"//g; + + ## Put the escaped double quotes and backslashes back in + if ($escaped) { + $line =~ s/\02/"/g; + $line =~ s/\01/\\/g; + } + + return $line; +} + + +sub create_array { + my($self, $line) = @_; + my @array; + + ## Replace all escaped double and single quotes with special characters + my $escaped = ($line =~ s/\\\"/\01/g); + $escaped |= ($line =~ s/\\\'/\02/g); + $escaped |= ($line =~ s/\\ /\03/g); + $escaped |= ($line =~ s/\\\t/\04/g); + + foreach my $part (grep(!/^\s*$/, + split(/(\"[^\"]+\"|\'[^\']+\'|\s+)/, $line))) { + ## Remove enclosing double and single quotes + $part =~ s/^"(.*)"$/$1/; + $part =~ s/^'(.*)'$/$1/; + + ## Put any escaped double or single quotes back into the string. + if ($escaped) { + $part =~ s/\01/\"/g; + $part =~ s/\02/\'/g; + $part =~ s/\03/ /g; + $part =~ s/\04/\t/g; + } + + ## Push it onto the array + push(@array, $part); + } + + return \@array; +} + + +sub crlf { + #my $self = shift; + return "\n"; +} + + +sub windows_crlf { + ## Windows, OS/2 and cygwin require a carriage return and line feed. + ## However, at some point cygwin changed the way it does output and can + ## be controled through an environment variable. + return ($^O eq 'MSWin32' || $^O eq 'os2' || + ($^O eq 'cygwin' && + ($] < 5.008 || (defined $ENV{PERLIO} && $ENV{PERLIO} eq 'crlf'))) ? + "\n" : "\r\n"); +} + + +sub resolve_alias { + #my $self = shift; + #my $name = shift; + return $_[1]; +} + +sub fgrep { + my($str, $array) = @_; + foreach my $target (@$array) { + return 1 if ($str eq $target); + } + return undef; +} + +1; diff --git a/ACE/MPC/modules/TemplateInputReader.pm b/ACE/MPC/modules/TemplateInputReader.pm new file mode 100644 index 00000000000..c1fc7c455d4 --- /dev/null +++ b/ACE/MPC/modules/TemplateInputReader.pm @@ -0,0 +1,140 @@ +package TemplateInputReader; + +# ************************************************************ +# Description : Reads the template input and stores the values +# Author : Chad Elliott +# Create Date : 5/16/2002 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use Parser; + +use vars qw(@ISA); +@ISA = qw(Parser); + +# ************************************************************ +# Data Section +# ************************************************************ + +my $mpt = 'mpt'; + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub new { + my($class, $inc) = @_; + my $self = Parser::new($class, $inc); + + ## Set up the internal data members + $self->{'values'} = {}; + $self->{'cindex'} = 0; + $self->{'current'} = [ $self->{'values'} ]; + $self->{'realnames'} = {}; + + return $self; +} + + +sub parse_line { + my($self, $ih, $line) = @_; + my $status = 1; + my $errorString; + my $current = $self->{'current'}; + + if ($line eq '') { + } + elsif ($line =~ /^([\w\s\(\)\.]+)\s*{$/) { + ## Entering a new scope, we need to save the real name so that it can + ## be accessed at a later time. + my $rname = $1; + $rname =~ s/\s+$//; + my $name = lc($rname); + $self->{'realnames'}->{$name} = $rname; + + ## Scopes are reentrant, so we only create a new map when we haven't + ## got one. + if (!defined $$current[$self->{'cindex'}]->{$name}) { + $$current[$self->{'cindex'}]->{$name} = {}; + } + + ## Keep track of the current scope + push(@$current, $$current[$self->{'cindex'}]->{$name}); + $self->{'cindex'}++; + } + elsif ($line =~ /^}$/) { + ## Maintain the scope and make sure there aren't any unmatched + ## braces. + if ($self->{'cindex'} > 0) { + pop(@$current); + $self->{'cindex'}--; + } + else { + $status = 0; + $errorString = 'Unmatched curly brace'; + } + } + elsif ($line =~ /^(\w+)\s*(\+=|=)\s*(.*)?/) { + ## Save the name, operation type and value. + my $name = lc($1); + my $op = $2; + my $value = $3; + + ## Turn the value into an array + if (defined $value) { + $value = $self->create_array($value); + } + else { + $value = []; + } + + ## Store the value + if ($op eq '+=' && defined $$current[$self->{'cindex'}]->{$name}) { + push(@{$$current[$self->{'cindex'}]->{$name}}, @$value); + } + else { + $$current[$self->{'cindex'}]->{$name} = $value; + } + } + elsif ($line =~ /^conditional_include\s+"([\w\s\-\+\/\\\.]+)"$/) { + ## Search for the include template file. If it does not exist, we + ## don't complain. It's likely that these sort of files won't exist. + my $file = $self->search_include_path("$1.$mpt"); + if (defined $file) { + ## Process the file making sure to restore the line number seting + ## when we get done. + my $ol = $self->get_line_number(); + ($status, $errorString) = $self->read_file($file); + $self->set_line_number($ol); + } + } + else { + $status = 0; + $errorString = "Unrecognized line: $line"; + } + + return $status, $errorString; +} + + +sub get_value { + ## All template names are case-insensitive. + my($self, $tag) = @_; + return $self->{'values'}->{lc($tag)}; +} + + +sub get_realname { + ## Sometimes, we need to get back to the name retaining the case so we + ## access the hash map containing them. + my($self, $tag) = @_; + return $self->{'realnames'}->{lc($tag)}; +} + + +1; diff --git a/ACE/MPC/modules/TemplateParser.pm b/ACE/MPC/modules/TemplateParser.pm new file mode 100644 index 00000000000..22dd49d5c69 --- /dev/null +++ b/ACE/MPC/modules/TemplateParser.pm @@ -0,0 +1,2050 @@ +package TemplateParser; + +# ************************************************************ +# Description : Parses the template and fills in missing values +# Author : Chad Elliott +# Create Date : 5/17/2002 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +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 +# +# Perl Function Parameter Type Return Type +# get_ string string or array +# perform_ array reference array +# doif_ array reference boolean +# +my %keywords = ('if' => 0, + 'else' => 0, + 'endif' => 0, + 'noextension' => 3, + 'dirname' => 7, + 'basename' => 0, + 'basenoextension' => 0, + 'foreach' => 0, + 'forfirst' => 0, + 'fornotfirst' => 0, + 'fornotlast' => 0, + 'forlast' => 0, + 'endfor' => 0, + 'eval' => 0, + 'comment' => 0, + 'marker' => 0, + 'uc' => 3, + 'lc' => 3, + 'ucw' => 0, + 'normalize' => 3, + 'flag_overrides' => 1, + 'reverse' => 3, + 'sort' => 3, + 'uniq' => 3, + 'multiple' => 5, + 'starts_with' => 5, + 'ends_with' => 5, + 'contains' => 5, + 'remove_from' => 0xf, + 'compares' => 5, + 'duplicate_index' => 5, + 'transdir' => 5, + 'has_extension' => 5, + 'keyname_used' => 0, + 'scope' => 0, + 'full_path' => 3, + 'extensions' => 0xa, + ); + +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', + ); + +# ************************************************************ +# 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->{'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."); + } + } + } + + + if ($_[0]->{'foreach'}->{'count'} >= 0) { + $_[0]->{'foreach'}->{'text'}->[$_[0]->{'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+\([^\)]+\))\s*,\s*(.*)/) { + push(@params, $1); + $str = $2; + } + while($str =~ /^([^,]+)\s*,\s*(.*)/) { + push(@params, $1); + $str = $2; + } + + ## Return the parameters (which includes whatever is left in the + ## string). Just return it instead of pushing it onto @params. + return @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 $scope; + my $sname; + 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) { + ## Find the outer most scope for our variable name + for(my $index = $counter; $index >= 0; --$index) { + if (defined $self->{'foreach'}->{'scope_name'}->[$index]) { + $scope = $self->{'foreach'}->{'scope_name'}->[$index]; + $sname = $scope . '::' . $name; + last; + } + } + 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}; + } + } + + 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([$sname, $name], + [], $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([$sname, $name], $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 $self->{'prjc'}->relative($value, undef, $scope); +} + + +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 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} & 0x02) != 0) { + push(@cmds, 'perform_' . $cmd); + if (($keywords{$cmd} & 0x08) != 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'}; + 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) { + return ($self->get_value_with_default($name) =~ /$pattern/); + } + } + return undef; +} + + +sub handle_contains { + my($self, $str) = @_; + $self->generic_handle('doif_contains', $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_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 = 0x01; + my $prefix = 'get_'; + + $val = $str; + 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 = 0x04; + $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 = Cwd::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 and convert the slashes if necessary. + $value = $dir . '/' . $self->mpc_basename($value); + $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, $name, $val) = @_; + + ## Get the value based on the string + my @cmds = ($name); + while ($val =~ /(\w+)\((.+)\)/) { + push(@cmds, $1); + $val = $2; + } + + ## Start out calling get_xxx on the string + my $type = 0x01; + my $prefix = 'get_'; + + foreach my $cmd (reverse @cmds) { + if (defined $keywords{$cmd} && ($keywords{$cmd} & $type) != 0) { + my $func = "$prefix$cmd"; + if ($type == 0x01) { + $val = $self->$func($val); + $val = [ $val ] if (!UNIVERSAL::isa($val, 'ARRAY')); + } + else { + my @array = $self->$func($val); + $val = \@array; + } + + ## Now that we have a value, we need to switch over + ## to calling perform_xxx + $type = 0x02; + $prefix = 'perform_'; + } + else { + $self->warning("Unable to use $cmd in nested " . + "functions (no $prefix method)."); + } + } + if (defined $val && UNIVERSAL::isa($val, 'ARRAY')) { + $self->append_current("@$val"); + } +} + + +sub perform_dirname { + my($self, $value) = @_; + my @val; + foreach my $val (@$value) { + push(@val, $self->validated_dirname($val)); + } + return @val; +} + + +sub get_dirname { + my($self, $name) = @_; + return $self->doif_dirname($self->get_value_with_default($name)); +} + + +sub doif_dirname { + my($self, $value) = @_; + + if (defined $value) { + $value = $self->validated_dirname($value); + return ($value ne '.'); + } + return undef; +} + + +sub handle_dirname { + my($self, $name) = @_; + + $self->append_current( + $self->validated_dirname($self->get_value_with_default($name))); +} + + +sub handle_basename { + my($self, $name) = @_; + + $self->append_current( + $self->tp_basename($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 get_transdir { + my($self, $name) = @_; + return $self->doif_transdir($self->get_value_with_default($name)); +} + + +sub doif_transdir { + my($self, $value) = @_; + + if ($value =~ /([\/\\])/) { + return $self->{'prjc'}->translate_directory( + $self->tp_dirname($value)) . $1; + } + + return undef; +} + + +sub handle_transdir { + my($self, $name) = @_; + my $value = $self->doif_transdir($self->get_value_with_default($name)); + $self->append_current($value) if (defined $value); +} + + +sub prepare_parameters { + my($self, $prefix) = @_; + my $input = $self->get_value($prefix . '->input_file'); + my $output; + + if (defined $input) { + $input =~ s/\//\\/g if ($self->{'cslashes'}); + $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) { + $$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 =~ /([^%\(]+)(\(([^%]+)\))?%>/) { + 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']); + + ## 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 !~ /^[ ]*<%(\w+)(?:\((?:(?:\w+\s*,\s*)*[!]?\w+\(.+\)|[^\)]+)\))?%>$/ || + !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; diff --git a/ACE/MPC/modules/VC10ProjectCreator.pm b/ACE/MPC/modules/VC10ProjectCreator.pm new file mode 100644 index 00000000000..caf93286e5f --- /dev/null +++ b/ACE/MPC/modules/VC10ProjectCreator.pm @@ -0,0 +1,20 @@ +package VC10ProjectCreator; + +# ************************************************************ +# Description : A VC10 Project Creator +# Author : Johnny Willemsen +# Create Date : 11/10/2008 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use VC9ProjectCreator; + +use vars qw(@ISA); +@ISA = qw(VC9ProjectCreator); + +1; diff --git a/ACE/MPC/modules/VC10WorkspaceCreator.pm b/ACE/MPC/modules/VC10WorkspaceCreator.pm new file mode 100644 index 00000000000..89c50c5a0d5 --- /dev/null +++ b/ACE/MPC/modules/VC10WorkspaceCreator.pm @@ -0,0 +1,42 @@ +package VC10WorkspaceCreator; + +# ************************************************************ +# Description : A VC10 Workspace Creator +# Author : Johnny Willemsen +# Create Date : 11/10/2008 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use VC10ProjectCreator; +use VC9WorkspaceCreator; + +use vars qw(@ISA); +@ISA = qw(VC9WorkspaceCreator); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub pre_workspace { + my($self, $fh) = @_; + my $crlf = $self->crlf(); + + print $fh '', $crlf, + 'Microsoft Visual Studio Solution File, Format Version 11.00', $crlf; + $self->print_workspace_comment($fh, + '# Visual Studio 10', $crlf, + '# $Id$', $crlf, + '#', $crlf, + '# This file was generated by MPC. Any changes made directly to', $crlf, + '# this file will be lost the next time it is generated.', $crlf, + '#', $crlf, + '# MPC Command:', $crlf, + '# ', $self->create_command_line_string($0, @ARGV), $crlf); +} + +1; diff --git a/ACE/MPC/modules/VC6ProjectCreator.pm b/ACE/MPC/modules/VC6ProjectCreator.pm new file mode 100644 index 00000000000..4a28f228c69 --- /dev/null +++ b/ACE/MPC/modules/VC6ProjectCreator.pm @@ -0,0 +1,81 @@ +package VC6ProjectCreator; + +# ************************************************************ +# Description : A VC6 Project Creator +# Author : Chad Elliott +# Create Date : 3/14/2002 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use ProjectCreator; +use VCProjectBase; + +use vars qw(@ISA); +@ISA = qw(VCProjectBase ProjectCreator); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub project_file_extension { + #my $self = shift; + return '.dsp'; +} + + +sub override_valid_component_extensions { + my($self, $comp) = @_; + + ## Visual C++ 6.0 doesn't understand all of the extensions that MPC + ## supports. + if ($comp eq 'source_files' && $self->languageIs(Creator::cplusplus)) { + return ["\\.cpp", "\\.cxx", "\\.c"]; + } + + return undef; +} + + +sub override_exclude_component_extensions { + my($self, $comp) = @_; + + ## Visual C++ 6.0 doesn't understand all of the extensions that MPC + ## supports. + if ($comp eq 'source_files' && $self->languageIs(Creator::cplusplus)) { + return ["_T\\.cpp", "_T\\.cxx"]; + } + + return undef; +} + + +sub get_dll_exe_template_input_file { + #my $self = shift; + return 'vc6dspdllexe'; +} + + +sub get_lib_exe_template_input_file { + #my $self = shift; + return 'vc6dsplibexe'; +} + + +sub get_lib_template_input_file { + #my $self = shift; + return 'vc6dsplib'; +} + + +sub get_dll_template_input_file { + #my $self = shift; + return 'vc6dspdll'; +} + + +1; diff --git a/ACE/MPC/modules/VC6WorkspaceCreator.pm b/ACE/MPC/modules/VC6WorkspaceCreator.pm new file mode 100644 index 00000000000..714c7ce1673 --- /dev/null +++ b/ACE/MPC/modules/VC6WorkspaceCreator.pm @@ -0,0 +1,105 @@ +package VC6WorkspaceCreator; + +# ************************************************************ +# Description : A VC6 Workspace Creator +# Author : Chad Elliott +# Create Date : 5/13/2002 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use VC6ProjectCreator; +use WinWorkspaceBase; +use WorkspaceCreator; + +use vars qw(@ISA); +@ISA = qw(WinWorkspaceBase WorkspaceCreator); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + + +sub compare_output { + #my $self = shift; + return 1; +} + + +sub workspace_file_extension { + #my $self = shift; + return '.dsw'; +} + + +sub pre_workspace { + my($self, $fh) = @_; + my $crlf = $self->crlf(); + + ## This identifies it as a Visual C++ file + print $fh 'Microsoft Developer Studio Workspace File, Format Version 6.00', $crlf; + + ## Optionally print the workspace comment + $self->print_workspace_comment($fh, + '#', $crlf, + '# $Id$', $crlf, + '#', $crlf, + '# This file was generated by MPC. Any changes made directly to', $crlf, + '# this file will be lost the next time it is generated.', $crlf, + '#', $crlf, + '# MPC Command:', $crlf, + '# ', $self->create_command_line_string($0, @ARGV), $crlf, $crlf); +} + + +sub write_comps { + my($self, $fh, $gen) = @_; + my $projects = $self->get_projects(); + my $pjs = $self->get_project_info(); + my $crlf = $self->crlf(); + + ## Sort the project so that they resulting file can be exactly + ## reproduced given the same list of projects. + foreach my $project (sort { $gen->file_sorter($a, $b) } @$projects) { + + ## Add the project name and project file information + print $fh "###############################################################################$crlf$crlf", + "Project: \"$$pjs{$project}->[0]\"=", $self->slash_to_backslash($project), + " - Package Owner=<4>$crlf$crlf", + "Package=<5>${crlf}{{{$crlf}}}$crlf$crlf", + "Package=<4>${crlf}{{{$crlf"; + + my $deps = $self->get_validated_ordering($project); + if (defined $$deps[0]) { + ## Add in the project dependencies + foreach my $dep (@$deps) { + print $fh " Begin Project Dependency$crlf", + " Project_Dep_Name $dep$crlf", + " End Project Dependency$crlf"; + } + } + + ## End the project section + print $fh "}}}$crlf$crlf"; + } +} + + +sub post_workspace { + my($self, $fh) = @_; + my $crlf = $self->crlf(); + + ## This text is always the same + print $fh "###############################################################################$crlf$crlf", + "Global:$crlf$crlf", + "Package=<5>${crlf}{{{$crlf}}}$crlf$crlf", + "Package=<3>${crlf}{{{$crlf}}}$crlf$crlf", + "###############################################################################$crlf$crlf"; +} + + +1; diff --git a/ACE/MPC/modules/VC71ProjectCreator.pm b/ACE/MPC/modules/VC71ProjectCreator.pm new file mode 100644 index 00000000000..5c8d9e5b4ce --- /dev/null +++ b/ACE/MPC/modules/VC71ProjectCreator.pm @@ -0,0 +1,37 @@ +package VC71ProjectCreator; + +# ************************************************************ +# Description : A VC7.1 Project Creator +# Author : Chad Elliott +# Create Date : 4/17/2003 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use VC7ProjectCreator; + +use vars qw(@ISA); +@ISA = qw(VC7ProjectCreator); + +# ************************************************************ +# Data Section +# ************************************************************ + +my %config = ('vcversion' => '7.10', + 'forloopscope' => 'TRUE', + ); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub get_configurable { + my($self, $name) = @_; + return $config{$name}; +} + +1; diff --git a/ACE/MPC/modules/VC71WorkspaceCreator.pm b/ACE/MPC/modules/VC71WorkspaceCreator.pm new file mode 100644 index 00000000000..0c9ecdada1b --- /dev/null +++ b/ACE/MPC/modules/VC71WorkspaceCreator.pm @@ -0,0 +1,82 @@ +package VC71WorkspaceCreator; + +# ************************************************************ +# Description : A VC7.1 Workspace Creator +# Author : Chad Elliott +# Create Date : 4/17/2003 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use VC71ProjectCreator; +use VC7WorkspaceCreator; + +use vars qw(@ISA); +@ISA = qw(VC7WorkspaceCreator); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + + +sub pre_workspace { + my($self, $fh) = @_; + my $crlf = $self->crlf(); + + ## This identifies it as a Visual Studio 2003 file + print $fh 'Microsoft Visual Studio Solution File, Format Version 8.00', $crlf; + + ## Optionally print the workspace comment + $self->print_workspace_comment($fh, + '#', $crlf, + '# $Id$', $crlf, + '#', $crlf, + '# This file was generated by MPC. Any changes made directly to', $crlf, + '# this file will be lost the next time it is generated.', $crlf, + '#', $crlf, + '# MPC Command:', $crlf, + '# ', $self->create_command_line_string($0, @ARGV), $crlf); +} + + +sub print_inner_project { + my($self, $fh, $gen, $pguid, $deps, $project_name, $name_to_guid_map) = @_; + + if ($self->allow_empty_dependencies() || defined $$deps[0]) { + ## Print out the project dependencies + my $crlf = $self->crlf(); + print $fh "\tProjectSection(ProjectDependencies) = postProject$crlf"; + foreach my $dep (@$deps) { + my $guid = $name_to_guid_map->{$dep}; + print $fh "\t\t{$guid} = {$guid}$crlf" if (defined $guid); + } + print $fh "\tEndProjectSection$crlf"; + } +} + + +sub allow_empty_dependencies { + #my $self = shift; + return 1; +} + + +sub print_configs { + my($self, $fh, $configs) = @_; + my $crlf = $self->crlf(); + foreach my $key (sort keys %$configs) { + print $fh "\t\t$key = $key$crlf"; + } +} + + +sub print_dependencies { + ## These are done in the print_inner_project method +} + + +1; diff --git a/ACE/MPC/modules/VC7ProjectCreator.pm b/ACE/MPC/modules/VC7ProjectCreator.pm new file mode 100644 index 00000000000..8182c23f130 --- /dev/null +++ b/ACE/MPC/modules/VC7ProjectCreator.pm @@ -0,0 +1,150 @@ +package VC7ProjectCreator; + +# ************************************************************ +# Description : A VC7 Project Creator +# Author : Chad Elliott +# Create Date : 4/23/2002 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use GUID; +use ProjectCreator; +use VCProjectBase; +use XMLProjectBase; + +use vars qw(@ISA); +@ISA = qw(XMLProjectBase VCProjectBase ProjectCreator); + +# ************************************************************ +# Data Section +# ************************************************************ + +my %info = (Creator::cplusplus => {'ext' => '.vcproj', + 'dllexe' => 'vc7exe', + 'libexe' => 'vc7libexe', + 'dll' => 'vc7dll', + 'lib' => 'vc7lib', + 'template' => 'vc7', + }, + Creator::csharp => {'ext' => '.csproj', + 'dllexe' => 'vc7csharp', + 'libexe' => 'vc7csharp', + 'dll' => 'vc7csharp', + 'lib' => 'vc7csharp', + 'template' => 'vc7csharp', + }, + Creator::java => {'ext' => '.vjsproj', + 'dllexe' => 'vc7java', + 'libexe' => 'vc7java', + 'dll' => 'vc7java', + 'lib' => 'vc7java', + 'template' => 'vc7java', + }, + Creator::vb => {'ext' => '.vbproj', + 'dllexe' => 'vc7vb', + 'libexe' => 'vc7vb', + 'dll' => 'vc7vb', + 'lib' => 'vc7vb', + 'template' => 'vc7vb', + }, + ); + +my %config = ('vcversion' => '7.00', + 'forloopscope' => 'TRUE', + ); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub languageSupported { + return defined $info{$_[0]->get_language()}; +} + + +sub get_info_hash { + #my($self, $key) = @_; + return $info{$_[1]}; +} + + +sub get_configurable { + #my($self, $name) = @_; + return $config{$_[1]}; +} + + +sub fill_value { + my($self, $name) = @_; + + if ($name eq 'guid') { + ## Return a repeatable GUID for use within the template. The values + ## provided will be hashed and returned in a format expected by + ## Visual Studio. + return GUID::generate($self->project_file_name(), + $self->{'current_input'}, $self->getcwd()); + } + elsif ($name eq 'language') { + ## If this project is a Web Application, the language is website. + ## Since Visual Studio 2003 doesn't support Web Applications, this + ## will never happen. However, this code is shared by the vc8 + ## project type, so it can happen then. + return Creator::website if ($self->get_assignment('webapp')); + + ## Also for the vc8 project type, the language is stored in the + ## project file as a comment when external C# references need to be + ## added to the resulting project. Since a C++ project can mix with + ## C#, the particular project language can not be determined by the + ## workspace language. + return $self->get_language(); + } + + ## Consult another method for this template name. This method is + ## overrridden by the other project creators that inherit from this + ## one. + return $self->get_configurable($name); +} + + +sub project_file_extension { + return $_[0]->get_info_hash($_[0]->get_language())->{'ext'}; +} + + +sub get_dll_exe_template_input_file { + return $_[0]->get_info_hash($_[0]->get_language())->{'dllexe'}; +} + + +sub get_lib_exe_template_input_file { + return $_[0]->get_info_hash($_[0]->get_language())->{'libexe'}; +} + + +sub get_dll_template_input_file { + return $_[0]->get_info_hash($_[0]->get_language())->{'dll'}; +} + + +sub get_lib_template_input_file { + return $_[0]->get_info_hash($_[0]->get_language())->{'lib'}; +} + + +sub get_template { + return $_[0]->get_info_hash($_[0]->get_language())->{'template'}; +} + + +sub get_cmdsep_symbol { + #my $self = shift; + return '&'; +} + + +1; diff --git a/ACE/MPC/modules/VC7WorkspaceCreator.pm b/ACE/MPC/modules/VC7WorkspaceCreator.pm new file mode 100644 index 00000000000..8de15f83db2 --- /dev/null +++ b/ACE/MPC/modules/VC7WorkspaceCreator.pm @@ -0,0 +1,295 @@ +package VC7WorkspaceCreator; + +# ************************************************************ +# Description : A VC7 Workspace Creator +# Author : Chad Elliott +# Create Date : 5/14/2002 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use VC7ProjectCreator; +use WinWorkspaceBase; +use WorkspaceCreator; + +use vars qw(@ISA); +@ISA = qw(WinWorkspaceBase WorkspaceCreator); + +# ************************************************************ +# Data Section +# ************************************************************ + +my %guids = (Creator::cplusplus => '8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942', + Creator::csharp => 'FAE04EC0-301F-11D3-BF4B-00C04F79EFBC', + Creator::java => 'E6FDF86B-F3D1-11D4-8576-0002A516ECE8', + Creator::vb => 'F184B08F-C81C-45F6-A57F-5ABD9991F28F', + Creator::website => 'E24C65DC-7377-472B-9ABA-BC803B73C61A', + ); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub compare_output { + #my $self = shift; + return 1; +} + + +sub workspace_file_extension { + #my $self = shift; + return '.sln'; +} + + +sub pre_workspace { + my($self, $fh) = @_; + my $crlf = $self->crlf(); + + ## This identifies it as a Visual Studio file + print $fh 'Microsoft Visual Studio Solution File, Format Version 7.00', $crlf; + + ## Optionally print the workspace comment + $self->print_workspace_comment($fh, + '#', $crlf, + '# $Id$', $crlf, + '#', $crlf, + '# This file was generated by MPC. Any changes made directly to', $crlf, + '# this file will be lost the next time it is generated.', $crlf, + '#', $crlf, + '# MPC Command:', $crlf, + '# ', $self->create_command_line_string($0, @ARGV), $crlf); +} + + +sub print_inner_project { + #my $self = shift; + #my $fh = shift; + #my $gen = shift; + #my $pguid = shift; + #my $deps = shift; + #my $name = shift; + #my $name_to_guid_map = shift; + #my $proj_language = shift; + #my $cfgs = shift; + +} + + +sub print_configs { + my($self, $fh, $configs) = @_; + my $crlf = $self->crlf(); + my $count = 0; + + ## Print out the configurations for the solution + foreach my $key (sort keys %$configs) { + print $fh "\t\tConfigName.$count = $key$crlf"; + $count++; + } +} + + +sub print_dependencies { + my($self, $fh, $gen, $list, $pjs) = @_; + my $crlf = $self->crlf(); + + ## I hate to add yet another loop through all the projects, but + ## we must have some way to map plain project names to guids. + my %name_to_guid_map; + foreach my $project (@$list) { + my($name, $deps, $guid) = @{$$pjs{$project}}; + $name_to_guid_map{$name} = $guid; + } + + ## Project Dependencies + print $fh "\tGlobalSection(ProjectDependencies) = postSolution$crlf"; + foreach my $project (@$list) { + my($name, $rawdeps, $project_guid) = @{$$pjs{$project}}; + my $deps = $self->get_validated_ordering($project); + if (defined $$deps[0]) { + my $i = 0; + foreach my $dep (@$deps) { + my $guid = $name_to_guid_map{$dep}; + if (defined $guid) { + print $fh "\t\t{$project_guid}.$i = {$guid}$crlf"; + $i++; + } + } + } + } + print $fh "\tEndGlobalSection$crlf"; +} + + +sub write_comps { + my($self, $fh, $gen) = @_; + my $projects = $self->get_projects(); + my $pjs = $self->get_project_info(); + my @list = sort @$projects; + my $crlf = $self->crlf(); + + ## I hate to add yet another loop through all the projects, but + ## we must have some way to map plain project names to guids. + my %name_to_guid_map; + foreach my $project (@list) { + my($name, $deps, $guid) = @{$$pjs{$project}}; + $name_to_guid_map{$name} = $guid; + } + + ## Project Information + foreach my $project (@list) { + my($pname, $rawdeps, $guid, $language, $custom_only, $nocross, $managed, @cfgs) = @{$$pjs{$project}}; + my $pguid = $guids{$language}; + my $deps = $self->get_validated_ordering($project); + my($name, $proj) = $self->adjust_names($pname, $project, $language); + print $fh "Project(\"{$pguid}\") = \"$name\", \"$proj\", \"{$guid}\"$crlf"; + $self->print_inner_project($fh, $gen, $guid, $deps, + $name, \%name_to_guid_map, + $language, \@cfgs); + print $fh "EndProject$crlf"; + } + + ## This block creates the different possible configurations for this + ## solution. + print $fh "Global$crlf", + "\tGlobalSection(", + $self->get_solution_config_section_name(), + ") = preSolution$crlf"; + my %configs; + foreach my $project (@list) { + my($name, $deps, $pguid, $lang, $custom_only, $nocross, $managed, @cfgs) = @{$$pjs{$project}}; + foreach my $cfg (@cfgs) { + $configs{$self->get_short_config_name($cfg)} = $cfg; + } + } + $self->print_configs($fh, \%configs); + print $fh "\tEndGlobalSection$crlf"; + + ## Print dependencies if there are any + $self->print_dependencies($fh, $gen, \@list, $pjs); + + ## Project Configuration Names + print $fh "\tGlobalSection(", + $self->get_project_config_section_name(), + ") = postSolution$crlf"; + + ## See if there is an 'Any CPU' or '.NET' configuration + my $anycpu; + foreach my $key (keys %configs) { + if (index($key, 'Any CPU') >= 0 || index($key, '.NET') >= 0) { + $anycpu = 1; + last; + } + } + + ## Go through each project and print out the settings per GUID + foreach my $project (@list) { + my($name, $deps, $pguid, $lang, $custom_only, $nocross, $managed, @cfgs) = @{$$pjs{$project}}; + my %all_configs = %configs; + foreach my $cfg (sort @cfgs) { + my $c = $self->get_short_config_name($cfg); + my $deployable = !$nocross; + my $buildable = $deployable; + if (index($cfg, 'Win32') >= 0 || index($cfg, 'x64') >= 0) { + $deployable = 0; + $buildable = 1; + } elsif ($custom_only) { + $deployable = 0; + } + if (defined $anycpu) { + ## There is a non-C++ project; there is no need to explicitly + ## enable building of the configurations for this project. So, we + ## get rid of the configuration settings from the copy of the + ## configs map. + delete $all_configs{$c}; + } + else { + print $fh "\t\t{$pguid}.$c.ActiveCfg = $cfg$crlf"; + print $fh "\t\t{$pguid}.$c.Build.0 = $cfg$crlf" if ($buildable == 1); + print $fh "\t\t{$pguid}.$c.Deploy.0 = $cfg$crlf" if ($deployable == 1); + } + } + + ## If this is a mixed language workspace, we need to explicitly + ## enable the building of the non-C++ projects when any platform + ## other than Any CPU/.NET is selected. + if (defined $anycpu) { + my %printed; + foreach my $c (sort @cfgs) { + if ($c =~ /(.+\|)/) { + my $cfg = $1; + foreach my $remainder (sort keys %all_configs) { + if (index($remainder, $cfg) == 0) { + if (!$printed{$pguid.$remainder}) { + print $fh "\t\t{$pguid}.$remainder.ActiveCfg = $c$crlf", + "\t\t{$pguid}.$remainder.Build.0 = $c$crlf"; + $printed{$pguid.$remainder} = 1; + } + } + } + } + print $fh "\t\t{$pguid}.$c.ActiveCfg = $c$crlf", + "\t\t{$pguid}.$c.Build.0 = $c$crlf"; + } + } + else { + ## Non-C++ projects have no configurations + if (!defined $cfgs[0]) { + foreach my $c (sort keys %configs) { + my $cfg = $c . '|.NET'; + print $fh "\t\t{$pguid}.$c.ActiveCfg = $cfg$crlf", + "\t\t{$pguid}.$c.Build.0 = $cfg$crlf"; + } + } + } + } + print $fh "\tEndGlobalSection$crlf"; + + $self->print_additional_sections($fh); + + print $fh "EndGlobal$crlf"; +} + + +sub adjust_names { + my($self, $name, $proj, $lang) = @_; + $proj =~ s/\//\\/g; + return $name, $proj; +} + + +sub get_short_config_name { + my($self, $cfg) = @_; + $cfg =~ s/\|.*//; + return $cfg; +} + + +sub get_solution_config_section_name { + #my $self = shift; + return 'SolutionConfiguration'; +} + + +sub get_project_config_section_name { + #my $self = shift; + return 'ProjectConfiguration'; +} + + +sub print_additional_sections { + my($self, $fh) = @_; + my $crlf = $self->crlf(); + + print $fh "\tGlobalSection(ExtensibilityGlobals) = postSolution$crlf", + "\tEndGlobalSection$crlf", + "\tGlobalSection(ExtensibilityAddIns) = postSolution$crlf", + "\tEndGlobalSection$crlf"; +} + + +1; diff --git a/ACE/MPC/modules/VC8ProjectCreator.pm b/ACE/MPC/modules/VC8ProjectCreator.pm new file mode 100644 index 00000000000..67de189c0d0 --- /dev/null +++ b/ACE/MPC/modules/VC8ProjectCreator.pm @@ -0,0 +1,113 @@ +package VC8ProjectCreator; + +# ************************************************************ +# Description : A VC8 Project Creator +# Author : Johnny Willemsen +# Create Date : 4/21/2004 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use VC7ProjectCreator; + +use vars qw(@ISA); +@ISA = qw(VC7ProjectCreator); + +# ************************************************************ +# Data Section +# ************************************************************ + +my %info = (Creator::cplusplus => {'ext' => '.vcproj', + 'dllexe' => 'vc8exe', + 'libexe' => 'vc8libexe', + 'dll' => 'vc8dll', + 'lib' => 'vc8lib', + 'template' => 'vc8', + }, + Creator::csharp => {'ext' => '.csproj', + 'dllexe' => 'vc8csharp', + 'libexe' => 'vc8csharp', + 'dll' => 'vc8csharp', + 'lib' => 'vc8csharp', + 'template' => 'vc8csharp', + }, + Creator::java => {'ext' => '.vjsproj', + 'dllexe' => 'vc8java', + 'libexe' => 'vc8java', + 'dll' => 'vc8java', + 'lib' => 'vc8java', + 'template' => 'vc8java', + }, + Creator::vb => {'ext' => '.vbproj', + 'dllexe' => 'vc8vb', + 'libexe' => 'vc8vb', + 'dll' => 'vc8vb', + 'lib' => 'vc8vb', + 'template' => 'vc8vb', + }, + ); + +my %config = ('vcversion' => '8.00'); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub languageSupported { + return defined $info{$_[0]->get_language()}; +} + + +sub webapp_supported { + #my $self = shift; + return 1; +} + + +sub require_dependencies { + ## With vc8, they fixed it such that static libraries that depend on + ## other static libraries will not be included into the target library + ## by default. Way to go Microsoft! + return 1; +} + +sub post_file_creation { + my($self, $file) = @_; + + ## VC8 stores information in a .user file that may conflict + ## with information stored in the project file. If we have + ## created a new project file, we will remove the corresponding + ## .user file to avoid strange conflicts. + unlink("$file.user"); +} + +sub get_configurable { + #my($self, $name) = @_; + return $config{$_[1]}; +} + +sub get_info_hash { + my($self, $key) = @_; + + ## If we have the setting in our information map, the use it. + return $info{$key} if (defined $info{$key}); + + ## Otherwise, see if our parent type can take care of it. + return $self->SUPER::get_info_hash($key); +} + +sub translate_value { + my($self, $key, $val) = @_; + + ## Microsoft uses AnyCPU in the project file, but uses Any CPU in the + ## solution file. + $val = 'Any CPU' if ($key eq 'platform' && $val eq 'AnyCPU'); + + return $self->SUPER::translate_value($key, $val); +} + +1; diff --git a/ACE/MPC/modules/VC8WorkspaceCreator.pm b/ACE/MPC/modules/VC8WorkspaceCreator.pm new file mode 100644 index 00000000000..60dfd7c7187 --- /dev/null +++ b/ACE/MPC/modules/VC8WorkspaceCreator.pm @@ -0,0 +1,248 @@ +package VC8WorkspaceCreator; + +# ************************************************************ +# Description : A VC8 Workspace Creator +# Author : Johnny Willemsen +# Create Date : 4/21/2004 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use VC8ProjectCreator; +use VC71WorkspaceCreator; + +use vars qw(@ISA); +@ISA = qw(VC71WorkspaceCreator); + +# ************************************************************ +# Data Section +# ************************************************************ + +my %lang_map = (Creator::cplusplus => 'Visual C#', + Creator::csharp => 'Visual C#', + Creator::vb => 'Visual Basic', + Creator::java => 'Visual J#'); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub pre_workspace { + my($self, $fh) = @_; + my $crlf = $self->crlf(); + + ## This identifies it as a Visual Studio 2005 file + print $fh '', $crlf, + 'Microsoft Visual Studio Solution File, Format Version 9.00', $crlf; + + ## Optionally print the workspace comment + $self->print_workspace_comment($fh, + '# Visual Studio 2005', $crlf, + '# $Id$', $crlf, + '#', $crlf, + '# This file was generated by MPC. Any changes made directly to', $crlf, + '# this file will be lost the next time it is generated.', $crlf, + '#', $crlf, + '# MPC Command:', $crlf, + '# ', $self->create_command_line_string($0, @ARGV), $crlf); +} + +sub post_workspace { + my($self, $fh, $creator) = @_; + my $pjs = $self->get_project_info(); + my @projects = $self->sort_dependencies($self->get_projects(), 0); + my %gmap; + + ## Store a map of the project name to project guid and whether or not + ## it is suitable to be referenced. Adding a reference to a + ## non-managed c++ library or a "utility" project causes a warning in + ## Visual Studio 2008 and higher. + foreach my $project (@projects) { + my($name, $deps, $guid, $lang, $custom_only, $nocross, $managed) = @{$$pjs{$project}}; + $gmap{$name} = [$guid, !$custom_only && ($managed || + $lang ne Creator::cplusplus)]; + } + + ## Now go through the projects and check for the need to add external + ## references. + foreach my $project (@projects) { + my $ph = new FileHandle(); + my $outdir = $self->get_outdir(); + $outdir = $self->getcwd() if ($outdir eq '.'); + if (open($ph, "$outdir/$project")) { + my $write; + my @read; + my $crlf = $self->crlf(); + my $cwd = $self->getcwd(); + my $lang = $$pjs{$project}->[3]; + my $managed = $$pjs{$project}->[6]; + + while(<$ph>) { + ## This is a comment found in vc8.mpd if the project contains the + ## 'after' keyword setting and the 'add_references' template + ## variable setting. + if (/^(\s*)<!\-\-\s+MPC\s+ADD\s+DEPENDENCIES/) { + my $spc = $1; + my $deps = $self->get_validated_ordering($project); + foreach my $dep (@$deps) { + my $relative = $self->get_relative_dep_file($creator, + "$cwd/$project", + $dep); + if (defined $relative) { + if ($lang eq Creator::cplusplus) { + ## If the current project is not managed, then we will + ## add references (although I doubt that will be useful). + ## If the current project is managed, then the reference + ## project must be managed or a non-c++ project. + if (!$managed || ($managed && $gmap{$dep}->[1])) { + push(@read, $spc . '<ProjectReference' . $crlf . + $spc . "\tReferencedProjectIdentifier=" . + "\"\{$gmap{$dep}->[0]\}\"$crlf" . + $spc . "\tRelativePathToProject=\"$relative\"$crlf" . + $spc . '/>' . $crlf); + } + } + ## This is a non-c++ language. So, it should not reference + ## unmanaged c++ libraries. If it's a managed project or + ## it's not a c++ project, it's ok to add a reference. + elsif ($gmap{$dep}->[1]) { + push(@read, $spc . '<ProjectReference Include="' . + $relative . '">' . $crlf, + $spc . ' <Project>{' . $gmap{$dep}->[0] . + '}</Project>' . $crlf, + $spc . ' <Name>' . $dep . '</Name>' . $crlf, + $spc . '</ProjectReference>' . $crlf); + } + + ## Indicate that we need to re-write the file + $write = 1; + } + } + last if (!$write); + } + else { + push(@read, $_); + } + } + close($ph); + + ## If we need to re-write the file, then do so + if ($write && open($ph, ">$outdir/$project")) { + foreach my $line (@read) { + print $ph $line; + } + close($ph); + } + } + } +} + +sub adjust_names { + my($self, $name, $proj, $lang) = @_; + + ## For websites, the project needs to be the directory of the actual + ## project file with a trailing slash. The name needs a trailing slash + ## too. + if ($lang eq Creator::website) { + $proj = $self->mpc_dirname($proj); + $proj .= '\\'; + $name .= '\\'; + } + + ## This always needs to be a path with the Windows style directory + ## separator. + $proj =~ s/\//\\/g; + return $name, $proj; +} + +sub get_short_config_name { + #my($self, $cfg) = @_; + return $_[1]; +} + +sub get_solution_config_section_name { + #my $self = shift; + return 'SolutionConfigurationPlatforms'; +} + +sub get_project_config_section_name { + #my $self = shift; + return 'ProjectConfigurationPlatforms'; +} + +sub print_additional_sections { + my($self, $fh) = @_; + my $crlf = $self->crlf(); + + print $fh "\tGlobalSection(SolutionProperties) = preSolution$crlf", + "\t\tHideSolutionNode = FALSE$crlf", + "\tEndGlobalSection$crlf"; +} + +sub allow_empty_dependencies { + #my $self = shift; + return 0; +} + +sub print_inner_project { + my($self, $fh, $gen, $currguid, $deps, $name, $name_to_guid_map, $proj_language, $cfgs) = @_; + + ## We need to perform a lot of work, but only for websites. + if ($proj_language eq Creator::website) { + my $crlf = $self->crlf(); + my $directory = ($name eq '.\\' ? + $self->get_workspace_name() . '\\' : $name); + + ## We need the directory name with no trailing back-slash for use + ## below. + my $notrail = $directory; + $notrail =~ s/\\$//; + + # Print the website project. + print $fh "\tProjectSection(WebsiteProperties) = preProject", $crlf; + + ## Print out the references + my $references; + foreach my $dep (@$deps) { + if (defined $$name_to_guid_map{$dep}) { + $references = "\t\t" . + 'ProjectReferences = "' if (!defined $references); + $references .= "{$$name_to_guid_map{$dep}}|$dep;"; + } + } + print $fh $references, '"', $crlf if (defined $references); + + ## And now the configurations + my %cfg_seen; + foreach my $config (@$cfgs) { + $config =~ s/\|.*//; + if (!$cfg_seen{$config}) { + print $fh "\t\t$config.AspNetCompiler.VirtualPath = \"/$notrail\"", $crlf, + "\t\t$config.AspNetCompiler.PhysicalPath = \"$directory\"", $crlf, + "\t\t$config.AspNetCompiler.TargetPath = \"PrecompiledWeb\\$directory\"", $crlf, + "\t\t$config.AspNetCompiler.Updateable = \"true\"", $crlf, + "\t\t$config.AspNetCompiler.ForceOverwrite = \"true\"", $crlf, + "\t\t$config.AspNetCompiler.FixedNames = \"true\"", $crlf, + "\t\t$config.AspNetCompiler.Debug = \"", + ($config =~ /debug/i ? 'True' : 'False'), "\"", $crlf; + $cfg_seen{$config} = 1; + } + } + print $fh "\t\tVWDPort = \"1573\"", $crlf, + "\t\tDefaultWebSiteLanguage = \"", + $lang_map{$self->get_language()}, "\"", $crlf, + "\tEndProjectSection", $crlf; + } + else { + # We can ignore this project and pass it to the + # SUPER since it's not a website. + $self->SUPER::print_inner_project($fh, $gen, $currguid, $deps, + $name, $name_to_guid_map); + } +} + +1; diff --git a/ACE/MPC/modules/VC9ProjectCreator.pm b/ACE/MPC/modules/VC9ProjectCreator.pm new file mode 100644 index 00000000000..fea5ee31fc4 --- /dev/null +++ b/ACE/MPC/modules/VC9ProjectCreator.pm @@ -0,0 +1,35 @@ +package VC9ProjectCreator; + +# ************************************************************ +# Description : A VC9 Project Creator +# Author : Johnny Willemsen +# Create Date : 11/22/2007 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use VC8ProjectCreator; + +use vars qw(@ISA); +@ISA = qw(VC8ProjectCreator); + +my %config = ('vcversion' => '9.00', + 'prversion' => '9.0.30729', + 'toolsversion' => '3.5', + 'xmlheader' => 1, + ); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub get_configurable { + my($self, $name) = @_; + return $config{$name}; +} + +1; diff --git a/ACE/MPC/modules/VC9WorkspaceCreator.pm b/ACE/MPC/modules/VC9WorkspaceCreator.pm new file mode 100644 index 00000000000..e0a5ba6b667 --- /dev/null +++ b/ACE/MPC/modules/VC9WorkspaceCreator.pm @@ -0,0 +1,42 @@ +package VC9WorkspaceCreator; + +# ************************************************************ +# Description : A VC9 Workspace Creator +# Author : Johnny Willemsen +# Create Date : 11/22/2007 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use VC9ProjectCreator; +use VC8WorkspaceCreator; + +use vars qw(@ISA); +@ISA = qw(VC8WorkspaceCreator); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub pre_workspace { + my($self, $fh) = @_; + my $crlf = $self->crlf(); + + print $fh '', $crlf, + 'Microsoft Visual Studio Solution File, Format Version 10.00', $crlf; + $self->print_workspace_comment($fh, + '# Visual Studio 2008', $crlf, + '# $Id$', $crlf, + '#', $crlf, + '# This file was generated by MPC. Any changes made directly to', $crlf, + '# this file will be lost the next time it is generated.', $crlf, + '#', $crlf, + '# MPC Command:', $crlf, + '# ', $self->create_command_line_string($0, @ARGV), $crlf); +} + +1; diff --git a/ACE/MPC/modules/VCProjectBase.pm b/ACE/MPC/modules/VCProjectBase.pm new file mode 100644 index 00000000000..47786b49dcd --- /dev/null +++ b/ACE/MPC/modules/VCProjectBase.pm @@ -0,0 +1,61 @@ +package VCProjectBase; + +# ************************************************************ +# Description : A VC Project base module +# Author : Chad Elliott +# Create Date : 1/4/2005 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use WinProjectBase; + +use vars qw(@ISA); +@ISA = qw(WinProjectBase); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub compare_output { + #my $self = shift; + return 1; +} + + +sub require_dependencies { + my $self = shift; + + ## Only write dependencies for non-static projects + ## and static exe projects, unless the user wants the + ## dependency combined static library. + return ($self->get_static() == 0 || $self->exe_target() || + $self->dependency_combined_static_library()); +} + + +sub dependency_is_filename { + #my $self = shift; + return 0; +} + + +sub get_properties { + my $self = shift; + + ## Get the base class properties and add the properties that we + ## support. + my $props = $self->WinProjectBase::get_properties(); + + ## All projects that use this base class are for Microsoft compilers. + $$props{'microsoft'} = 1; + + return $props; +} + + +1; diff --git a/ACE/MPC/modules/Version.pm b/ACE/MPC/modules/Version.pm new file mode 100644 index 00000000000..7edc61a50f7 --- /dev/null +++ b/ACE/MPC/modules/Version.pm @@ -0,0 +1,58 @@ +package Version; + +# ************************************************************ +# Description : Central location for the MPC version. +# Author : Chad Elliott +# Create Date : 1/5/2003 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +# ************************************************************ +# Data Section +# ************************************************************ + +## This is the starting major and minor version +my $version = '3.7'; +my $once = 1; + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub get { + if ($once) { + ## We only need to do this once + $once = 0; + + ## Here we determine the beta version. The base variable + ## is the negated number of existing ChangeLog entries at the + ## time of the release of the major and minor version. We then + ## add the total number of ChangeLog entries to the base to + ## get the beta version. + my $base = -1; + if (open(CLH, ::getBasePath() . '/ChangeLog')) { + while(<CLH>) { + if (/^\w\w\w\s\w\w\w\s/) { + ++$base; + } + } + close(CLH); + + ## We then append the beta version number to the version string + $version .= ".$base"; + } + else { + $version .= '.??'; + } + } + + return $version; +} + + +1; diff --git a/ACE/MPC/modules/WB26ProjectCreator.pm b/ACE/MPC/modules/WB26ProjectCreator.pm new file mode 100644 index 00000000000..2a59f05038f --- /dev/null +++ b/ACE/MPC/modules/WB26ProjectCreator.pm @@ -0,0 +1,85 @@ +package WB26ProjectCreator; + +# ************************************************************ +# Description : Workbench 2.6 / VxWorks 6.4 generator +# Author : Johnny Willemsen +# Create Date : 07/01/2008 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use ProjectCreator; + +use vars qw(@ISA); +@ISA = qw(ProjectCreator); + +# ************************************************************ +# Data Section +# ************************************************************ + +my %templates = ('wb26' => '.project', + 'wb26wrproject' => '.wrproject', + 'wb26wrmakefile' => '.wrmakefile'); +my @tkeys = sort keys %templates; + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub crlf { + #my $self = shift; + return "\n"; +} + +sub project_file_name { + my($self, $name, $template) = @_; + + ## Fill in the name and template if they weren't provided + $name = $self->project_name() if (!defined $name); + $template = 'wb26' if (!defined $template || !defined $templates{$template}); + + if ($self->{'make_coexistence'}) { + return $self->get_modified_project_file_name($name, + '/' . $templates{$template}); + } + else { + return $templates{$template}; + } +} + +sub get_template { + #my $self = shift; + return @tkeys; +} + +sub dependency_is_filename { + #my $self = shift; + return 0; +} + +sub requires_forward_slashes { + return 1; +} + +sub file_visible { + ## We only want the project file visible to the workspace creator. + ## There can only be one and this is it. + #my($self, $template) = @_; + return $_[1] eq 'wb26'; +} + +sub get_dll_exe_template_input_file { + #my $self = shift; + return 'wb26exe'; +} + +sub get_dll_template_input_file { + #my $self = shift; + return 'wb26dll'; +} + +1; diff --git a/ACE/MPC/modules/WB26WorkspaceCreator.pm b/ACE/MPC/modules/WB26WorkspaceCreator.pm new file mode 100644 index 00000000000..63ec046ca71 --- /dev/null +++ b/ACE/MPC/modules/WB26WorkspaceCreator.pm @@ -0,0 +1,204 @@ +package WB26WorkspaceCreator; + +# ************************************************************ +# Description : Workbench 2.6 / VxWorks 6.4 generator +# Author : Johnny Willemsen +# Create Date : 07/01/2008 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +use WB26ProjectCreator; +use WorkspaceCreator; + +use vars qw(@ISA); +@ISA = qw(WorkspaceCreator); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub requires_make_coexistence { + #my $self = shift; + return 1; +} + +sub supports_make_coexistence { + #my $self = shift; + return 1; +} + +sub workspace_file_name { + #my $self = shift; + return 'org.eclipse.core.resources.prefs'; +} + +sub pre_workspace { + my($self, $fh) = @_; + my $crlf = $self->crlf(); + + ## Optionally print the workspace comment + $self->print_workspace_comment($fh, + '#----------------------------------------------------------------------------', $crlf, + '# WindRiver Workbench generator', $crlf, + '#', $crlf, + '# $Id$', $crlf, + '#', $crlf, + '# This file was generated by MPC. Any changes made directly to', $crlf, + '# this file will be lost the next time it is generated.', $crlf, + '# This file should be placed in the .metadata\.plugins\org.eclipse.core.runtime\.settings directory', $crlf, + '#', $crlf, + '# MPC Command:', $crlf, + "# $0 @ARGV", $crlf, + '#----------------------------------------------------------------------------', $crlf); + + ## Unchanging initial settings + print $fh 'version=1', $crlf, + 'eclipse.preferences.version=1', $crlf, + 'description.defaultbuildorder=false', $crlf; +} + +sub write_comps { + my($self, $fh) = @_; + my $pjs = $self->get_project_info(); + my @list = $self->sort_dependencies($self->get_projects(), 0); + + ## Print out the target + print $fh 'description.buildorder='; + foreach my $project (@list) { + print $fh "$$pjs{$project}->[0]/"; + } + print $fh $self->crlf(); +} + +sub post_workspace { + my($self, $fh, $creator) = @_; + my $crlf = $self->crlf(); + + ## Clear out the seen dependency hash for use within the + ## add_dependencies method. + $self->{'seen_deps'} = {}; + + ## Print out the project dependencies + foreach my $project ($self->sort_dependencies($self->get_projects(), 0)) { + print $fh "$project$crlf"; + $self->add_dependencies($creator, $project); + } +} + +sub get_additional_output { + ## Create the accompanying list file. It always goes in the same + ## directory as the first workspace output file. See + ## WorkspaceCreator.pm for a description of the array elements. + return [[undef, 'wb26projects.lst', \&list_file_body]]; +} + +sub list_file_body { + my($self, $fh) = @_; + my $crlf = $self->crlf(); + + ## Optionally print the workspace comment + $self->print_workspace_comment($fh, + '#----------------------------------------------------------------------------', $crlf, + '# WindRiver Workbench generator', $crlf, + '#', $crlf, + '# $Id$', $crlf, + '#', $crlf, + '# This file was generated by MPC. Any changes made directly to', $crlf, + '# this file will be lost the next time it is generated.', $crlf, + '# MPC Command:', $crlf, + "# $0 @ARGV", $crlf, + '#----------------------------------------------------------------------------', $crlf); + + ## Print out each target separately + foreach my $project ($self->sort_dependencies($self->get_projects(), 0)) { + print $fh Cwd::abs_path($self->mpc_dirname($project)), '/.project', $crlf; + } +} + +sub add_dependencies { + my($self, $creator, $proj) = @_; + my $outdir = $self->mpc_dirname($proj); + + ## These values will be changed after the first time through the for + ## loop below. + my $pre = "\t\t" . '<project>'; + my $post = '</project>'; + my $outfile = $outdir . '/.project'; + + ## Go through twice to edit both the .project and .wrproject files + for(my $i = 0; $i < 2; $i++) { + my $fh = new FileHandle(); + if (open($fh, $outfile)) { + ## Get the dependencies and store them based on the directory of + ## the project file. We will check them later. + my $deps = $self->get_validated_ordering($proj); + my $key = $self->mpc_basename($self->mpc_dirname($proj)); + $self->{'seen_deps'}->{$key} = {}; + foreach my $dep (@$deps) { + $self->{'seen_deps'}->{$key}->{$dep} = 1; + } + + my @read = (); + my $cwd = $self->getcwd(); + while(<$fh>) { + ## This is a comment found in wb26.mpd and wb26wrproject.mpd if + ## the project is an executable, contains the 'after' keyword + ## setting, and the 'enable_subprojects' template variable. + if (/MPC\s+ADD\s+DEPENDENCIES/) { + my $crlf = $self->crlf(); + my %seen = (); + my @lines; + foreach my $dep (reverse @$deps) { + ## If we've seen this dependency, we don't need to add it + ## again. The build tool will handle it correctly. + if (!$seen{$dep}) { + my $relative = $self->get_relative_dep_file($creator, + "$cwd/$proj", $dep); + ## Since we're looking at the dependencies in reverse order + ## now, we need to unshift them into another array to keep + ## the correct order. + unshift(@lines, "$pre$dep$post$crlf") if (defined $relative); + + ## We've now seen this dependency and all of the + ## projects upon which this one depends. + $seen{$dep} = 1; + foreach my $key (keys %{$self->{'seen_deps'}->{$dep}}) { + $seen{$key} = 1; + } + } + } + + ## Add the dependency lines to the project file + push(@read, @lines); + } + else { + push(@read, $_); + } + } + close($fh); + + ## We will always rewrite the project file (with or without + ## dependencies). + if (open($fh, ">$outfile")) { + foreach my $line (@read) { + print $fh $line; + } + close($fh); + } + } + + ## The dependencies need to go into the .wrproject too, so transform + ## the name and the pre and post values. + $outfile = $outdir . '/.wrproject'; + $pre = ' <subproject project="/'; + $post = '"/>'; + } +} + + +1; diff --git a/ACE/MPC/modules/WinProjectBase.pm b/ACE/MPC/modules/WinProjectBase.pm new file mode 100644 index 00000000000..0ef49418d93 --- /dev/null +++ b/ACE/MPC/modules/WinProjectBase.pm @@ -0,0 +1,119 @@ +package WinProjectBase; + +# ************************************************************ +# Description : A Windows base module for Project Creators +# Author : Chad Elliott +# Create Date : 1/4/2005 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +# ************************************************************ +# Data Section +# ************************************************************ + +my $max_win_env = 'MPC_MAX_WIN_FILE_LENGTH'; + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub convert_slashes { + #my $self = shift; + return 1; +} + + +sub case_insensitive { + #my $self = shift; + return 1; +} + + +sub translate_directory { + my($self, $dir) = @_; + + ## Call the base class version + $dir = $self->DirectoryManager::translate_directory($dir); + + ## Change drive letters and $() macros + $dir =~ s/^([A-Z]):/$1/i; + $dir =~ s/\$\(([^\)]+)\)/$1/g; + + ## We need to make sure that we do not exceed the maximum file name + ## limitation (including the cwd (- c:\) and object file name). So, we + ## check the total length against a predetermined "acceptable" value. + ## This acceptable value is modifiable through the environment. + my $maxenv = $ENV{$max_win_env}; + my $maxlen = (defined $maxenv && $maxenv =~ /^\d+$/ ? $maxenv : 128) + 3; + my $dirlen = length($dir); + my $diff = (length($self->getcwd()) + $dirlen + 1) - $maxlen; + + if ($diff > 0) { + if ($diff > $dirlen) { + $dir = substr($dir, $dirlen - 1); + } + else { + $dir = substr($dir, $diff); + } + while($dir =~ s/^\\//) { + } + } + + return $dir; +} + + +sub validated_directory { + my($self, $dir) = @_; + + ## $(...) could contain a drive letter and Windows can not + ## make a directory that resembles a drive letter. So, we have + ## to exclude those directories with $(...). + if ($dir =~ /\$\([^\)]+\)/ || $dir =~ /\.\.\\/ || $dir =~ /^[A-Z]:/i) { + return '.'; + } + else { + return $dir; + } +} + + +sub crlf { + return $_[0]->windows_crlf(); +} + + +sub get_cmdsep_symbol { + #my $self = shift; + return '&'; +} + + +sub file_sorter { + #my $self = shift; + #my $left = shift; + #my $right = shift; + return lc($_[1]) cmp lc($_[2]); +} + + +sub get_properties { + my $self = shift; + + ## Get the base class properties and add the properties that we + ## support. + my $props = $self->ProjectCreator::get_properties(); + + ## All projects that use this base class are for Windows. + $$props{'windows'} = 1; + + return $props; +} + + +1; diff --git a/ACE/MPC/modules/WinVersionTranslator.pm b/ACE/MPC/modules/WinVersionTranslator.pm new file mode 100644 index 00000000000..ff82a7d2a3e --- /dev/null +++ b/ACE/MPC/modules/WinVersionTranslator.pm @@ -0,0 +1,69 @@ +package WinVersionTranslator; + +# ************************************************************ +# Description : Translate the version value for Windows. +# Windows can not handle letters in the version +# and truncates anything after \d+\.\d+. We +# will convert letters to numbers, retain +# trailing numbers and everything else will be +# converted to a zero. +# +# ex. 1.4.3 => 1.403 +# 1.4a.5 => 1.4005 +# 1.4b.4 => 1.4104 +# +# Author : Chad Elliott +# Create Date : 10/7/2004 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub translate { + my $version = shift; + + ## See if the version contains something other than numbers followed by + ## a decimal point and numbers. + if ($version =~ /^(\d+\.\d+)([^\d].*)$/) { + $version = $1; + my $post = $2; + my $length = length($post); + + ## Convert the non-conforming value to all numbers + for(my $i = 0; $i < $length; ++$i) { + my $ch = substr($post, $i, 1); + if ($ch =~ /[a-z]/i) { + my $digit = ord(lc($ch)) - ord('a'); + $version .= $digit; + } + elsif ($ch =~ /\d/) { + $version .= $ch; + } + else { + $version .= '0'; + } + } + + ## If we have a good version number we need to make sure that the + ## minor version number does not exceed the value of a short unsigned + ## integer. + if ($version =~ /(\d+)\.(\d+)/) { + my($major, $minor) = ($1, $2); + $minor =~ s/^\d+\.//; + while($minor > 65535) { + $minor = substr($minor, 0, length($minor) - 1); + } + $version = $major . '.' . $minor; + } + } + return $version; +} + +1; diff --git a/ACE/MPC/modules/WinWorkspaceBase.pm b/ACE/MPC/modules/WinWorkspaceBase.pm new file mode 100644 index 00000000000..6ffd56efb40 --- /dev/null +++ b/ACE/MPC/modules/WinWorkspaceBase.pm @@ -0,0 +1,35 @@ +package WinWorkspaceBase; + +# ************************************************************ +# Description : A Windows base module for Workspace Creators +# Author : Chad Elliott +# Create Date : 2/26/2007 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub crlf { + return $_[0]->windows_crlf(); +} + + +sub convert_slashes { + #my $self = shift; + return 1; +} + +sub case_insensitive { + #my $self = shift; + return 1; +} + + +1; diff --git a/ACE/MPC/modules/WixProjectCreator.pm b/ACE/MPC/modules/WixProjectCreator.pm new file mode 100644 index 00000000000..1b349e9711b --- /dev/null +++ b/ACE/MPC/modules/WixProjectCreator.pm @@ -0,0 +1,120 @@ +package WixProjectCreator; + +# ************************************************************ +# Description : A Wix Project Creator +# Author : James H. Hill +# Create Date : 6/23/2009 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; +use ProjectCreator; +use WinProjectBase; +use XMLProjectBase; +use GUID; + +use vars qw(@ISA); +@ISA = qw(XMLProjectBase WinProjectBase ProjectCreator); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub expand_variables_from_template_values { + return 1; +} + +sub warn_useless_project { + return 0; +} + +sub convert_slashes { + return 0; +} + +sub fill_value { + my($self, $name) = @_; + + if ($name eq 'guid') { + ## Return a repeatable GUID for use within the template. The values + ## provided will be hashed and returned in a format expected by Wix. + return GUID::generate($self->project_file_name(), + $self->{'current_input'}, $self->getcwd()); + } + elsif ($name eq 'source_directory') { + my $source; + + if ($self->get_assignment('sharedname')) { + $source = $self->get_assignment('dllout'); + + if ($source eq '') { + $source = $self->get_assignment('libout'); + } + } + elsif ($self->get_assignment('staticname')) { + $source = $self->get_assignment('libout'); + } + else { + $source = $self->get_assignment('exeout'); + } + + ## Check for a variable in the source directory. We have to make + ## sure we transform this correctly for WIX by adding the correct + ## prefix. Otherwise, WIX will complain. + if (defined $source && $source =~ /.*?\$\((.+?)\).*/) { + my $prefix; + my $varname = $1; + + if ($ENV{$varname}) { + $prefix = "env"; + } + else { + $prefix = "var"; + } + + ## Add the correct prefix to the variable. + $source =~ s/$varname/$prefix.$varname/g; + } + + return $source; + } + + return undef; +} + +sub project_file_extension { + return '.wxi'; +} + + +sub get_dll_exe_template_input_file { + #my $self = shift; + return 'wix'; +} + + +sub get_lib_exe_template_input_file { + #my $self = shift; + return 'wix'; +} + + +sub get_lib_template_input_file { + #my $self = shift; + return 'wix'; +} + + +sub get_dll_template_input_file { + #my $self = shift; + return 'wix'; +} + +sub get_template { + return 'wix'; +} + +1; diff --git a/ACE/MPC/modules/WixWorkspaceCreator.pm b/ACE/MPC/modules/WixWorkspaceCreator.pm new file mode 100644 index 00000000000..60f42b39200 --- /dev/null +++ b/ACE/MPC/modules/WixWorkspaceCreator.pm @@ -0,0 +1,81 @@ +package WixWorkspaceCreator; + +# ************************************************************ +# Description : A Wix Workspace creator +# Author : James H. Hill +# Create Date : 6/23/2009 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; +use WixProjectCreator; +use WorkspaceCreator; + +use vars qw(@ISA); +@ISA = qw(WorkspaceCreator); + +# ************************************************************ +# Data Section +# ************************************************************ + + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub workspace_file_extension { + return '.wxs'; +} + +sub workspace_file_name { + my $self = shift; + return $self->get_modified_workspace_name($self->get_workspace_name(), + '.wxi'); +} + +sub pre_workspace { + my($self, $fh) = @_; + my $crlf = $self->crlf(); + my $name = $self->get_workspace_name(); + + ## Begin the project definition for the workspace + print $fh '<?xml version="1.0" encoding="utf-8" standalone="yes"?>', $crlf, + '<Include>', $crlf; +} + +sub write_comps { + my($self, $fh) = @_; + my $crlf = $self->crlf(); + + + # print the target for clean + foreach my $project ($self->sort_dependencies($self->get_projects())) { + print $fh " <?include $project ?>", $crlf; + } +} + +sub post_workspace { + my($self, $fh) = @_; + my $info = $self->get_project_info(); + my $crlf = $self->crlf(); + + # Create a component group consisting of all the projects. + print $fh $crlf, + ' <Fragment>', $crlf, + ' <ComponentGroup Id="', + $self->get_workspace_name(), '">', $crlf; + + foreach my $project ($self->sort_dependencies($self->get_projects())) { + print $fh ' <ComponentRef Id="', + $$info{$project}->[0], '" />', $crlf; + } + + print $fh ' </ComponentGroup>', $crlf, + ' </Fragment>', $crlf, + '</Include>', $crlf; +} + +1; diff --git a/ACE/MPC/modules/WorkspaceCreator.pm b/ACE/MPC/modules/WorkspaceCreator.pm new file mode 100644 index 00000000000..0ac462340f7 --- /dev/null +++ b/ACE/MPC/modules/WorkspaceCreator.pm @@ -0,0 +1,2354 @@ +package WorkspaceCreator; + +# ************************************************************ +# Description : Base class for all workspace creators +# Author : Chad Elliott +# Create Date : 5/13/2002 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; +use FileHandle; +use File::Path; + +use Creator; +use Options; +use WorkspaceHelper; + +use vars qw(@ISA); +@ISA = qw(Creator Options); + +# ************************************************************ +# Data Section +# ************************************************************ + +my $wsext = 'mwc'; +my $wsbase = 'mwb'; + +## Valid names for assignments within a workspace +my %validNames = ('cmdline' => 1, + 'implicit' => 1, + ); + +## Singleton hash maps of project information +my %allprinfo; +my %allprojects; +my %allliblocs; + +## Global previous workspace names +my %previous_workspace_name; + +## Constant aggregated workspace type name +my $aggregated = 'aggregated_workspace'; + +my $onVMS = DirectoryManager::onVMS(); + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub new { + 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) = @_; + my $self = Creator::new($class, $global, $inc, + $template, $ti, $dynamic, $static, + $relative, $addtemp, $addproj, + $progress, $toplevel, $baseprojs, + $feature, $features, + $hierarchy, $nmod, $applypj, + $into, $language, $use_env, $expandvars, + 'workspace'); + + ## These need to be reset at the end of each + ## workspace processed within a .mwc file + $self->{'workspace_name'} = undef; + $self->{'projects'} = []; + $self->{'project_info'} = {}; + $self->{'project_files'} = []; + $self->{'modified_count'} = 0; + $self->{'exclude'} = {}; + $self->{'associated'} = {}; + $self->{'scoped_assign'} = {}; + + ## These are maintained/modified throughout processing + $self->{$self->{'type_check'}} = 0; + $self->{'cacheok'} = 1; + $self->{'lib_locations'} = {}; + $self->{'reading_parent'} = []; + $self->{'global_feature_file'} = $gfeature; + $self->{'relative_file'} = $relative_f; + $self->{'project_file_list'} = {}; + $self->{'ordering_cache'} = {}; + $self->{'handled_scopes'} = {}; + $self->{'scoped_basedir'} = undef; + + ## These are static throughout processing + $self->{'coexistence'} = $self->requires_make_coexistence() ? 1 : $makeco; + $self->{'for_eclipse'} = $foreclipse; + $self->{'generate_dot'} = $gendot; + $self->{'generate_ins'} = $genins; + $self->{'verbose_ordering'} = undef; + $self->{'wctype'} = $self->extractType("$self"); + $self->{'workspace_comments'} = $comments; + + if (defined $$exclude[0]) { + my $type = $self->{'wctype'}; + if (!defined $self->{'exclude'}->{$type}) { + $self->{'exclude'}->{$type} = []; + } + push(@{$self->{'exclude'}->{$type}}, @$exclude); + $self->{'orig_exclude'} = $self->{'exclude'}; + } + else { + $self->{'orig_exclude'} = {}; + } + + ## Add a hash reference for our workspace type + if (!defined $previous_workspace_name{$self->{'wctype'}}) { + $previous_workspace_name{$self->{'wctype'}} = {}; + } + + ## Warn users about unnecessary options + if ($self->get_hierarchy() && $self->workspace_per_project()) { + $self->warning("The -hierarchy option is unnecessary " . + "for the " . $self->{'wctype'} . " type."); + } + if ($self->{'coexistence'} && !$self->supports_make_coexistence()) { + $self->warning("Using the -make_coexistence option has " . + "no effect on the " . $self->{'wctype'} . " type."); + } + return $self; +} + + +sub set_verbose_ordering { + my($self, $value) = @_; + $self->{'verbose_ordering'} = $value; +} + + +sub modify_assignment_value { + ## Workspace assignments do not need modification. + return $_[2]; +} + + +sub parse_line { + my($self, $ih, $line, $flags) = @_; + my($status, $error, @values) = $self->parse_known($line); + + ## Was the line recognized? + if ($status && defined $values[0]) { + if ($values[0] eq $self->{'grammar_type'}) { + my $name = $values[1]; + if (defined $name && $name eq '}') { + if (!defined $self->{'reading_parent'}->[0]) { + ## Fill in all the default values + $self->generate_defaults(); + + ## End of workspace; Have subclass write out the file + ## Generate the project files + my($gstat, $creator, $err) = $self->generate_project_files(); + if ($gstat) { + ($status, $error) = $self->write_workspace($creator, 1); + $self->{'assign'} = {}; + } + else { + $error = $err; + $status = 0; + } + + $self->{'modified_count'} = 0; + $self->{'workspace_name'} = undef; + $self->{'projects'} = []; + $self->{'project_info'} = {}; + $self->{'project_files'} = []; + $self->{'exclude'} = $self->{'orig_exclude'}; + $self->{'associated'} = {}; + $self->{'scoped_assign'} = {}; + } + $self->{$self->{'type_check'}} = 0; + } + else { + ## Workspace Beginning + ## Deal with the inheritance hiearchy first + if (defined $values[2]) { + foreach my $parent (@{$values[2]}) { + ## Read in the parent onto ourself + my $file = $self->search_include_path("$parent.$wsbase"); + if (!defined $file) { + $file = $self->search_include_path("$parent.$wsext"); + } + + if (defined $file) { + push(@{$self->{'reading_parent'}}, 1); + $status = $self->parse_file($file); + pop(@{$self->{'reading_parent'}}); + + $error = "Invalid parent: $parent" if (!$status); + } + else { + $status = 0; + $error = "Unable to locate parent: $parent"; + } + } + } + + ## Set up some initial values + if (defined $name) { + if ($name =~ /[\/\\]/) { + $status = 0; + $error = 'Workspaces can not have a slash ' . + 'or a back slash in the name'; + } + else { + $name =~ s/^\(\s*//; + $name =~ s/\s*\)$//; + + ## Replace any *'s with the default name + if (index($name, '*') >= 0) { + $name = $self->fill_type_name( + $name, + $self->get_default_workspace_name()); + } + + $self->{'workspace_name'} = $name; + } + } + $self->{$self->{'type_check'}} = 1; + } + } + elsif ($values[0] eq '0') { + if (defined $validNames{$values[1]}) { + $self->process_assignment($values[1], $values[2], $flags); + } + else { + $error = "Invalid assignment name: '$values[1]'"; + $status = 0; + } + } + elsif ($values[0] eq '1') { + if (defined $validNames{$values[1]}) { + ## This code only runs when there is a non-scoped assignment. As + ## such, we can safely replace all environment variables here so + ## that they are not incorrectly handled in aggregated + ## workspaces. + $self->replace_env_vars(\$values[2]) if ($values[2] =~ /\$/); + $self->process_assignment_add($values[1], $values[2], $flags); + } + else { + $error = "Invalid addition name: $values[1]"; + $status = 0; + } + } + elsif ($values[0] eq '-1') { + if (defined $validNames{$values[1]}) { + $self->process_assignment_sub($values[1], $values[2], $flags); + } + else { + $error = "Invalid subtraction name: $values[1]"; + $status = 0; + } + } + elsif ($values[0] eq 'component') { + my %copy = %{defined $flags ? $flags : $self->get_assignment_hash()}; + ($status, $error) = $self->parse_scope($ih, + $values[1], + $values[2], + \%validNames, + \%copy); + } + else { + $error = "Unrecognized line: $line"; + $status = 0; + } + } + elsif ($status == -1) { + ## If the line contains a variable, try to replace it with an actual + ## value. + $line = $self->relative($line) if (index($line, '$') >= 0); + + foreach my $expfile ($line =~ /[\?\*\[\]]/ ? $self->mpc_glob($line) : + $line) { + if ($expfile =~ /\.$wsext$/) { + my %copy = %{defined $flags ? $flags : $self->get_assignment_hash()}; + ($status, $error) = $self->aggregated_workspace($expfile, \%copy); + last if (!$status); + } + else { + push(@{$self->{'project_files'}}, $expfile); + $status = 1; + } + } + } + + return $status, $error; +} + + +sub aggregated_workspace { + my($self, $file, $flags) = @_; + my $fh = new FileHandle(); + + if (open($fh, $file)) { + my $oline = $self->get_line_number(); + my $tc = $self->{$self->{'type_check'}}; + my $ag = $self->{'handled_scopes'}->{$aggregated}; + my $psbd = $self->{'scoped_basedir'}; + my($status, $error, @values) = (0, 'No recognizable lines'); + + $self->{'handled_scopes'}->{$aggregated} = undef; + $self->set_line_number(0); + $self->{$self->{'type_check'}} = 0; + $self->{'scoped_basedir'} = $self->mpc_dirname($file); + + ## If the directory name for the file is the current directory, we + ## need to empty it out. If we don't, it will cause the file name to + ## not match up with itself later on where scoped_basedir is used. + $self->{'scoped_basedir'} = undef if ($self->{'scoped_basedir'} eq '.'); + + while(<$fh>) { + my $line = $self->preprocess_line($fh, $_); + ($status, $error, @values) = $self->parse_known($line); + + ## Was the line recognized? + if ($status) { + if (defined $values[0]) { + if ($values[0] eq $self->{'grammar_type'}) { + if (defined $values[2]) { + my $name = $self->mpc_basename($file); + $name =~ s/\.[^\.]+$//; + $status = 0; + $error = 'Aggregated workspace (' . $name . + ') can not inherit from another workspace'; + } + else { + ($status, $error) = $self->parse_scope($fh, + '', + $aggregated, + \%validNames, + $flags); + } + } + else { + $status = 0; + $error = 'Unable to aggregate ' . $file; + } + last; + } + } + else { + last; + } + } + close($fh); + + $self->{'scoped_basedir'} = $psbd; + $self->{'handled_scopes'}->{$aggregated} = $ag; + $self->{$self->{'type_check'}} = $tc; + $self->set_line_number($oline); + + return $status, $error; + } + + return 0, 'Unable to open ' . $file; +} + + +sub parse_scope { + my($self, $fh, $name, $type, $validNames, $flags, $elseflags) = @_; + + if ($type eq $self->get_default_component_name()) { + $type = $self->{'wctype'}; + } + + if ($name eq 'exclude') { + return $self->parse_exclude($fh, $type, $flags); + } + elsif ($name eq 'associate') { + return $self->parse_associate($fh, $type); + } + else { + return $self->SUPER::parse_scope($fh, $name, $type, + $validNames, $flags, $elseflags); + } +} + +sub process_types { + my($self, $typestr) = @_; + my %types; + @types{split(/\s*,\s*/, $typestr)} = (); + + ## If there is a negation at all, add our + ## current type, it may be removed below + if (index($typestr, '!') >= 0) { + $types{$self->{wctype}} = 1; + + ## Process negated exclusions + foreach my $key (keys %types) { + if ($key =~ /^!\s*(\w+)/) { + ## Remove the negated key + delete $types{$key}; + + ## Then delete the key that was negated in the exclusion. + delete $types{$1}; + } + } + } + return \%types; +} + +sub parse_exclude { + my($self, $fh, $typestr, $flags) = @_; + my $status = 0; + my $errorString = 'Unable to process exclude'; + my $negated = (index($typestr, '!') >= 0); + my @exclude; + my $types = $self->process_types($typestr); + my $count = 1; + + if (exists $$types{$self->{wctype}}) { + while(<$fh>) { + my $line = $self->preprocess_line($fh, $_); + + if ($line eq '') { + } + elsif ($line =~ /^}(.*)$/) { + --$count; + if (defined $1 && $1 ne '') { + $status = 0; + $errorString = "Trailing characters found: '$1'"; + } + else { + $status = 1; + $errorString = undef; + } + last if ($count == 0); + } + else { + if ($line =~ /^(\w+)\s*(\([^\)]+\))?\s*{$/) { + ++$count; + } + elsif ($self->parse_assignment($line, [])) { + ## Ignore all assignments + } + else { + if ($line =~ /^"([^"]+)"$/) { + $line = $1; + } + + ## If the line contains a variable, try to replace it with an + ## actual value. + $line = $self->relative($line) if (index($line, '$') >= 0); + + if (defined $self->{'scoped_basedir'} && + $self->path_is_relative($line)) { + $line = $self->{'scoped_basedir'} . '/' . $line; + } + if ($line =~ /[\?\*\[\]]/) { + push(@exclude, $self->mpc_glob($line)); + } + else { + push(@exclude, $line); + } + } + } + } + + foreach my $type (keys %$types) { + if (!defined $self->{'exclude'}->{$type}) { + $self->{'exclude'}->{$type} = []; + } + push(@{$self->{'exclude'}->{$type}}, @exclude); + } + } + else { + if ($negated) { + ($status, $errorString) = $self->SUPER::parse_scope($fh, + 'exclude', + $typestr, + \%validNames, + $flags); + } + else { + ## If this exclude block didn't match the current type and the + ## exclude wasn't negated, we need to eat the exclude block so that + ## these lines don't get included into the workspace. + while(<$fh>) { + my $line = $self->preprocess_line($fh, $_); + + if ($line =~ /^(\w+)\s*(\([^\)]+\))?\s*{$/) { + ++$count; + } + elsif ($line =~ /^}(.*)$/) { + --$count; + if (defined $1 && $1 ne '') { + $status = 0; + $errorString = "Trailing characters found: '$1'"; + } + else { + $status = 1; + $errorString = undef; + } + last if ($count == 0); + } + } + } + } + + return $status, $errorString; +} + + +sub parse_associate { + my($self, $fh, $assoc_key) = @_; + my $status = 0; + my $errorString = 'Unable to process associate'; + my $count = 1; + my @projects; + + if (!defined $self->{'associated'}->{$assoc_key}) { + $self->{'associated'}->{$assoc_key} = {}; + } + + while(<$fh>) { + my $line = $self->preprocess_line($fh, $_); + + if ($line eq '') { + } + elsif ($line =~ /^}(.*)$/) { + --$count; + if (defined $1 && $1 ne '') { + $errorString = "Trailing characters found: '$1'"; + last; + } + else { + $status = 1; + $errorString = undef; + } + last if ($count == 0); + } + else { + if ($line =~ /^(\w+)\s*(\([^\)]+\))?\s*{$/) { + ++$count; + } + elsif ($self->parse_assignment($line, [])) { + $errorString = 'Assignments are not ' . + 'allowed within an associate scope'; + last; + } + else { + if ($line =~ /^"([^"]+)"$/) { + $line = $1; + } + + ## If the line contains a variable, try to replace it with an + ## actual value. + $line = $self->relative($line) if (index($line, '$') >= 0); + + if (defined $self->{'scoped_basedir'} && + $self->path_is_relative($line)) { + $line = $self->{'scoped_basedir'} . '/' . $line; + } + if ($line =~ /[\?\*\[\]]/) { + foreach my $file ($self->mpc_glob($line)) { + $self->{'associated'}->{$assoc_key}->{$file} = 1; + } + } + else { + $self->{'associated'}->{$assoc_key}->{$line} = 1; + } + } + } + } + + return $status, $errorString; +} + + +sub excluded { + my($self, $file) = @_; + + foreach my $excluded (@{$self->{'exclude'}->{$self->{'wctype'}}}) { + return 1 if ($excluded eq $file || index($file, "$excluded/") == 0); + } + + return 0; +} + + +sub handle_scoped_end { + my($self, $type, $flags) = @_; + my $status = 1; + my $error; + + ## Replace instances of $PWD with the current directory plus the + ## scoped_basedir. We have to do it now otherwise, $PWD will be the + ## wrong directory if it's done later. + if (defined $$flags{'cmdline'} && defined $self->{'scoped_basedir'} && + index($$flags{'cmdline'}, '$PWD') >= 0) { + my $dir = $self->getcwd() . '/' . $self->{'scoped_basedir'}; + $$flags{'cmdline'} =~ s/\$PWD(\W)/$dir$1/g; + $$flags{'cmdline'} =~ s/\$PWD$/$dir/; + } + + if ($type eq $aggregated && !defined $self->{'handled_scopes'}->{$type}) { + ## Go back to the previous directory and add the directory contents + ($status, $error) = $self->handle_scoped_unknown(undef, $type, $flags, '.'); + } + + $self->{'handled_scopes'}->{$type} = undef; + return $status, $error; +} + + +sub handle_scoped_unknown { + my($self, $fh, $type, $flags, $line) = @_; + my $status = 1; + my $error; + my $dupchk; + + if ($line =~ /^\w+.*{/) { + if (defined $fh) { + my @values; + my $tc = $self->{$self->{'type_check'}}; + $self->{$self->{'type_check'}} = 1; + ($status, $error, @values) = $self->parse_line($fh, $line, $flags); + $self->{$self->{'type_check'}} = $tc; + } + else { + $status = 0; + $error = 'Unhandled line: ' . $line; + } + return $status, $error; + } + + ## If the line contains a variable, try to replace it with an actual + ## value. + $line = $self->relative($line) if (index($line, '$') >= 0); + + if (defined $self->{'scoped_basedir'}) { + if ($self->path_is_relative($line)) { + $line = $self->{'scoped_basedir'} . ($line ne '.' ? "/$line" : ''); + } + } + + ## We must build up the list of project files and use them as the + ## keys in the duplicate hash check. We need to call + ## search_for_files() because the user may have just listed + ## directories in the workspace and we need to deal with mpc files. + my @files; + $self->search_for_files($self->{'project_files'}, \@files); + my %dup; + @dup{@files} = (); + $dupchk = \%dup; + + ## If the aggregated workspace contains a scope (other than exclude) + ## it will be processed in the block above and we will eventually get + ## here, but by that time $type will no longer be $aggregated. So, + ## we just need to set it here to ensure that we don't add everything + ## in the scoped_basedir directory in handle_scoped_end() + $self->{'handled_scopes'}->{$aggregated} = 1; + + if (-d $line) { + my @files; + $self->search_for_files([ $line ], \@files, $$flags{'implicit'}); + + ## If we are generating implicit projects within a scope, then + ## we need to remove directories and the parent directories for which + ## there is an mpc file. Otherwise, the projects will be added + ## twice. + if ($$flags{'implicit'}) { + my %remove; + foreach my $file (@files) { + if ($file =~ /\.mpc$/) { + my $exc = $file; + do { + $exc = $self->mpc_dirname($exc); + $remove{$exc} = 1; + } while($exc ne '.' && $exc !~ /[a-z]:[\/\\]/i); + } + } + + my @acceptable; + foreach my $file (@files) { + push(@acceptable, $file) if (!defined $remove{$file}); + } + @files = @acceptable; + } + + foreach my $file (@files) { + if (!$self->excluded($file)) { + if (defined $dupchk && exists $$dupchk{$file}) { + $self->information("Duplicate mpc file ($file) added by an " . + 'aggregate workspace. It will be ignored.'); + } + else { + $self->{'scoped_assign'}->{$file} = $flags; + push(@{$self->{'project_files'}}, $file); + } + } + } + } + else { + foreach my $expfile ($line =~ /[\?\*\[\]]/ ? $self->mpc_glob($line) : + $line) { + if ($expfile =~ /\.$wsext$/) { + ## An aggregated workspace within an aggregated workspace or scope. + ($status, $error) = $self->aggregated_workspace($expfile, $flags); + last if (!$status); + } + else { + if (!$self->excluded($expfile)) { + if (defined $dupchk && exists $$dupchk{$expfile}) { + $self->information("Duplicate mpc file ($expfile) added by an " . + 'aggregate workspace. It will be ignored.'); + } + else { + $self->{'scoped_assign'}->{$expfile} = $flags; + push(@{$self->{'project_files'}}, $expfile); + } + } + } + } + } + $self->{'handled_scopes'}->{$type} = 1; + + return $status, $error; +} + + +sub search_for_files { + my($self, $files, $array, $impl) = @_; + my $excluded = 0; + + foreach my $file (@$files) { + if (-d $file) { + my @f = $self->generate_default_file_list( + $file, + $self->{'exclude'}->{$self->{'wctype'}}, + \$excluded); + $self->search_for_files(\@f, $array, $impl); + if ($impl) { + $file =~ s/^\.\///; + + # Strip out ^ symbols + $file =~ s/\^//g if ($onVMS); + + unshift(@$array, $file); + } + } + elsif ($file =~ /\.mpc$/) { + $file =~ s/^\.\///; + + # Strip out ^ symbols + $file =~ s/\^//g if ($onVMS); + + unshift(@$array, $file); + } + } + + return $excluded; +} + + +sub remove_duplicate_projects { + my($self, $list) = @_; + my $count = scalar(@$list); + + for(my $i = 0; $i < $count; ++$i) { + my $file = $$list[$i]; + foreach my $inner (@$list) { + if ($file ne $inner && + $file eq $self->mpc_dirname($inner) && ! -d $inner) { + splice(@$list, $i, 1); + --$count; + --$i; + last; + } + } + } +} + + +sub generate_default_components { + my($self, $files, $impl, $excluded) = @_; + my $pjf = $self->{'project_files'}; + + if (defined $$pjf[0]) { + ## If we have files, then process directories + my @built; + foreach my $file (@$pjf) { + if (!$self->excluded($file)) { + if (-d $file) { + my @found; + my @gen = $self->generate_default_file_list( + $file, + $self->{'exclude'}->{$self->{'wctype'}}); + $self->search_for_files(\@gen, \@found, $impl); + push(@built, @found); + if ($impl || $self->{'scoped_assign'}->{$file}->{'implicit'}) { + push(@built, $file); + } + } + else { + push(@built, $file); + } + } + } + + ## If the workspace is set to implicit remove duplicates from this + ## list. + $self->remove_duplicate_projects(\@built) if ($impl); + + ## Set the project files + $self->{'project_files'} = \@built; + } + else { + ## Add all of the wanted files in this directory + ## and in the subdirectories. + $excluded |= $self->search_for_files($files, $pjf, $impl); + + ## If the workspace is set to implicit remove duplicates from this + ## list. + $self->remove_duplicate_projects($pjf) if ($impl); + + ## If no files were found, then we push the empty + ## string, so the Project Creator will generate + ## the default project file. + push(@$pjf, '') if (!defined $$pjf[0] && !$excluded); + } +} + + +sub get_default_workspace_name { + my $self = shift; + my $name = $self->{'current_input'}; + + if ($name eq '') { + $name = $self->base_directory(); + } + else { + ## Since files on UNIX can have back slashes, we transform them + ## into underscores. + $name =~ s/\\/_/g; + + ## Take off the extension + $name =~ s/\.[^\.]+$//; + } + + return $name; +} + + +sub generate_defaults { + my $self = shift; + + ## Generate default workspace name + if (!defined $self->{'workspace_name'}) { + $self->{'workspace_name'} = $self->get_default_workspace_name(); + } + + ## Modify the exclude list if we have changed directory from the original + ## starting directory. Just take off the difference from the front. + my @original; + my $top = $self->getcwd() . '/'; + my $start = $self->getstartdir() . '/'; + + if ($start ne $top && $top =~ s/^$start//) { + foreach my $exclude (@{$self->{'exclude'}->{$self->{'wctype'}}}) { + push(@original, $exclude); + $exclude =~ s/^$top//; + } + } + + my $excluded = 0; + my @files = $self->generate_default_file_list( + '.', + $self->{'exclude'}->{$self->{'wctype'}}, + \$excluded); + + ## Generate default components + $self->generate_default_components(\@files, + $self->get_assignment('implicit'), + $excluded); + + ## Return the actual exclude list of we modified it + if (defined $original[0]) { + $self->{'exclude'}->{$self->{'wctype'}} = \@original; + } +} + + +sub get_workspace_name { + return $_[0]->{'workspace_name'}; +} + + +sub get_current_output_name { + return $_[0]->{'current_output'}; +} + + +sub write_and_compare_file { + my($self, $outdir, $oname, $func, @params) = @_; + my $fh = new FileHandle(); + my $error = undef; + + ## Set the output directory if one wasn't provided + $outdir = $self->get_outdir() if (!defined $outdir); + + ## Create the full name and pull off the directory. The directory + ## portion may not be the same as $outdir, since $name could possibly + ## contain a directory portion too. + my $name = "$outdir/$oname"; + my $dir = $self->mpc_dirname($name); + + ## Make the full path if necessary + mkpath($dir, 0, 0777) if ($dir ne '.'); + + ## Set the current output data member to our file's full name + $self->{'current_output'} = $name; + + if ($self->compare_output()) { + ## First write the output to a temporary file + my $tmp = "$outdir/MWC$>.$$"; + my $different = 1; + if (open($fh, ">$tmp")) { + &$func($self, $fh, @params); + close($fh); + + $different = 0 if (!$self->files_are_different($name, $tmp)); + } + else { + $error = "Unable to open $tmp for output."; + } + + if (!defined $error) { + if ($different) { + unlink($name); + $error = "Unable to open $name for output" if (!rename($tmp, $name)); + } + else { + ## There is no need to rename, so remove our temp file. + unlink($tmp); + } + } + } + else { + if (open($fh, ">$name")) { + &$func($self, $fh, @params); + close($fh); + } + else { + $error = "Unable to open $name for output."; + } + } + + return $error; +} + +sub write_workspace { + my($self, $creator, $addfile) = @_; + my $status = 1; + my $error; + my $duplicates = 0; + + if ($self->get_toplevel()) { + ## There is usually a progress indicator callback provided, but if + ## the output is being redirected, there will be no progress + ## indicator. + my $progress = $self->get_progress_callback(); + &$progress() if (defined $progress); + + if ($addfile) { + ## To be consistent across multiple project types, we disallow + ## duplicate project names for all types, not just VC6. + ## Note that these name are handled case-insensitive by VC6 + my %names; + foreach my $project (@{$self->{'projects'}}) { + my $name = lc($self->{'project_info'}->{$project}->[0]); + if (defined $names{$name}) { + ++$duplicates; + $self->error("Duplicate case-insensitive project '$name'. " . + "Look in " . $self->mpc_dirname($project) . + " and " . $self->mpc_dirname($names{$name}) . + " for project name conflicts."); + } + else { + $names{$name} = $project; + } + } + } + else { + $self->{'per_project_workspace_name'} = 1; + } + + my $name = $self->transform_file_name($self->workspace_file_name()); + + my $abort_creation = 0; + if ($duplicates > 0) { + $abort_creation = 1; + $error = "Duplicate case-insensitive project names are " . + "not allowed within a workspace."; + $status = 0; + } + else { + if (!defined $self->{'projects'}->[0]) { + $self->information('No projects were created.'); + $abort_creation = 1; + } + } + + if (!$abort_creation) { + ## Verify and possibly modify the dependencies + if ($addfile) { + $self->verify_build_ordering(); + } + + if ($addfile || !$self->file_written($name)) { + $error = $self->write_and_compare_file( + undef, $name, + sub { + my($self, $fh) = @_; + $self->pre_workspace($fh, $creator, $addfile); + $self->write_comps($fh, $creator, $addfile); + + my $wsHelper = WorkspaceHelper::get($self); + $wsHelper->perform_custom_processing($fh, $creator, $addfile); + + $self->post_workspace($fh, $creator, $addfile); + }); + if (defined $error) { + $status = 0; + } + else { + $self->add_file_written($name) if ($addfile); + } + } + + my $additional = $self->get_additional_output(); + foreach my $entry (@$additional) { + $error = $self->write_and_compare_file(@$entry); + if (defined $error) { + $status = 0; + last; + } + } + + if ($addfile && $self->{'generate_dot'}) { + my $dh = new FileHandle(); + my $wsname = $self->get_workspace_name(); + if (open($dh, ">$wsname.dot")) { + my %targnum; + my @list = $self->number_target_deps($self->{'projects'}, + $self->{'project_info'}, + \%targnum, 0); + print $dh "digraph $wsname {\n"; + foreach my $project (@{$self->{'projects'}}) { + if (defined $targnum{$project}) { + my $pname = $self->{'project_info'}->{$project}->[0]; + foreach my $number (@{$targnum{$project}}) { + print $dh " $pname -> ", + "$self->{'project_info'}->{$list[$number]}->[0];\n"; + } + } + } + print $dh "}\n"; + close($dh); + } + else { + $self->warning("Unable to write to $wsname.dot."); + } + } + } + + $self->{'per_project_workspace_name'} = undef if (!$addfile); + } + + return $status, $error; +} + + +sub save_project_info { + my($self, $gen, $gpi, $gll, $dir, $projects, $pi, $ll) = @_; + my $c = 0; + + ## For each file written + foreach my $pj (@$gen) { + ## Save the full path to the project file in the array + my $full = ($dir ne '.' ? "$dir/" : '') . $pj; + push(@$projects, $full); + + ## Get the corresponding generated project info and save it + ## in the hash map keyed on the full project file name + $$pi{$full} = $$gpi[$c]; + $c++; + } + + foreach my $key (keys %$gll) { + $$ll{$key} = $$gll{$key}; + } +} + + +sub topname { + my($self, $file) = @_; + my $dir = '.'; + my $rest = $file; + if ($file =~ /^([^\/\\]+)[\/\\](.*)/) { + $dir = $1; + $rest = $2; + } + return $dir, $rest; +} + + +sub generate_hierarchy { + my($self, $creator, $origproj, $originfo) = @_; + my $current; + my @saved; + my %sinfo; + my $cwd = $self->getcwd(); + + ## Make a copy of these. We will be modifying them. + ## It is necessary to sort the projects to get the correct ordering. + ## Projects in the current directory must come before projects in + ## other directories. + my @projects = sort { return $self->sort_projects_by_directory($a, $b) + 0; + } @{$origproj}; + my %projinfo = %{$originfo}; + + foreach my $prj (@projects) { + my($top, $rest) = $self->topname($prj); + + if (!defined $current) { + $current = $top; + push(@saved, $rest); + $sinfo{$rest} = $projinfo{$prj}; + } + elsif ($top ne $current) { + if ($current ne '.') { + ## Write out the hierachical workspace + $self->cd($current); + $self->generate_hierarchy($creator, \@saved, \%sinfo); + + $self->{'projects'} = \@saved; + $self->{'project_info'} = \%sinfo; + $self->{'workspace_name'} = $self->base_directory(); + + my($status, $error) = $self->write_workspace($creator); + $self->error($error) if (!$status); + + $self->cd($cwd); + } + + ## Start the next one + $current = $top; + @saved = ($rest); + %sinfo = (); + $sinfo{$rest} = $projinfo{$prj}; + } + else { + push(@saved, $rest); + $sinfo{$rest} = $projinfo{$prj}; + } + } + if (defined $current && $current ne '.') { + $self->cd($current); + $self->generate_hierarchy($creator, \@saved, \%sinfo); + + $self->{'projects'} = \@saved; + $self->{'project_info'} = \%sinfo; + $self->{'workspace_name'} = $self->base_directory(); + + my($status, $error) = $self->write_workspace($creator); + $self->error($error) if (!$status); + + $self->cd($cwd); + } +} + + +sub generate_project_files { + my $self = shift; + my $status = (scalar @{$self->{'project_files'}} == 0 ? 1 : 0); + my @projects; + my %pi; + my %liblocs; + my $creator = $self->project_creator(); + my $cwd = $self->getcwd(); + my $impl = $self->get_assignment('implicit'); + my $postkey = $creator->get_dynamic() . + $creator->get_static() . "-$self"; + my $previmpl = $impl; + my $prevcache = $self->{'cacheok'}; + my %gstate = $creator->save_state(); + my $genimpdep = $self->generate_implicit_project_dependencies(); + + ## Save this project creator setting for later use in the + ## number_target_deps() method. + $self->{'dependency_is_filename'} = $creator->dependency_is_filename(); + + ## Remove the address portion of the $self string + $postkey =~ s/=.*//; + + ## Set the source file callback on our project creator + $creator->set_source_listing_callback([\&source_listing_callback, $self]); + + foreach my $ofile (@{$self->{'project_files'}}) { + if (!$self->excluded($ofile)) { + my $file = $ofile; + my $dir = $self->mpc_dirname($file); + my $restore = 0; + + if (defined $self->{'scoped_assign'}->{$ofile}) { + ## Handle the implicit assignment + my $oi = $self->{'scoped_assign'}->{$ofile}->{'implicit'}; + if (defined $oi) { + $previmpl = $impl; + $impl = $oi; + } + + ## Handle the cmdline assignment + my $cmdline = $self->{'scoped_assign'}->{$ofile}->{'cmdline'}; + if (defined $cmdline && $cmdline ne '') { + ## Save the cacheok value + $prevcache = $self->{'cacheok'}; + + ## Get the current parameters and process the command line + my %parameters = $self->current_parameters(); + $self->process_cmdline($cmdline, \%parameters); + + ## Set the parameters on the creator + $creator->restore_state(\%parameters); + $restore = 1; + } + } + + ## If we are generating implicit projects and the file is a + ## directory, then we set the dir to the file and empty the file + if ($impl && -d $file) { + $dir = $file; + $file = ''; + + ## If the implicit assignment value was not a number, then + ## we will add this value to our base projects. + if ($impl !~ /^\d+$/) { + my $bps = $creator->get_baseprojs(); + push(@$bps, split(/\s+/, $impl)); + $restore = 1; + $self->{'cacheok'} = 0; + } + } + + ## Generate the key for this project file + my $prkey = $self->getcwd() . '/' . + ($file eq '' ? $dir : $file) . "-$postkey"; + + ## We must change to the subdirectory for + ## which this project file is intended + if ($self->cd($dir)) { + my $files_written = []; + my $gen_proj_info = []; + my $gen_lib_locs = {}; + if ($self->{'cacheok'} && defined $allprojects{$prkey}) { + $files_written = $allprojects{$prkey}; + $gen_proj_info = $allprinfo{$prkey}; + $gen_lib_locs = $allliblocs{$prkey}; + $status = 1; + } + else { + $status = $creator->generate($self->mpc_basename($file)); + + ## If any one project file fails, then stop + ## processing altogether. + if (!$status) { + ## We don't restore the state before we leave, + ## but that's ok since we will be exiting right now. + return $status, $creator, + "Unable to process " . ($file eq '' ? " in $dir" : $file); + } + + ## Get the individual project information and + ## generated file name(s) + $files_written = $creator->get_files_written(); + $gen_proj_info = $creator->get_project_info(); + $gen_lib_locs = $creator->get_lib_locations(); + + if ($self->{'cacheok'}) { + $allprojects{$prkey} = $files_written; + $allprinfo{$prkey} = $gen_proj_info; + $allliblocs{$prkey} = $gen_lib_locs; + } + } + $self->cd($cwd); + $self->save_project_info($files_written, $gen_proj_info, + $gen_lib_locs, $dir, + \@projects, \%pi, \%liblocs); + } + else { + ## Unable to change to the directory. + ## We don't restore the state before we leave, + ## but that's ok since we will be exiting soon. + return 0, $creator, "Unable to change directory to $dir"; + } + + ## Return things to the way they were + $impl = $previmpl if (defined $self->{'scoped_assign'}->{$ofile}); + if ($restore) { + $self->{'cacheok'} = $prevcache; + $creator->restore_state(\%gstate); + } + } + else { + ## This one was excluded, so status is ok + $status = 1; + } + } + + ## Add implict project dependencies based on source files + ## that have been used by multiple projects. If we do it here + ## before we call generate_hierarchy(), we don't have to call it + ## in generate_hierarchy() for each workspace. + $self->{'projects'} = \@projects; + $self->{'project_info'} = \%pi; + if ($status && $genimpdep) { + $self->add_implicit_project_dependencies($creator, $cwd); + } + + ## If we are generating the hierarchical workspaces, then do so + $self->{'lib_locations'} = \%liblocs; + if ($self->get_hierarchy() || $self->workspace_per_project()) { + my $orig = $self->{'workspace_name'}; + $self->generate_hierarchy($creator, \@projects, \%pi); + $self->{'workspace_name'} = $orig; + } + + ## Reset the projects and project_info + $self->{'projects'} = \@projects; + $self->{'project_info'} = \%pi; + + return $status, $creator; +} + + +sub array_contains { + my($self, $left, $right) = @_; + my %check; + + ## Initialize the hash keys with the left side array + @check{@$left} = (); + + ## Check each element on the right against the left. + foreach my $r (@$right) { + return 1 if (exists $check{$r}); + } + + return 0; +} + + +sub non_intersection { + my($self, $left, $right, $over) = @_; + my $status = 0; + my %check; + + ## Initialize the hash keys with the left side array + @check{@$left} = (); + + ## Check each element on the right against the left. + ## Store anything that isn't in the left side in the over array. + foreach my $r (@$right) { + if (exists $check{$r}) { + $status = 1; + } + else { + push(@$over, $r); + } + } + return $status; +} + + +sub indirect_dependency { + my($self, $dir, $ccheck, $cfile) = @_; + + $self->{'indirect_checked'}->{$ccheck} = 1; + if (index($self->{'project_info'}->{$ccheck}->[1], $cfile) >= 0) { + return 1; + } + else { + my $deps = $self->create_array( + $self->{'project_info'}->{$ccheck}->[1]); + foreach my $dep (@$deps) { + if (defined $self->{'project_info'}->{"$dir$dep"} && + !defined $self->{'indirect_checked'}->{"$dir$dep"} && + $self->indirect_dependency($dir, "$dir$dep", $cfile)) { + return 1; + } + } + } + + return 0; +} + + +sub add_implicit_project_dependencies { + my($self, $creator, $cwd) = @_; + my %bidir; + my %save; + + ## Take the current working directory and regular expression'ize it. + $cwd = $self->escape_regex_special($cwd); + + ## Look at each projects file list and check it against all of the + ## others. If any of the other projects file lists contains anothers + ## file, then they are dependent (due to build parallelism). So, we + ## append the dependency and remove the file in question from the + ## project so that the next time around the foreach, we don't find it + ## as a dependent on the one that we just modified. + my @pflkeys = keys %{$self->{'project_file_list'}}; + foreach my $key (@pflkeys) { + foreach my $ikey (@pflkeys) { + ## Not the same project and + ## The same directory and + ## We've not already added a dependency to this project + if ($key ne $ikey && + ($self->{'project_file_list'}->{$key}->[1] eq + $self->{'project_file_list'}->{$ikey}->[1]) && + (!defined $bidir{$ikey} || + !$self->array_contains($bidir{$ikey}, [$key]))) { + my @over; + if ($self->non_intersection( + $self->{'project_file_list'}->{$key}->[2], + $self->{'project_file_list'}->{$ikey}->[2], + \@over)) { + ## The project contains shared source files, so we need to + ## look into adding an implicit inter-project dependency. + $save{$ikey} = $self->{'project_file_list'}->{$ikey}->[2]; + $self->{'project_file_list'}->{$ikey}->[2] = \@over; + if (defined $bidir{$key}) { + push(@{$bidir{$key}}, $ikey); + } + else { + $bidir{$key} = [$ikey]; + } + my $append = $creator->translate_value('after', $key); + my $file = $self->{'project_file_list'}->{$ikey}->[0]; + my $dir = $self->{'project_file_list'}->{$ikey}->[1]; + my $cfile = $creator->translate_value('after', $ikey); + ## Remove our starting directory from the projects directory + ## to get the right part of the directory to prepend. + $dir =~ s/^$cwd[\/\\]*//; + + ## Turn the append value into a key for 'project_info' and + ## prepend the directory to the file. + my $ccheck = $append; + $ccheck =~ s/"//g; + if ($dir ne '') { + $dir .= '/'; + $ccheck = "$dir$ccheck"; + $file = "$dir$file"; + } + + ## If the append value key contains a reference to the project + ## that we were going to append the dependency value, then + ## ignore the generated dependency. It is redundant and + ## quite possibly wrong. + $self->{'indirect_checked'} = {}; + if (defined $self->{'project_info'}->{$file} && + (!defined $self->{'project_info'}->{$ccheck} || + !$self->indirect_dependency($dir, $ccheck, $cfile))) { + ## Append the dependency + $self->{'project_info'}->{$file}->[1] .= " $append"; + } + } + } + } + } + + ## Restore the modified values in case this method is called again + ## which is the case when using the -hierarchy option. + foreach my $skey (keys %save) { + $self->{'project_file_list'}->{$skey}->[2] = $save{$skey}; + } +} + + +sub get_projects { + return $_[0]->{'projects'}; +} + + +sub get_project_info { + return $_[0]->{'project_info'}; +} + + +sub get_lib_locations { + return $_[0]->{'lib_locations'}; +} + + +sub get_first_level_directory { + my($self, $file) = @_; + + if (($file =~ tr/\///) > 0) { + my $dir = $file; + $dir =~ s/^([^\/]+\/).*/$1/; + $dir =~ s/\/+$//; + return $dir; + } + + return '.'; +} + + +sub get_associated_projects { + return $_[0]->{'associated'}; +} + + +sub sort_within_group { + my($self, $list, $start, $end) = @_; + my $deps; + my %seen; + my $ccount = 0; + my $cmax = ($end - $start) + 1; + my $previ = -1; + my $prevpjs = []; + my $movepjs = []; + + ## Put the projects in the order specified + ## by the project dpendencies. + for(my $i = $start; $i <= $end; ++$i) { + ## If our moved project equals our previously moved project then + ## we count this as a possible circular dependency. + my $key = "@$list"; + if ($seen{$key} || + (defined $$movepjs[0] && defined $$prevpjs[0] && + $$movepjs[0] == $$prevpjs[0] && $$movepjs[1] == $$prevpjs[1])) { + ++$ccount; + } + else { + $ccount = 0; + } + + ## Detect circular dependencies + if ($ccount > $cmax) { + my @prjs; + foreach my $mvgr (@$movepjs) { + push(@prjs, $$list[$mvgr]); + } + my $other = $$movepjs[0] - 1; + if ($other < $start || $other == $$movepjs[1] || !defined $$list[$other]) { + $other = undef; + } + $self->warning('Circular dependency detected while processing the ' . + ($self->{'current_input'} eq '' ? + 'default' : $self->{'current_input'}) . + ' workspace. ' . + 'The following projects are involved: ' . + (defined $other ? "$$list[$other], " : '') . + join(' and ', @prjs)); + return; + } + + ## Keep track of the previous project movement + $seen{$key} = 1; + $prevpjs = $movepjs; + $movepjs = [] if ($previ < $i); + $previ = $i; + + $deps = $self->get_validated_ordering($$list[$i]); + if (defined $$deps[0]) { + my $baseproj = ($self->{'dependency_is_filename'} ? + $self->mpc_basename($$list[$i]) : + $self->{'project_info'}->{$$list[$i]}->[0]); + my $moved = 0; + foreach my $dep (@$deps) { + if ($baseproj ne $dep) { + ## See if the dependency is listed after this project + for(my $j = $i + 1; $j <= $end; ++$j) { + my $ldep = ($self->{'dependency_is_filename'} ? + $self->mpc_basename($$list[$j]) : + $self->{'project_info'}->{$$list[$j]}->[0]); + if ($ldep eq $dep) { + $movepjs = [$i, $j]; + ## If so, move it in front of the current project. + ## The original code, which had splices, didn't always + ## work correctly (especially on AIX for some reason). + my $save = $$list[$j]; + for(my $k = $j; $k > $i; --$k) { + $$list[$k] = $$list[$k - 1]; + } + $$list[$i] = $save; + + ## Mark that an entry has been moved + $moved = 1; + $j--; + } + } + } + } + --$i if ($moved); + } + } +} + + +sub build_dependency_chain { + my($self, $name, $len, $list, $ni, $glen, $groups, $map, $gdeps) = @_; + my $deps = $self->get_validated_ordering($name); + + if (defined $$deps[0]) { + foreach my $dep (@$deps) { + ## Find the item in the list that matches our current dependency + my $mapped = $$map{$dep}; + if (defined $mapped) { + for(my $i = 0; $i < $len; $i++) { + if ($$list[$i] eq $mapped) { + + ## Locate the group number to which the dependency belongs + for(my $j = 0; $j < $glen; $j++) { + if ($i >= $$groups[$j]->[0] && $i <= $$groups[$j]->[1]) { + + if ($j != $ni) { + ## Add every project in the group to the dependency chain + for(my $k = $$groups[$j]->[0]; $k <= $$groups[$j]->[1]; $k++) { + my $ldep = $self->mpc_basename($$list[$k]); + if (!exists $$gdeps{$ldep}) { + $$gdeps{$ldep} = 1; + $self->build_dependency_chain($$list[$k], + $len, $list, $j, + $glen, $groups, + $map, $gdeps); + } + } + } + last; + } + } + last; + } + } + } + + $$gdeps{$dep} = 1; + } + } +} + + +sub sort_by_groups { + my($self, $list, $grindex) = @_; + my @groups = @$grindex; + my $llen = scalar(@$list); + + ## Check for duplicates first before we attempt to sort the groups. + ## If there is a duplicate, we quietly return immediately. The + ## duplicates will be flagged as an error when creating the main + ## workspace. + my %dupcheck; + foreach my $proj (@$list) { + my $base = $self->mpc_basename($proj); + return undef if (defined $dupcheck{$base}); + $dupcheck{$base} = $proj; + } + + my %circular_checked; + for(my $gi = 0; $gi <= $#groups; ++$gi) { + ## Detect circular dependencies + if (!$circular_checked{$gi}) { + $circular_checked{$gi} = 1; + for(my $i = $groups[$gi]->[0]; $i <= $groups[$gi]->[1]; ++$i) { + my %gdeps; + $self->build_dependency_chain($$list[$i], $llen, $list, $gi, + $#groups + 1, \@groups, + \%dupcheck, \%gdeps); + if (exists $gdeps{$self->mpc_basename($$list[$i])}) { + ## There was a cirular dependency, get all of the directories + ## involved. + my %dirs; + foreach my $gdep (keys %gdeps) { + $dirs{$self->mpc_dirname($dupcheck{$gdep})} = 1; + } + + ## If the current directory was involved, translate that into + ## a directory relative to the start directory. + if (defined $dirs{'.'}) { + my $cwd = $self->getcwd(); + my $start = $self->getstartdir(); + if ($cwd ne $start) { + my $startre = $self->escape_regex_special($start); + delete $dirs{'.'}; + $cwd =~ s/^$startre[\\\/]//; + $dirs{$cwd} = 1; + } + } + + ## Display a warining to the user + my @keys = sort keys %dirs; + $self->warning('Circular directory dependency detected in the ' . + ($self->{'current_input'} eq '' ? + 'default' : $self->{'current_input'}) . + ' workspace. ' . + 'The following director' . + ($#keys == 0 ? 'y is' : 'ies are') . + ' involved: ' . join(', ', @keys)); + return; + } + } + } + + ## Build up the group dependencies + my %gdeps; + for(my $i = $groups[$gi]->[0]; $i <= $groups[$gi]->[1]; ++$i) { + my $deps = $self->get_validated_ordering($$list[$i]); + @gdeps{@$deps} = () if (defined $$deps[0]); + } + + ## Search the rest of the groups for any of the group dependencies + for(my $gj = $gi + 1; $gj <= $#groups; ++$gj) { + for(my $i = $groups[$gj]->[0]; $i <= $groups[$gj]->[1]; ++$i) { + if (exists $gdeps{$self->mpc_basename($$list[$i])}) { + ## Move this group ($gj) in front of the current group ($gi) + my @save; + for(my $j = $groups[$gi]->[1] + 1; $j <= $groups[$gj]->[1]; ++$j) { + push(@save, $$list[$j]); + } + my $offset = $groups[$gj]->[1] - $groups[$gi]->[1]; + for(my $j = $groups[$gi]->[1]; $j >= $groups[$gi]->[0]; --$j) { + $$list[$j + $offset] = $$list[$j]; + } + for(my $j = 0; $j <= $#save; ++$j) { + $$list[$groups[$gi]->[0] + $j] = $save[$j]; + } + + ## Update the group indices + my $shiftamt = ($groups[$gi]->[1] - $groups[$gi]->[0]) + 1; + for(my $j = $gi + 1; $j <= $gj; ++$j) { + $groups[$j]->[0] -= $shiftamt; + $groups[$j]->[1] -= $shiftamt; + } + my @grsave = @{$groups[$gi]}; + $grsave[0] += $offset; + $grsave[1] += $offset; + for(my $j = $gi; $j < $gj; ++$j) { + $groups[$j] = $groups[$j + 1]; + $circular_checked{$j} = $circular_checked{$j + 1}; + } + $groups[$gj] = \@grsave; + $circular_checked{$gj} = 1; + + ## Start over from the first group + $gi = -1; + + ## Exit from the outter ($gj) loop + $gj = $#groups; + last; + } + } + } + } +} + + +sub sort_dependencies { + my($self, $projects, $groups) = @_; + my @list = sort { return $self->sort_projects_by_directory($a, $b) + 0; + } @$projects; + ## The list above is sorted by directory in order to keep projects + ## within the same directory together. Otherwise, when groups are + ## created we may get multiple groups for the same directory. + + ## Put the projects in the order specified + ## by the project dpendencies. We only need to do + ## this if there is more than one element in the array. + if ($#list > 0) { + ## If the parameter wasn't passed in or it was passed in + ## and was true, sort with directory groups in mind + if (!defined $groups || $groups) { + ## First determine the individual groups + my @grindex; + my $previous = [0, undef]; + for(my $li = 0; $li <= $#list; ++$li) { + my $dir = $self->get_first_level_directory($list[$li]); + if (!defined $previous->[1]) { + $previous = [$li, $dir]; + } + elsif ($previous->[1] ne $dir) { + push(@grindex, [$previous->[0], $li - 1]); + $previous = [$li, $dir]; + } + } + push(@grindex, [$previous->[0], $#list]); + + ## Next, sort the individual groups + foreach my $gr (@grindex) { + $self->sort_within_group(\@list, @$gr) if ($$gr[0] != $$gr[1]); + } + + ## Now sort the groups as single entities + $self->sort_by_groups(\@list, \@grindex) if ($#grindex > 0); + } + else { + $self->sort_within_group(\@list, 0, $#list); + } + } + + return @list; +} + + +sub number_target_deps { + my($self, $projects, $pjs, $targets, $groups) = @_; + my @list = $self->sort_dependencies($projects, $groups); + + ## This block of code must be done after the list of dependencies + ## has been sorted in order to get the correct project numbers. + for(my $i = 0; $i <= $#list; ++$i) { + my $project = $list[$i]; + if (defined $$pjs{$project}) { + my($name, $deps) = @{$$pjs{$project}}; + if (defined $deps && $deps ne '') { + my @numbers; + my %dhash; + @dhash{@{$self->create_array($deps)}} = (); + + ## For each dependency, search in the sorted list + ## up to the point of this project for the projects + ## that this one depends on. When the project is + ## found, we put the target number in the numbers array. + for(my $j = 0; $j < $i; ++$j) { + ## If the dependency is a filename, then take the basename of + ## the project file. Otherwise, get the project name based on + ## the project file from the "project_info". + my $key = ($self->{'dependency_is_filename'} ? + $self->mpc_basename($list[$j]) : + $self->{'project_info'}->{$list[$j]}->[0]); + push(@numbers, $j) if (exists $dhash{$key}); + } + + ## Store the array in the hash keyed on the project file. + $$targets{$project} = \@numbers if (defined $numbers[0]); + } + } + } + + return @list; +} + + +sub project_target_translation { + my($self, $case) = @_; + my %map; + + ## Translate project names to avoid target collision with + ## some versions of make. + foreach my $key (keys %{$self->{'project_info'}}) { + my $dir = $self->mpc_dirname($key); + my $name = $self->{'project_info'}->{$key}->[0]; + + ## We want to compare to the upper most directory. This will be the + ## one that may conflict with the project name. + $dir =~ s/[\/\\].*//; + if (($case && $dir eq $name) || (!$case && lc($dir) eq lc($name))) { + $map{$key} = "$name-target"; + } + else { + $map{$key} = $name; + } + } + return \%map; +} + + +sub optionError { + my($self, $str) = @_; + $self->warning("$self->{'current_input'}: $str.") if (defined $str); +} + + +sub process_cmdline { + my($self, $cmdline, $parameters) = @_; + + ## It's ok to use the cache + $self->{'cacheok'} = 1; + + if (defined $cmdline && $cmdline ne '') { + my $args = $self->create_array($cmdline); + + ## Look for environment variables + foreach my $arg (@$args) { + $self->replace_env_vars(\$arg) if ($arg =~ /\$/); + } + + my $options = $self->options('MWC', {}, 0, @$args); + if (defined $options) { + foreach my $key (keys %$options) { + my $type = $self->is_set($key, $options); + + if (!defined $type) { + ## This option was not used, so we ignore it + } + elsif ($type eq 'ARRAY') { + push(@{$parameters->{$key}}, @{$options->{$key}}); + } + elsif ($type eq 'HASH') { + foreach my $hk (keys %{$options->{$key}}) { + $parameters->{$key}->{$hk} = $options->{$key}->{$hk}; + } + } + elsif ($type eq 'SCALAR') { + $parameters->{$key} = $options->{$key}; + } + } + + ## Some option data members are named consistently with the MPC + ## option name. In this case, we can use this foreach loop. + foreach my $consistent_opt ('exclude', 'for_eclipse', 'gendot', + 'gfeature_file', 'into', + 'make_coexistence', 'recurse') { + ## Issue warnings for the options provided by the user + if ($self->is_set($consistent_opt, $options)) { + $self->optionError("-$consistent_opt is ignored"); + } + } + + ## For those that are inconsistent, we have special code to deal + ## with them. + if ($self->is_set('reldefs', $options)) { + $self->optionError('-noreldefs is ignored'); + } + + ## Make sure no input files were specified (we can't handle it). + if (defined $options->{'input'}->[0]) { + $self->optionError('Command line files ' . + 'specified in a workspace are ignored'); + } + + ## Determine if it's ok to use the cache + my @cacheInvalidating = ('global', 'include', 'baseprojs', + 'template', 'ti', 'relative', 'language', + 'addtemp', 'addproj', 'feature_file', + 'features', 'use_env', 'expand_vars'); + foreach my $key (@cacheInvalidating) { + if ($self->is_set($key, $options)) { + $self->{'cacheok'} = 0; + last; + } + } + } + } +} + + +sub current_parameters { + my $self = shift; + my %parameters = $self->save_state(); + + ## We always want the project creator to generate a toplevel + $parameters{'toplevel'} = 1; + return %parameters; +} + + +sub project_creator { + my $self = shift; + my $str = "$self"; + + ## NOTE: If the subclassed WorkspaceCreator name prefix does not + ## match the name prefix of the ProjectCreator, this code + ## will not work and the subclassed WorkspaceCreator will + ## need to override this method. + + $str =~ s/Workspace/Project/; + $str =~ s/=HASH.*//; + + ## Set up values for each project creator + ## If we have command line arguments in the workspace, then + ## we process them before creating the project creator + my $cmdline = $self->get_assignment('cmdline'); + my %parameters = $self->current_parameters(); + $self->process_cmdline($cmdline, \%parameters); + + ## Create the new project creator with the updated parameters + return $str->new($parameters{'global'}, + $parameters{'include'}, + $parameters{'template'}, + $parameters{'ti'}, + $parameters{'dynamic'}, + $parameters{'static'}, + $parameters{'relative'}, + $parameters{'addtemp'}, + $parameters{'addproj'}, + $parameters{'progress'}, + $parameters{'toplevel'}, + $parameters{'baseprojs'}, + $self->{'global_feature_file'}, + $parameters{'relative_file'}, + $parameters{'feature_file'}, + $parameters{'features'}, + $parameters{'hierarchy'}, + $self->{'exclude'}->{$self->{'wctype'}}, + $self->make_coexistence(), + $parameters{'name_modifier'}, + $parameters{'apply_project'}, + $self->{'generate_ins'} || $parameters{'genins'}, + $self->get_into(), + $parameters{'language'}, + $parameters{'use_env'}, + $parameters{'expand_vars'}, + $self->{'gendot'}, + $parameters{'comments'}, + $self->{'for_eclipse'}); +} + + +sub sort_files { + #my $self = shift; + return 0; +} + + +sub make_coexistence { + return $_[0]->{'coexistence'}; +} + + +sub get_modified_workspace_name { + my($self, $name, $ext, $nows) = @_; + my $nmod = $self->get_name_modifier(); + my $oname = $name; + + if (defined $nmod) { + $nmod =~ s/\*/$name/g; + $name = $nmod; + } + + ## If this is a per project workspace, then we should not + ## modify the workspace name. It may overwrite another workspace + ## but that's ok, it will only be a per project workspace. + ## Also, if we don't want the workspace name attached ($nows) then + ## we just return the name plus the extension. + return "$name$ext" if ($nows || $self->{'per_project_workspace_name'}); + + my $pwd = $self->getcwd(); + my $type = $self->{'wctype'}; + my $wsname = $self->get_workspace_name(); + + if (!defined $previous_workspace_name{$type}->{$pwd}) { + $previous_workspace_name{$type}->{$pwd} = $wsname; + $self->{'current_workspace_name'} = undef; + } + else { + my $prefix = ($oname eq $wsname ? $name : "$name.$wsname"); + $previous_workspace_name{$type}->{$pwd} = $wsname; + while($self->file_written("$prefix" . + ($self->{'modified_count'} > 0 ? + ".$self->{'modified_count'}" : '') . + "$ext")) { + ++$self->{'modified_count'}; + } + $self->{'current_workspace_name'} = + "$prefix" . ($self->{'modified_count'} > 0 ? + ".$self->{'modified_count'}" : '') . "$ext"; + } + + return (defined $self->{'current_workspace_name'} ? + $self->{'current_workspace_name'} : "$name$ext"); +} + + +sub generate_recursive_input_list { + my($self, $dir, $exclude) = @_; + return $self->extension_recursive_input_list($dir, $exclude, $wsext); +} + + +sub verify_build_ordering { + my $self = shift; + foreach my $project (@{$self->{'projects'}}) { + $self->get_validated_ordering($project); + } +} + + +sub get_validated_ordering { + my($self, $project) = @_; + my $deps; + + if (defined $self->{'ordering_cache'}->{$project}) { + $deps = $self->{'ordering_cache'}->{$project}; + } + else { + $deps = []; + if (defined $self->{'project_info'}->{$project}) { + my($name, $dstr) = @{$self->{'project_info'}->{$project}}; + if (defined $dstr && $dstr ne '') { + $deps = $self->create_array($dstr); + my $dlen = scalar(@$deps); + for(my $i = 0; $i < $dlen; $i++) { + my $dep = $$deps[$i]; + my $found = 0; + ## Avoid circular dependencies + if ($dep ne $name && $dep ne $self->mpc_basename($project)) { + foreach my $p (@{$self->{'projects'}}) { + if ($dep eq $self->{'project_info'}->{$p}->[0] || + $dep eq $self->mpc_basename($p)) { + $found = 1; + last; + } + } + if (!$found) { + if ($self->{'verbose_ordering'}) { + $self->warning("'$name' references '$dep' which has " . + "not been processed."); + } + splice(@$deps, $i, 1); + --$dlen; + --$i; + } + } + else { + ## If a project references itself, we must remove it + ## from the list of dependencies. + splice(@$deps, $i, 1); + --$dlen; + --$i; + } + } + } + + $self->{'ordering_cache'}->{$project} = $deps; + } + } + + return $deps; +} + + +sub source_listing_callback { + my($self, $project_file, $project_name, $list) = @_; + $self->{'project_file_list'}->{$project_name} = [ $project_file, + $self->getcwd(), $list ]; +} + + +sub sort_projects_by_directory { + my($self, $left, $right) = @_; + my $sa = index($left, '/'); + my $sb = index($right, '/'); + + if ($sa >= 0 && $sb == -1) { + return 1; + } + elsif ($sb >= 0 && $sa == -1) { + return -1; + } + return $left cmp $right; +} + + +sub get_relative_dep_file { + my($self, $creator, $project, $dep) = @_; + + ## If the dependency is a filename, we have to find the key that + ## matches the project file. + if ($creator->dependency_is_filename()) { + foreach my $key (keys %{$self->{'project_file_list'}}) { + if ($self->{'project_file_list'}->{$key}->[0] eq $dep) { + $dep = $key; + last; + } + } + } + + if (defined $self->{'project_file_list'}->{$dep}) { + my $base = $self->{'project_file_list'}->{$dep}->[1]; + my @dirs = grep(!/^$/, split('/', $base)); + my $last = -1; + $project =~ s/^\///; + for(my $i = 0; $i <= $#dirs; $i++) { + my $dir = $dirs[$i]; + if ($project =~ s/^$dir\///) { + $last = $i; + } + else { + last; + } + } + + my $dependee = $self->{'project_file_list'}->{$dep}->[0]; + if ($last == -1) { + return $base . '/' . $dependee; + } + else { + my $built = ''; + for(my $i = $last + 1; $i <= $#dirs; $i++) { + $built .= $dirs[$i] . '/'; + } + $built .= $dependee; + my $dircount = ($project =~ tr/\///); + return ('../' x $dircount) . $built; + } + } + return undef; +} + + +sub create_command_line_string { + my $self = shift; + my @args = @_; + my $str; + + foreach my $arg (@args) { + $arg =~ s/^\-\-/-/; + if ($arg =~ /\$/ && $^O ne 'MSWin32') { + ## If we're not running on Windows and the command line argument + ## contains a dollar sign, we need to wrap the argument in single + ## quotes so that the UNIX shell does not interpret it. + $arg = "'$arg'"; + } + else { + ## Unfortunately, the Windows command line shell does not + ## understand single quotes correctly. So, we have the distinction + ## above and handle dollar signs here too. + $arg = "\"$arg\"" if ($arg =~ /[\s\*\$]/); + } + if (defined $str) { + $str .= " $arg"; + } + else { + $str = $arg; + } + } + return $str; +} + + +sub print_workspace_comment { + my $self = shift; + my $fh = shift; + + if ($self->{'workspace_comments'}) { + foreach my $line (@_) { + print $fh $line; + } + } +} + + +sub get_initial_relative_values { + my $self = shift; + return $self->get_relative(), $self->get_expand_vars(); +} + + +sub get_secondary_relative_values { + return \%ENV, $_[0]->get_expand_vars(); +} + + +sub convert_all_variables { + #my $self = shift; + return 1; +} + + +sub workspace_file_name { + my $self = shift; + return $self->get_modified_workspace_name($self->get_workspace_name(), + $self->workspace_file_extension()); +} + + +sub relative { + my $self = shift; + my $line = $self->SUPER::relative(shift); + $line =~ s/\\/\//g; + return $line; +} + +# ************************************************************ +# Virtual Methods To Be Overridden +# ************************************************************ + +sub requires_make_coexistence { + #my $self = shift; + return 0; +} + + +sub supports_make_coexistence { + #my $self = shift; + return 0; +} + + +sub generate_implicit_project_dependencies { + #my $self = shift; + return 0; +} + + +sub workspace_file_extension { + #my $self = shift; + return ''; +} + + +sub workspace_per_project { + #my $self = shift; + return 0; +} + + +sub pre_workspace { + #my $self = shift; + #my $fh = shift; + #my $creator = shift; + #my $top = shift; +} + + +sub write_comps { + #my $self = shift; + #my $fh = shift; + #my $creator = shift; + #my $top = shift; +} + + +sub post_workspace { + #my $self = shift; + #my $fh = shift; + #my $creator = shift; + #my $top = shift; +} + +sub requires_forward_slashes { + #my $self = shift; + return 0; +} + +sub get_additional_output { + #my $self = shift; + + ## This method should return an array reference of array references. + ## For each entry, the array should be laid out as follows: + ## [ <directory or undef to use the current output directory>, + ## <file name>, + ## <function to write body of file, $self and $fh are first params>, + ## <optional additional parameter 1>, + ## ..., + ## <optional additional parameter N> + ## ] + return []; +} + +1; diff --git a/ACE/MPC/modules/WorkspaceHelper.pm b/ACE/MPC/modules/WorkspaceHelper.pm new file mode 100644 index 00000000000..58ff37efdd5 --- /dev/null +++ b/ACE/MPC/modules/WorkspaceHelper.pm @@ -0,0 +1,88 @@ +package WorkspaceHelper; + +# ************************************************************ +# Description : Base class and factory for all workspace helpers +# Author : Chad Elliott +# Create Date : 9/01/2004 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +# ************************************************************ +# Data Section +# ************************************************************ + +my %required; + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub get { + my $type = shift; + + ## Create the helper name + $type =~ s/Creator/Helper/; + $type =~ s/=HASH.*//; + + ## If we can find a helper with this name, we will + ## create a singleton of that type and return it. + if (!$required{$type}) { + foreach my $inc (@INC) { + if (-r "$inc/$type.pm") { + require "$type.pm"; + $required{$type} = $type->new(); + last; + } + } + + ## If we can't find the helper, we just create an + ## empty helper and return that. + $required{$type} = new WorkspaceHelper() if (!$required{$type}); + } + + return $required{$type}; +} + + +sub new { + my $class = shift; + return bless {}, $class; +} + + +sub modify_value { + my($self, $name, $value) = @_; + return $value; +} + + +sub modify_libpath { + #my $self = shift; + #my $str = shift; + #my $reldir = shift; + #my $libname = shift; + return undef; +} + + +sub write_settings { + #my $self = shift; + #my $fh = shift; + #my @locals = @_; + return 1, undef; +} + + +sub perform_custom_processing { + #my $self = shift; + #my $fh = shift; + #my $creator = shift; + #my $toplevel = shift; +} + +1; diff --git a/ACE/MPC/modules/XMLProjectBase.pm b/ACE/MPC/modules/XMLProjectBase.pm new file mode 100644 index 00000000000..355c76055bd --- /dev/null +++ b/ACE/MPC/modules/XMLProjectBase.pm @@ -0,0 +1,49 @@ +package XMLProjectBase; + +# ************************************************************ +# Description : An XML base module for Project Creators +# Author : Chad Elliott +# Create Date : 1/30/2006 +# ************************************************************ + +# ************************************************************ +# Pragmas +# ************************************************************ + +use strict; + +# ************************************************************ +# Subroutine Section +# ************************************************************ + +sub get_quote_symbol { + #my $self = shift; + return '"'; +} + + +sub get_escaped_quote_symbol { + #my $self = shift; + return '\\"'; +} + + +sub get_gt_symbol { + #my $self = shift; + return '>'; +} + + +sub get_lt_symbol { + #my $self = shift; + return '<'; +} + + +sub get_and_symbol { + #my $self = shift; + return '&&'; +} + + +1; |