diff options
Diffstat (limited to 'ACE/MPC/create_base.pl')
| -rwxr-xr-x | ACE/MPC/create_base.pl | 199 |
1 files changed, 199 insertions, 0 deletions
diff --git a/ACE/MPC/create_base.pl b/ACE/MPC/create_base.pl new file mode 100755 index 00000000000..1788fa629b8 --- /dev/null +++ b/ACE/MPC/create_base.pl @@ -0,0 +1,199 @@ +#! /usr/bin/perl +eval '(exit $?0)' && eval 'exec perl -w -S $0 ${1+"$@"}' + & eval 'exec perl -w -S $0 $argv:q' + if 0; + +# ****************************************************************** +# Author: Chad Elliott +# Date: 9/13/2007 +# $Id$ +# Description: Generate a base project based on a library project +# ****************************************************************** + +# ****************************************************************** +# Pragma Section +# ****************************************************************** + +use strict; +use FindBin; +use FileHandle; +use File::Spec; +use File::Basename; + +my $basePath = $FindBin::Bin; +if ($^O eq 'VMS') { + $basePath = File::Spec->rel2abs(dirname($0)) if ($basePath eq ''); + $basePath = VMS::Filespec::unixify($basePath); +} +unshift(@INC, $basePath . '/modules'); + +require Creator; + +# ****************************************************************** +# Data Section +# ****************************************************************** + +my $version = '0.1'; + +# ****************************************************************** +# Subroutine Section +# ****************************************************************** + +sub gather_info { + my $name = shift; + my $fh = new FileHandle(); + + if (open($fh, $name)) { + my @lines = (); + my $pname = undef; + while(<$fh>) { + ## Get the line a remove leading and trailing white space + my $line = $_; + $line =~ s/^\s+//; + $line =~ s/\s+$//; + + ## Look for the project declaration and pull out the name and any + ## parents. + if ($line =~ /^project\s*(\(([^\)]+)\))?\s*(:.+)?\s*{$/) { + $pname = $2; + my $parents = $3 || ''; + + ## Create the default project name by removing the extension and + ## converting back-slashes, spaces and dashes to underscores. + ## This needs to be done regardless of whether the project name + ## was provided or not since it's used below in the + ## fill_type_name call. + my $def = basename($name); + $def =~ s/\.[^\.]+$//; + $def =~ s/\\/_/g; + $def =~ s/[\s\-]/_/g; + + if (!defined $pname || $pname eq '') { + ## Take the default project name since one wasn't provided. + $pname = $def; + } + else { + ## Convert back-slashes, spaces and dashes to underscores. + $pname =~ s/\\/_/g; + $pname =~ s/[\s\-]/_/g; + } + + ## If the project has a '*' we need to have MPC fix that up for + ## us. + $pname = Creator::fill_type_name(undef, $pname, $def); + push(@lines, "project$parents {"); + } + elsif ($line =~ /^(shared|static)name\s*=\s*(.+)$/) { + ## Add in the libs and after settings. + my $lib = $2; + if (defined $pname && $lib ne '') { + push(@lines, " libs += $2", + " after += $pname", + "}"); + } + last; + } + } + close($fh); + + ## Only return the lines if there is more than one line. It is + ## possible (and likely) that we've read in the project declaration, + ## but the project did not contain a sharedname or staticname + ## setting. + return @lines if ($#lines > 0); + } + + return (); +} + +sub write_base { + my($in, $out) = @_; + my @lines = gather_info($in); + + if ($#lines >= 0) { + if (-r $out) { + print STDERR "ERROR: $out already exists\n"; + } + else { + my $fh = new FileHandle(); + if (open($fh, ">$out")) { + foreach my $line (@lines) { + print $fh "$line\n"; + } + close($fh); + + ## Everything was ok, return zero. + return 0; + } + else { + print STDERR "ERROR: Unable to write to $out\n"; + } + } + } + else { + if (-r $in) { + print STDERR "ERROR: $in is not a valid MPC file\n"; + } + else { + print STDERR "ERROR: Unable to read from $in\n"; + } + } + + ## Non-zero indicates an error (as in the shell $? value). + return 1; +} + +sub usageAndExit { + my $str = shift; + print STDERR "$str\n" if (defined $str); + print STDERR "Create Base Project v$version\n", + "Usage: ", basename($0), " <mpc files> <output file or ", + "directory>\n\nThis script will create a base project ", + "based on the contents of the\nsupplied MPC file. ", + "This is only useful if the project ", + "explictly sets\nsharedname or staticname.\n"; + exit(0); +} + +# ****************************************************************** +# Main Section +# ****************************************************************** + +if ($#ARGV > 1) { + ## Get the last argument and make sure it's a directory. + my $dir = pop(@ARGV); + if (!-d $dir) { + usageAndExit("Creating multiple base projects, but the " . + "last argument, $dir, is not a directory"); + } + + ## Process each input file and create the base project with an implicit + ## base project file name. + my $status = 0; + foreach my $input (@ARGV) { + my $output = $dir . '/' . lc(basename($input)); + $output =~ s/mpc$/mpb/; + $status += write_base($input, $output); + } + exit($status); +} +else { + my $input = shift; + my $output = shift; + + ## Print the usage and exit if there is no input, output or the input + ## file looks like an option. + usageAndExit() if (!defined $output || + !defined $input || index($input, '-') == 0); + + ## If the output file is a directory, we will create the output file + ## name based on the input file. + if (-d $output) { + $output .= '/' . lc(basename($input)); + $output =~ s/mpc$/mpb/; + } + + ## Create the base project and return the status to the caller of the + ## script. + exit(write_base($input, $output)); +} |