summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorelliott_c <ocielliottc@users.noreply.github.com>2008-06-17 17:15:26 +0000
committerelliott_c <ocielliottc@users.noreply.github.com>2008-06-17 17:15:26 +0000
commit1cde0c244a5bbe5a88390b327f5da3eae47909bb (patch)
tree311b150f6dfa06c7f34ece13f68435ea93105ff7
parent821e676d9ff0c53f73f99ed68bd0113bd3c62add (diff)
downloadMPC-1cde0c244a5bbe5a88390b327f5da3eae47909bb.tar.gz
ChangeLogTag: Tue Jun 17 17:16:07 UTC 2008 Chad Elliott <elliott_c@ociweb.com>
Diffstat
-rw-r--r--ChangeLog39
-rwxr-xr-xcombine_dsw.pl26
-rwxr-xr-xcreate_base.pl6
-rwxr-xr-xdepgen.pl4
-rw-r--r--docs/templates/make.txt1
-rwxr-xr-xgenerate_export_header.pl15
-rw-r--r--modules/ConfigParser.pm30
-rw-r--r--modules/Creator.pm419
-rw-r--r--modules/DirectoryManager.pm32
-rw-r--r--modules/Driver.pm237
-rw-r--r--modules/FeatureParser.pm24
-rw-r--r--modules/GUID.pm18
-rw-r--r--modules/MakeWorkspaceBase.pm51
-rw-r--r--modules/Options.pm176
-rw-r--r--modules/OutputMessage.pm48
-rw-r--r--modules/Parser.pm49
-rw-r--r--modules/ProjectCreator.pm1230
-rw-r--r--modules/StringProcessor.pm23
-rw-r--r--modules/TemplateInputReader.pm37
-rw-r--r--modules/TemplateParser.pm674
-rw-r--r--modules/VCProjectBase.pm2
-rw-r--r--modules/Version.pm6
-rw-r--r--modules/WinProjectBase.pm19
-rw-r--r--modules/WinWorkspaceBase.pm3
-rw-r--r--modules/WorkspaceCreator.pm554
-rw-r--r--modules/WorkspaceHelper.pm13
-rwxr-xr-xmpc.pl4
-rwxr-xr-xmwc.pl4
-rwxr-xr-xprj_install.pl135
-rwxr-xr-xregistry.pl56
30 files changed, 1809 insertions, 2126 deletions
diff --git a/ChangeLog b/ChangeLog
index 3c065ecd..c04ef5c7 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,42 @@
+Tue Jun 17 17:16:07 UTC 2008 Chad Elliott <elliott_c@ociweb.com>
+
+ * docs/templates/make.txt:
+
+ Document the 'depgen_flags' template variable.
+
+ * combine_dsw.pl:
+ * create_base.pl:
+ * depgen.pl:
+ * generate_export_header.pl:
+ * mpc.pl:
+ * mwc.pl:
+ * prj_install.pl:
+ * registry.pl:
+ * modules/ConfigParser.pm:
+ * modules/Creator.pm:
+ * modules/DirectoryManager.pm:
+ * modules/Driver.pm:
+ * modules/FeatureParser.pm:
+ * modules/GUID.pm:
+ * modules/MakeWorkspaceBase.pm:
+ * modules/Options.pm:
+ * modules/OutputMessage.pm:
+ * modules/Parser.pm:
+ * modules/ProjectCreator.pm:
+ * modules/StringProcessor.pm:
+ * modules/TemplateInputReader.pm:
+ * modules/TemplateParser.pm:
+ * modules/VCProjectBase.pm:
+ * modules/Version.pm:
+ * modules/WinProjectBase.pm:
+ * modules/WinWorkspaceBase.pm:
+ * modules/WorkspaceCreator.pm:
+ * modules/WorkspaceHelper.pm:
+
+ Removed unnecessary parenthesis around variable declarations.
+ This provides a very minor performance increase due to reduced
+ perl op codes.
+
Tue Jun 10 14:45:18 UTC 2008 Adam Mitz <mitza@ociweb.com>
* templates/make.mpd:
diff --git a/combine_dsw.pl b/combine_dsw.pl
index 43a2dc67..70308b3e 100755
--- a/combine_dsw.pl
+++ b/combine_dsw.pl
@@ -21,14 +21,14 @@ use File::Basename;
# Data Section
# ******************************************************************
-my($version) = '1.3';
+my $version = '1.3';
# ******************************************************************
# Subroutine Section
# ******************************************************************
sub usageAndExit {
- my($str) = shift;
+ my $str = shift;
if (defined $str) {
print STDERR "$str\n";
}
@@ -52,12 +52,12 @@ sub usageAndExit {
# Main Section
# ******************************************************************
-my($output) = undef;
-my($unlink) = undef;
-my(@input) = ();
+my $output;
+my $unlink;
+my @input;
for(my $i = 0; $i <= $#ARGV; $i++) {
- my($arg) = $ARGV[$i];
+ my $arg = $ARGV[$i];
if ($arg =~ /^-/) {
if ($arg eq '-u') {
$unlink = 1;
@@ -80,18 +80,18 @@ if (!defined $output || !defined $input[0]) {
usageAndExit();
}
-my($tmp) = "$output.tmp";
-my($oh) = new FileHandle();
+my $tmp = "$output.tmp";
+my $oh = new FileHandle();
if (open($oh, ">$tmp")) {
- my($msident) = 0;
+ my $msident = 0;
for(my $i = 0; $i <= $#input; ++$i) {
- my($input) = $input[$i];
- my($fh) = new FileHandle();
- my($global) = ($i == $#input);
+ my $input = $input[$i];
+ my $fh = new FileHandle();
+ my $global = ($i == $#input);
if (open($fh, $input)) {
- my($in_global) = 0;
+ my $in_global = 0;
while(<$fh>) {
if (/Microsoft\s+(Developer\s+Studio|eMbedded\s+Visual)/) {
if ($msident == 0) {
diff --git a/create_base.pl b/create_base.pl
index d26022c1..33774c7b 100755
--- a/create_base.pl
+++ b/create_base.pl
@@ -19,7 +19,7 @@ use FileHandle;
use File::Spec;
use File::Basename;
-my($basePath) = $FindBin::Bin;
+my $basePath = $FindBin::Bin;
if ($^O eq 'VMS') {
$basePath = File::Spec->rel2abs(dirname($0)) if ($basePath eq '');
$basePath = VMS::Filespec::unixify($basePath);
@@ -32,7 +32,7 @@ require Creator;
# Data Section
# ******************************************************************
-my($version) = '0.1';
+my $version = '0.1';
# ******************************************************************
# Subroutine Section
@@ -40,7 +40,7 @@ my($version) = '0.1';
sub gather_info {
my $name = shift;
- my $fh = new FileHandle();
+ my $fh = new FileHandle();
if (open($fh, $name)) {
my @lines = ();
diff --git a/depgen.pl b/depgen.pl
index e357ad82..335c93c2 100755
--- a/depgen.pl
+++ b/depgen.pl
@@ -18,7 +18,7 @@ use FindBin;
use File::Spec;
use File::Basename;
-my($basePath) = $FindBin::Bin;
+my $basePath = $FindBin::Bin;
if ($^O eq 'VMS') {
$basePath = File::Spec->rel2abs(dirname($0)) if ($basePath eq '');
$basePath = VMS::Filespec::unixify($basePath);
@@ -31,5 +31,5 @@ require Driver;
# Main Section
# ************************************************************
-my($driver) = new Driver();
+my $driver = new Driver();
exit($driver->run(\@ARGV));
diff --git a/docs/templates/make.txt b/docs/templates/make.txt
index 80880b79..87b7627c 100644
--- a/docs/templates/make.txt
+++ b/docs/templates/make.txt
@@ -21,6 +21,7 @@ cxx = Holds the C/C++ compiler.
cxxint = This is Green Hills specific and specifies the type of integration.
delete = A utility to delete a file.
depgen = A utility to generate make dependencies.
+depgen_flags = Flags to be passed to the dependency generator utility.
devnull = The null device for a particular platform.
dld = The linker to create dynamic libraries.
dmclink = Used by the dmc compiler, this determines if the dmc special mode of linking is used.
diff --git a/generate_export_header.pl b/generate_export_header.pl
index 9c331112..9582e0ce 100755
--- a/generate_export_header.pl
+++ b/generate_export_header.pl
@@ -21,17 +21,16 @@ use File::Basename;
# Data Section
# ******************************************************************
-my($version) = '1.2';
+my $version = '1.2';
# ******************************************************************
# Subroutine Section
# ******************************************************************
sub generate_export_header {
- my($name) = shift;
- my($output) = shift;
- my($fh) = new FileHandle();
- my($status) = 0;
+ my($name, $output) = @_;
+ my $fh = new FileHandle();
+ my $status = 0;
if (open($fh, ">$output")) {
$name = uc($name);
@@ -88,7 +87,7 @@ EOM
}
sub usageAndExit {
- my($str) = shift;
+ my $str = shift;
if (defined $str) {
print STDERR "$str\n";
}
@@ -101,8 +100,8 @@ sub usageAndExit {
# Main Section
# ******************************************************************
-my($name) = shift;
-my($output) = shift;
+my $name = shift;
+my $output = shift;
if (!defined $name) {
usageAndExit();
diff --git a/modules/ConfigParser.pm b/modules/ConfigParser.pm
index a6003521..4b4303b9 100644
--- a/modules/ConfigParser.pm
+++ b/modules/ConfigParser.pm
@@ -22,9 +22,8 @@ use vars qw(@ISA);
# ************************************************************
sub new {
- my($class) = shift;
- my($valid) = shift;
- my($self) = $class->SUPER::new();
+ my($class, $valid) = @_;
+ my $self = $class->SUPER::new();
## Set the values associative array
$self->{'values'} = {};
@@ -36,17 +35,15 @@ sub new {
sub parse_line {
- my($self) = shift;
- my($if) = shift;
- my($line) = shift;
- my($status) = 1;
- my($error) = undef;
+ my($self, $if, $line) = @_;
+ my $status = 1;
+ my $error;
if ($line eq '') {
}
elsif ($line =~ /^([^=]+)\s*=\s*(.*)$/) {
- my($name) = $1;
- my($value) = $2;
+ my $name = $1;
+ my $value = $2;
$name =~ s/\s+$//;
## Pre-process the name and value
@@ -76,26 +73,23 @@ sub parse_line {
sub get_names {
- my($self) = shift;
- my(@names) = keys %{$self->{'values'}};
+ my @names = keys %{$_[0]->{'values'}};
return \@names;
}
sub get_value {
- my($self) = shift;
- my($tag) = shift;
+ my($self, $tag) = @_;
return $self->{'values'}->{$tag} || $self->{'values'}->{lc($tag)};
}
sub preprocess {
- my($self) = shift;
- my($str) = shift;
+ my($self, $str) = @_;
while($str =~ /\$([\(\w\)]+)/) {
- my($name) = $1;
+ my $name = $1;
$name =~ s/[\(\)]//g;
- my($val) = $ENV{$name};
+ my $val = $ENV{$name};
if (!defined $val) {
$val = '';
if (!defined $self->{'warned'}->{$name}) {
diff --git a/modules/Creator.pm b/modules/Creator.pm
index c8bc2619..ea5a2fa1 100644
--- a/modules/Creator.pm
+++ b/modules/Creator.pm
@@ -23,51 +23,29 @@ use vars qw(@ISA);
# Data Section
# ************************************************************
-my($assign_key) = 'assign';
-my($gassign_key) = 'global_assign';
-my(%non_convert) = ('prebuild' => 1,
- 'postbuild' => 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();
+my $assign_key = 'assign';
+my $gassign_key = 'global_assign';
+my %non_convert = ('prebuild' => 1,
+ 'postbuild' => 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) = shift;
- my($global) = shift;
- my($inc) = shift;
- my($template) = shift;
- my($ti) = shift;
- my($dynamic) = shift;
- my($static) = shift;
- my($relative) = shift;
- my($addtemp) = shift;
- my($addproj) = shift;
- my($progress) = shift;
- my($toplevel) = shift;
- my($baseprojs) = shift;
- my($feature) = shift;
- my($features) = shift;
- my($hierarchy) = shift;
- my($nmodifier) = shift;
- my($applypj) = shift;
- my($into) = shift;
- my($language) = shift;
- my($use_env) = shift;
- my($expandvars) = shift;
- my($type) = shift;
- my($self) = Parser::new($class, $inc);
+ 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;
@@ -107,14 +85,12 @@ sub new {
sub preprocess_line {
- my($self) = shift;
- my($fh) = shift;
- my($line) = shift;
+ my($self, $fh, $line) = @_;
$line = $self->strip_line($line);
while ($line =~ /\\$/) {
$line =~ s/\s*\\$/ /;
- my($next) = $fh->getline();
+ my $next = $fh->getline();
if (defined $next) {
$line .= $self->strip_line($next);
}
@@ -124,7 +100,7 @@ sub preprocess_line {
sub generate_default_input {
- my($self) = shift;
+ my $self = shift;
my($status,
$error) = $self->parse_line(undef, "$self->{'grammar_type'} {");
@@ -144,7 +120,7 @@ sub parse_file {
my($self, $input) = @_;
## Save the last line number so we can put it back later
- my($oline) = $self->get_line_number();
+ my $oline = $self->get_line_number();
## Read the input file
my($status, $errorString) = $self->read_file($input);
@@ -168,9 +144,8 @@ sub parse_file {
sub generate {
- my($self) = shift;
- my($input) = shift;
- my($status) = 1;
+ my($self, $input) = @_;
+ my $status = 1;
## Reset the files_written hash array between processing each file
$self->{'files_written'} = {};
@@ -204,12 +179,11 @@ sub generate {
sub parse_known {
- my($self) = shift;
- my($line) = shift;
- my($status) = 1;
- my($errorString) = undef;
- my($type) = $self->{'grammar_type'};
- my(@values) = ();
+ 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
@@ -221,8 +195,8 @@ sub parse_known {
if ($line eq '') {
}
elsif ($line =~ /^$type\s*(\([^\)]+\))?\s*(:.*)?\s*{$/) {
- my($name) = $1;
- my($parents) = $2;
+ my $name = $1;
+ my $parents = $2;
if ($self->{$self->{'type_check'}}) {
$errorString = "Did not find the end of the $type";
$status = 0;
@@ -231,7 +205,7 @@ sub parse_known {
if (defined $parents) {
$parents =~ s/^:\s*//;
$parents =~ s/\s+$//;
- my(@parents) = split(/\s*,\s*/, $parents);
+ my @parents = split(/\s*,\s*/, $parents);
if (!defined $parents[0]) {
## The : was used, but no parents followed. This
## is an error.
@@ -253,15 +227,15 @@ sub parse_known {
}
}
elsif ($line =~ /^(feature)\s*\(([^\)]+)\)\s*(:.*)?\s*{$/) {
- my($type) = $1;
- my($name) = $2;
- my($parents) = $3;
- my(@names) = split(/\s*,\s*/, $name);
+ 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);
+ my @parents = split(/\s*,\s*/, $parents);
if (!defined $parents[0]) {
## The : was used, but no parents followed. This
## is an error.
@@ -280,8 +254,8 @@ sub parse_known {
## If this returns true, then we've found an assignment
}
elsif ($line =~ /^(\w+)\s*(\([^\)]+\))?\s*{$/) {
- my($comp) = lc($1);
- my($name) = $2;
+ my $comp = lc($1);
+ my $name = $2;
if (defined $name) {
$name =~ s/^\(\s*//;
@@ -302,22 +276,16 @@ sub parse_known {
sub parse_scope {
- my($self) = shift;
- my($fh) = shift;
- my($name) = shift;
- my($type) = shift;
- my($validNames) = shift;
- my($flags) = shift;
- my($elseflags) = shift;
- my($status) = 0;
- my($errorString) = "Unable to process $name";
+ my($self, $fh, $name, $type, $validNames, $flags, $elseflags) = @_;
+ my $status = 0;
+ my $errorString = "Unable to process $name";
if (!defined $flags) {
$flags = {};
}
while(<$fh>) {
- my($line) = $self->preprocess_line($fh, $_);
+ my $line = $self->preprocess_line($fh, $_);
if ($line eq '') {
}
@@ -349,7 +317,7 @@ sub parse_scope {
}
}
else {
- my(@values) = ();
+ 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
@@ -392,29 +360,25 @@ sub parse_scope {
sub base_directory {
- my($self) = shift;
+ my $self = shift;
return $self->mpc_basename($self->getcwd());
}
sub generate_default_file_list {
- my($self) = shift;
- my($dir) = shift;
- my($exclude) = shift;
- my($fileexc) = shift;
- my($recurse) = shift;
- my($dh) = new FileHandle();
- my(@files) = ();
+ 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;
+ 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;
+ my $full = $prefix . $file;
if ($have_exc) {
foreach my $exc (@$exclude) {
@@ -456,8 +420,7 @@ sub generate_default_file_list {
sub transform_file_name {
- my($self) = shift;
- my($name) = shift;
+ my($self, $name) = @_;
$name =~ s/[\s\-]/_/g;
return $name;
@@ -465,16 +428,14 @@ sub transform_file_name {
sub file_written {
- my($self) = shift;
- my($file) = shift;
+ my($self, $file) = @_;
return (defined $all_written{$self->getcwd() . '/' . $file});
}
sub add_file_written {
- my($self) = shift;
- my($file) = shift;
- my($key) = lc($file);
+ my($self, $file) = @_;
+ my $key = lc($file);
if (defined $self->{'files_written'}->{$key}) {
$self->warning("$self->{'grammar_type'} $file " .
@@ -492,20 +453,17 @@ sub add_file_written {
sub extension_recursive_input_list {
- my($self) = shift;
- my($dir) = shift;
- my($exclude) = shift;
- my($ext) = shift;
- my($fh) = new FileHandle();
- my(@files) = ();
+ my($self, $dir, $exclude, $ext) = @_;
+ my $fh = new FileHandle();
+ my @files;
if (opendir($fh, $dir)) {
- my($prefix) = ($dir ne '.' ? "$dir/" : '');
- my($skip) = 0;
+ my $prefix = ($dir ne '.' ? "$dir/" : '');
+ my $skip = 0;
foreach my $file (grep(!/^\.\.?$/,
($onVMS ? map {$_ =~ s/\.dir$//; $_} readdir($fh) :
readdir($fh)))) {
- my($full) = $prefix . $file;
+ my $full = $prefix . $file;
## Check for command line exclusions
if (defined $$exclude[0]) {
@@ -539,15 +497,13 @@ sub extension_recursive_input_list {
}
sub recursive_directory_list {
- my($self) = shift;
- my($dir) = shift;
- my($exclude) = shift;
- my($directories) = '';
- my($fh) = new FileHandle();
+ my($self, $dir, $exclude) = @_;
+ my $directories = '';
+ my $fh = new FileHandle();
if (opendir($fh, $dir)) {
- my($prefix) = ($dir ne '.' ? "$dir/" : '');
- my($skip) = 0;
+ my $prefix = ($dir ne '.' ? "$dir/" : '');
+ my $skip = 0;
if (defined $$exclude[0]) {
foreach my $exc (@$exclude) {
if ($dir eq $exc) {
@@ -566,7 +522,7 @@ sub recursive_directory_list {
foreach my $file (grep(!/^\.\.?$/,
($onVMS ? map {$_ =~ s/\.dir$//; $_} readdir($fh) :
readdir($fh)))) {
- my($full) = $prefix . $file;
+ my $full = $prefix . $file;
## Check for command line exclusions
if (defined $$exclude[0]) {
@@ -596,9 +552,7 @@ sub recursive_directory_list {
sub modify_assignment_value {
- my($self) = shift;
- my($name) = shift;
- my($value) = shift;
+ my($self, $name, $value) = @_;
if ($self->{'convert_slashes'} &&
index($name, 'flags') == -1 && !defined $non_convert{$name}) {
@@ -612,16 +566,13 @@ sub modify_assignment_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;
+ my $self = shift;
return $self->{$self->{'reading_global'} ? $gassign_key : $assign_key};
}
sub process_assignment {
- my($self) = shift;
- my($name) = shift;
- my($value) = shift;
- my($assign) = shift;
+ my($self, $name, $value, $assign) = @_;
## If no hash table was passed in
if (!defined $assign) {
@@ -645,11 +596,7 @@ sub process_assignment {
sub addition_core {
- my($self) = shift;
- my($name) = shift;
- my($value) = shift;
- my($nval) = shift;
- my($assign) = shift;
+ my($self, $name, $value, $nval, $assign) = @_;
if (defined $nval) {
if ($self->preserve_assignment_order($name)) {
@@ -667,11 +614,8 @@ sub addition_core {
sub process_assignment_add {
- my($self) = shift;
- my($name) = shift;
- my($value) = shift;
- my($assign) = shift;
- my($nval) = $self->get_assignment_for_modification($name, $assign);
+ 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
@@ -686,21 +630,17 @@ sub process_assignment_add {
sub subtraction_core {
- my($self) = shift;
- my($name) = shift;
- my($value) = shift;
- my($nval) = shift;
- my($assign) = shift;
+ my($self, $name, $value, $nval, $assign) = @_;
if (defined $nval) {
- my($last) = 1;
- my($found) = undef;
+ 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]);
+ 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
@@ -713,7 +653,7 @@ sub subtraction_core {
## 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);
+ my $re = ($j == 0 ? '"' . $elem . '"' : $elem);
if ($nval =~ s/\s+$re\s+/ / || $nval =~ s/\s+$re$// ||
$nval =~ s/^$re\s+// || $nval =~ s/^$re$//) {
@@ -732,11 +672,8 @@ sub subtraction_core {
sub process_assignment_sub {
- my($self) = shift;
- my($name) = shift;
- my($value) = shift;
- my($assign) = shift;
- my($nval) = $self->get_assignment_for_modification($name, $assign);
+ my($self, $name, $value, $assign) = @_;
+ my $nval = $self->get_assignment_for_modification($name, $assign);
## Remove double quotes if there are any
$value =~ s/^\"(.*)\"$/$1/;
@@ -746,17 +683,15 @@ sub process_assignment_sub {
sub fill_type_name {
- my($self) = shift;
- my($names) = shift;
- my($def) = shift;
- my($array) = ($names =~ /\s/ ? $self->create_array($names) : [$names]);
+ 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;
+ my $pre = $def . '_';
+ my $mid = '_' . $def . '_';
+ my $post = '_' . $def;
## Replace the beginning and end first then the middle
$name =~ s/^\*/$pre/;
@@ -773,14 +708,14 @@ sub fill_type_name {
if ($name =~ /[A-Z][0-9a-z_]+/) {
## Do the first word
if ($name =~ /^([a-z])([^_]+)/) {
- my($first) = uc($1);
- my($rest) = $2;
+ 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;
+ my $first = uc($1);
+ my $rest = $2;
$name =~ s/_[a-z][^_]+/$first$rest/;
}
}
@@ -795,9 +730,8 @@ sub fill_type_name {
sub save_state {
- my($self) = shift;
- my($selected) = shift;
- my(%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.
@@ -826,22 +760,20 @@ sub save_state {
sub restore_state {
- my($self) = shift;
- my($state) = shift;
- my($selected) = shift;
+ 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.
foreach my $skey (defined $selected ? $selected : @statekeys) {
- my($old) = $self->{$skey};
+ my $old = $self->{$skey};
if (defined $state->{$skey} &&
UNIVERSAL::isa($state->{$skey}, 'ARRAY')) {
- my(@arr) = @{$state->{$skey}};
+ my @arr = @{$state->{$skey}};
$self->{$skey} = \@arr;
}
elsif (defined $state->{$skey} &&
UNIVERSAL::isa($state->{$skey}, 'HASH')) {
- my(%hash) = %{$state->{$skey}};
+ my %hash = %{$state->{$skey}};
$self->{$skey} = \%hash;
}
else {
@@ -853,81 +785,69 @@ sub restore_state {
sub get_global_cfg {
- my($self) = shift;
- return $self->{'global'};
+ return $_[0]->{'global'};
}
sub get_template_override {
- my($self) = shift;
- return $self->{'template'};
+ return $_[0]->{'template'};
}
sub get_ti_override {
- my($self) = shift;
- return $self->{'ti'};
+ return $_[0]->{'ti'};
}
sub get_relative {
- my($self) = shift;
- return $self->{'relative'};
+ return $_[0]->{'relative'};
}
sub get_progress_callback {
- my($self) = shift;
- return $self->{'progress'};
+ return $_[0]->{'progress'};
}
sub get_addtemp {
- my($self) = shift;
- return $self->{'addtemp'};
+ return $_[0]->{'addtemp'};
}
sub get_addproj {
- my($self) = shift;
- return $self->{'addproj'};
+ return $_[0]->{'addproj'};
}
sub get_toplevel {
- my($self) = shift;
- return $self->{'toplevel'};
+ return $_[0]->{'toplevel'};
}
sub get_into {
- my($self) = shift;
- return $self->{'into'};
+ return $_[0]->{'into'};
}
sub get_use_env {
- my($self) = shift;
- return $self->{'use_env'};
+ return $_[0]->{'use_env'};
}
sub get_expand_vars {
- my($self) = shift;
- return $self->{'expand_vars'};
+ return $_[0]->{'expand_vars'};
}
sub get_files_written {
- my($self) = shift;
- return $self->{'real_fwritten'};
+ return $_[0]->{'real_fwritten'};
}
sub get_assignment {
- my($self) = shift;
- my($name) = $self->resolve_alias(shift);
- my($assign) = shift;
+ my $self = shift;
+ my $name = $self->resolve_alias(shift);
+ my $assign = shift;
## If no hash table was passed in
if (!defined $assign) {
@@ -940,29 +860,23 @@ sub get_assignment {
sub get_assignment_for_modification {
- my($self) = shift;
- my($name) = shift;
- my($assign) = shift;
- my($subtraction) = shift;
+ my($self, $name, $assign, $subtraction) = @_;
return $self->get_assignment($name, $assign);
}
sub get_baseprojs {
- my($self) = shift;
- return $self->{'baseprojs'};
+ return $_[0]->{'baseprojs'};
}
sub get_dynamic {
- my($self) = shift;
- return $self->{'dynamic'};
+ return $_[0]->{'dynamic'};
}
sub get_static {
- my($self) = shift;
- return $self->{'static'};
+ return $_[0]->{'static'};
}
@@ -973,40 +887,35 @@ sub get_default_component_name {
sub get_features {
- my($self) = shift;
- return $self->{'features'};
+ return $_[0]->{'features'};
}
sub get_hierarchy {
- my($self) = shift;
- return $self->{'hierarchy'};
+ return $_[0]->{'hierarchy'};
}
sub get_name_modifier {
- my($self) = shift;
- return $self->{'name_modifier'};
+ return $_[0]->{'name_modifier'};
}
sub get_apply_project {
- my($self) = shift;
- return $self->{'apply_project'};
+ return $_[0]->{'apply_project'};
}
sub get_language {
- my($self) = shift;
- return $self->{'language'};
+ return $_[0]->{'language'};
}
sub get_outdir {
- my($self) = shift;
+ my $self = shift;
if (defined $self->{'into'}) {
- my($outdir) = $self->getcwd();
- my($re) = $self->escape_regex_special($self->getstartdir());
+ my $outdir = $self->getcwd();
+ my $re = $self->escape_regex_special($self->getstartdir());
$outdir =~ s/^$re//;
return $self->{'into'} . $outdir;
@@ -1018,15 +927,9 @@ sub get_outdir {
sub expand_variables {
- my($self) = shift;
- my($value) = shift;
- my($rel) = shift;
- my($expand_template) = shift;
- my($scope) = shift;
- my($expand) = shift;
- my($warn) = shift;
- my($cwd) = $self->getcwd();
- my($start) = 0;
+ 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'};
@@ -1034,10 +937,10 @@ sub expand_variables {
$cwd =~ s/\\/\//g if ($forward_slashes);
while(substr($value, $start) =~ /(\$\(([^)]+)\))/) {
- my($whole) = $1;
- my($name) = $2;
+ my $whole = $1;
+ my $name = $2;
if (defined $$rel{$name}) {
- my($val) = $$rel{$name};
+ my $val = $$rel{$name};
if ($expand) {
$val =~ s/\//\\/g if ($forward_slashes);
substr($value, $start) =~ s/\$\([^)]+\)/$val/;
@@ -1047,19 +950,19 @@ sub expand_variables {
## 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);
+ 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) = undef;
+ my $append;
if (index($ival, $icwd) == 0 && $iclen != $ivlen &&
substr($ival, $iclen, 1) eq '/') {
- my($diff) = $ivlen - $iclen;
+ my $diff = $ivlen - $iclen;
$append = substr($ival, $iclen);
substr($ival, $iclen, $diff) = '';
$ivlen -= $diff;
@@ -1067,10 +970,10 @@ sub expand_variables {
if (index($icwd, $ival) == 0 &&
($iclen == $ivlen || substr($icwd, $ivlen, 1) eq '/')) {
- my($current) = $icwd;
+ my $current = $icwd;
substr($current, 0, $ivlen) = '';
- my($dircount) = ($current =~ tr/\///);
+ my $dircount = ($current =~ tr/\///);
if ($dircount == 0) {
$ival = '.';
}
@@ -1094,18 +997,18 @@ sub expand_variables {
$whole = $val;
}
else {
- my($loc) = index(substr($value, $start), $whole);
+ 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 : []));
+ 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");
}
@@ -1124,7 +1027,7 @@ sub expand_variables {
if ($expand && $warn) {
$self->warning("Unable to expand $name.");
}
- my($loc) = index(substr($value, $start), $whole);
+ my $loc = index(substr($value, $start), $whole);
$start += $loc if ($loc > 0);
}
}
@@ -1133,7 +1036,7 @@ sub expand_variables {
$whole = '';
}
else {
- my($loc) = index(substr($value, $start), $whole);
+ my $loc = index(substr($value, $start), $whole);
$start += $loc if ($loc > 0);
}
$start += length($whole);
@@ -1146,16 +1049,13 @@ sub expand_variables {
sub relative {
- my($self) = shift;
- my($value) = shift;
- my($expand_template) = shift;
- my($scope) = shift;
+ my($self, $value, $expand_template, $scope) = @_;
if (defined $value) {
if (UNIVERSAL::isa($value, 'ARRAY')) {
- my(@built) = ();
+ my @built;
foreach my $val (@$value) {
- my($rel) = $self->relative($val, $expand_template, $scope);
+ my $rel = $self->relative($val, $expand_template, $scope);
if (UNIVERSAL::isa($rel, 'ARRAY')) {
push(@built, @$rel);
}
@@ -1171,7 +1071,7 @@ sub relative {
## something in this area, please look at the method in
## ProjectCreator.pm to see if it needs changing too.
- my($ovalue) = $value;
+ my $ovalue = $value;
my($rel, $how) = $self->get_initial_relative_values();
$value = $self->expand_variables($value, $rel,
$expand_template, $scope, $how);
@@ -1213,7 +1113,7 @@ sub get_initial_relative_values {
sub get_secondary_relative_values {
- my($self) = shift;
+ my $self = shift;
return ($self->{'use_env'} ? \%ENV :
$self->{'relative'}), $self->{'expand_vars'};
}
@@ -1245,9 +1145,7 @@ sub compare_output {
sub files_are_different {
- my($self) = shift;
- my($old) = shift;
- my($new) = shift;
+ my($self, $old, $new) = @_;
return !(-r $old && -s $new == -s $old && compare($new, $old) == 0);
}
@@ -1260,28 +1158,21 @@ sub handle_scoped_end {
}
sub handle_unknown_assignment {
- my($self) = shift;
- my($type) = shift;
- my(@values) = @_;
+ my $self = shift;
+ my $type = shift;
+ my @values = @_;
return 0, "Invalid assignment name: '$values[1]'";
}
sub handle_scoped_unknown {
- my($self) = shift;
- my($fh) = shift;
- my($type) = shift;
- my($flags) = shift;
- my($line) = shift;
+ my($self, $fh, $type, $flags, $line) = @_;
return 0, "Unrecognized line: $line";
}
sub remove_duplicate_addition {
- my($self) = shift;
- my($name) = shift;
- my($value) = shift;
- my($current) = shift;
+ my($self, $name, $value, $current) = @_;
return $value;
}
diff --git a/modules/DirectoryManager.pm b/modules/DirectoryManager.pm
index 5af88f0e..ffbca897 100644
--- a/modules/DirectoryManager.pm
+++ b/modules/DirectoryManager.pm
@@ -18,11 +18,11 @@ use File::Basename;
# Data Section
# ************************************************************
-my($onVMS) = ($^O eq 'VMS');
-my($case_insensitive) = File::Spec->case_tolerant();
-my($cwd) = Cwd::getcwd();
+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`;
+ my $cyg = `cygpath -w $cwd`;
if (defined $cyg) {
$cyg =~ s/\\/\//g;
chop($cwd = $cyg);
@@ -33,7 +33,7 @@ elsif ($onVMS) {
$cwd = VMS::Filespec::unixify($cwd);
$cwd =~ s!/$!!g;
}
-my($start) = $cwd;
+my $start = $cwd;
# ************************************************************
# Subroutine Section
@@ -41,7 +41,7 @@ my($start) = $cwd;
sub cd {
my($self, $dir) = @_;
- my($status) = chdir($dir);
+ my $status = chdir($dir);
if ($status && $dir ne '.') {
## First strip out any /./ or ./ or /.
@@ -54,7 +54,7 @@ sub cd {
if (index($dir, '..') >= 0) {
$cwd = Cwd::getcwd();
if ($^O eq 'cygwin' && $cwd !~ /[A-Za-z]:/) {
- my($cyg) = `cygpath -w $cwd`;
+ my $cyg = `cygpath -w $cwd`;
if (defined $cyg) {
$cyg =~ s/\\/\//g;
chop($cwd = $cyg);
@@ -118,19 +118,19 @@ sub mpc_dirname {
sub mpc_glob {
my($self, $pattern) = @_;
- my(@files) = ();
+ my @files;
## 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($pre) = $1;
- my($mid) = $2;
- my($post) = $3;
+ my $pre = $1;
+ my $mid = $2;
+ my $post = $3;
for(my $i = 0; $i < length($mid); $i++) {
- my($p) = $pre . substr($mid, $i, 1) . $post;
+ my $p = $pre . substr($mid, $i, 1) . $post;
foreach my $new (DirectoryManager::mpc_glob($self, $p)) {
- my($found) = undef;
+ my $found;
foreach my $file (@files) {
if ($file eq $new) {
$found = 1;
@@ -169,17 +169,17 @@ sub translate_directory {
my($self, $dir) = @_;
## Remove the current working directory from $dir (if it is contained)
- my($cwd) = $self->getcwd();
+ my $cwd = $self->getcwd();
$cwd =~ s/\//\\/g if ($self->convert_slashes());
if (index($dir, $cwd) == 0) {
- my($cwdl) = length($cwd);
+ my $cwdl = length($cwd);
return '.' if (length($dir) == $cwdl);
$dir = substr($dir, $cwdl + 1);
}
## Translate .. to $dd
if (index($dir, '..') >= 0) {
- my($dd) = 'dotdot';
+ my $dd = 'dotdot';
$dir =~ s/^\.\.([\/\\])/$dd$1/;
$dir =~ s/([\/\\])\.\.$/$1$dd/;
$dir =~ s/([\/\\])\.\.([\/\\])/$1$dd$2/g;
diff --git a/modules/Driver.pm b/modules/Driver.pm
index d3bdf594..75576e50 100644
--- a/modules/Driver.pm
+++ b/modules/Driver.pm
@@ -24,27 +24,27 @@ use vars qw(@ISA);
# 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 $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,
+ );
# ************************************************************
# Subroutine Section
# ************************************************************
sub new {
- my($class) = shift;
- my($path) = shift;
- my($name) = shift;
- my(@creators) = @_;
- my($self) = $class->SUPER::new();
+ my $class = shift;
+ my $path = shift;
+ my $name = shift;
+ my @creators = @_;
+ my $self = $class->SUPER::new();
$self->{'path'} = $path;
$self->{'basepath'} = ::getBasePath();
@@ -61,9 +61,9 @@ sub new {
sub locate_default_type {
- my($self) = shift;
- my($name) = lc(shift) . lc($self->{'type'}) . '.pm';
- my($fh) = new FileHandle();
+ my $self = shift;
+ my $name = lc(shift) . lc($self->{'type'}) . '.pm';
+ my $fh = new FileHandle();
foreach my $dir (@INC) {
if (opendir($fh, $dir)) {
@@ -82,11 +82,10 @@ sub locate_default_type {
sub locate_dynamic_directories {
- my($self) = shift;
- my($dtypes) = shift;
+ my($self, $dtypes) = @_;
if (defined $dtypes) {
- my(@directories) = ();
+ my @directories;
foreach my $dir (split(/\s*,\s*/, $dtypes)) {
if (-d $dir) {
if (-d "$dir/modules" || -d "$dir/config" || -d "$dir/templates") {
@@ -105,18 +104,17 @@ sub locate_dynamic_directories {
sub add_dynamic_creators {
- my($self) = shift;
- my($dirs) = shift;
- my($type) = $self->{'type'};
+ my($self, $dirs) = @_;
+ my $type = $self->{'type'};
foreach my $dir (@$dirs) {
- my($fh) = new FileHandle();
+ my $fh = new FileHandle();
if (opendir($fh, "$dir/modules")) {
foreach my $file (readdir($fh)) {
if ($file =~ /(.+$type)\.pm$/i) {
my $name = $1;
if ($^O eq 'VMS') {
- my($fh) = new FileHandle();
+ my $fh = new FileHandle();
if (open($fh, $dir . "/modules/" . $file)) {
my $line = <$fh>;
if ($line =~ /^\s*package\s+(.+);/) {
@@ -135,17 +133,15 @@ sub add_dynamic_creators {
}
sub parse_line {
- my($self) = shift;
- my($ih) = shift;
- my($line) = shift;
- my($status) = 1;
- my($errorString) = undef;
+ my($self, $ih, $line) = @_;
+ my $status = 1;
+ my $errorString;
if ($line eq '') {
}
elsif ($line =~ /^([\w\*]+)(\s*,\s*(.*))?$/) {
- my($name) = $1;
- my($value) = $3;
+ my $name = $1;
+ my $value = $3;
if (defined $value) {
$value =~ s/^\s+//;
$value =~ s/\s+$//;
@@ -186,8 +182,7 @@ sub parse_line {
sub optionError {
- my($self) = shift;
- my($line) = shift;
+ my($self, $line) = @_;
$self->printUsage($line, $self->{'name'}, Version::get(),
keys %{$self->{'types'}});
@@ -196,9 +191,7 @@ sub optionError {
sub find_file {
- my($self) = shift;
- my($includes) = shift;
- my($file) = shift;
+ my($self, $includes, $file) = @_;
foreach my $inc (@$includes) {
if (-r $inc . '/' . $file) {
@@ -211,17 +204,15 @@ sub find_file {
sub determine_cfg_file {
- my($self) = shift;
- my($cfg) = shift;
- my($odir) = shift;
- my($ci) = $self->case_insensitive();
+ 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);
+ 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';
+ my $cfgfile = $value . '/MPC.cfg';
return $cfgfile if (-e $cfgfile);
}
}
@@ -231,18 +222,18 @@ sub determine_cfg_file {
sub run {
- my($self) = shift;
- my(@args) = @_;
- my($cfgfile) = undef;
+ 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();
+ 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";
+ my $cbcfg = new ConfigParser();
+ my $cbfile = "$self->{'basepath'}/config/base.cfg";
if (-r $cbfile) {
my($status, $error) = $cbcfg->read_file($cbfile);
if (!$status) {
@@ -262,9 +253,9 @@ sub run {
}
## Read the MPC config file
- my($cfg) = new ConfigParser(\%valid_cfg);
+ my $cfg = new ConfigParser(\%valid_cfg);
if (defined $cfgfile) {
- my($ellipses) = $cfgfile;
+ my $ellipses = $cfgfile;
$ellipses =~ s!.*(/[^/]+/[^/]+/[^/]+/[^/]+/[^/]+/[^/]+)!...$1!;
$self->diagnostic("Using $ellipses");
my($status, $error) = $cfg->read_file($cfgfile);
@@ -280,8 +271,8 @@ sub run {
## After we read the config file, see if the user has provided
## dynamic types
- my($dynamic) = $self->locate_dynamic_directories(
- $cfg->get_value('dynamic_types'));
+ my $dynamic = $self->locate_dynamic_directories(
+ $cfg->get_value('dynamic_types'));
if (defined $dynamic) {
## If so, add in the creators found in the dynamic directories
$self->add_dynamic_creators($dynamic);
@@ -299,24 +290,24 @@ sub run {
## Dynamically load in each perl module and set up
## the type tags and project creators
- my($creators) = $self->{'creators'};
+ my $creators = $self->{'creators'};
foreach my $creator (@$creators) {
- my($tag) = $self->extractType($creator);
+ 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');
+ my $cmd = $cfg->get_value('command_line');
if (defined $cmd) {
- my($envargs) = $self->create_array($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');
+ 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
@@ -326,10 +317,10 @@ sub run {
}
}
- my($options) = $self->options($self->{'name'},
- $self->{'types'},
- 1,
- @args);
+ my $options = $self->options($self->{'name'},
+ $self->{'types'},
+ 1,
+ @args);
if (!defined $options) {
## If options are not defined, that means that calling options
## took care of whatever functionality that was required and
@@ -339,13 +330,13 @@ sub run {
## Set up a hash that we can use to keep track of what
## has been 'required'
- my(%loaded) = ();
+ my %loaded;
## Set up the default creator, if no type is selected
if (!defined $options->{'creators'}->[0]) {
- my($utype) = $cfg->get_value('default_type');
+ my $utype = $cfg->get_value('default_type');
if (defined $utype) {
- my($default) = $self->locate_default_type($utype);
+ my $default = $self->locate_default_type($utype);
if (defined $default) {
push(@{$options->{'creators'}}, $default);
}
@@ -387,16 +378,16 @@ sub run {
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];
+ 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'});
+ 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
@@ -422,11 +413,11 @@ sub run {
$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);
+ my $global_feature_file = (defined $options->{'gfeature_file'} &&
+ -r $options->{'gfeature_file'} ?
+ $options->{'gfeature_file'} : undef);
if (!defined $global_feature_file) {
- my($gf) = 'global.features';
+ 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;
@@ -446,11 +437,11 @@ sub run {
'global.mpb');
}
## Set the relative
- my($relative_file) = (defined $options->{'relative_file'} &&
- -r $options->{'relative_file'} ?
- $options->{'relative_file'} : undef);
+ my $relative_file = (defined $options->{'relative_file'} &&
+ -r $options->{'relative_file'} ?
+ $options->{'relative_file'} : undef);
if (!defined $relative_file) {
- my($gf) = 'default.rel';
+ my $gf = 'default.rel';
$relative_file = $self->find_file($options->{'include'}, $gf);
if (!defined $relative_file) {
$relative_file = $self->{'basepath'} . '/config/' . $gf;
@@ -472,10 +463,10 @@ sub run {
}
if (defined $self->{'reldefs'}->{$key} &&
!defined $options->{'relative'}->{$key}) {
- my($value) = $self->{'reldefs'}->{$key};
+ my $value = $self->{'reldefs'}->{$key};
if ($value =~ /\$(\w+)(.*)?/) {
- my($var) = $1;
- my($extra) = $2;
+ my $var = $1;
+ my $extra = $2;
$options->{'relative'}->{$key} =
(defined $options->{'relative'}->{$var} ?
$options->{'relative'}->{$var} : '') .
@@ -506,17 +497,17 @@ sub run {
$| = 1;
## Keep the starting time for the total output
- my($startTime) = time();
- my($loopTimes) = 0;
+ my $startTime = time();
+ my $loopTimes = 0;
## Generate the files
- my($status) = 0;
+ 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));
+ my $base = ($cfile eq '' ? '' : $self->mpc_basename($cfile));
if (-d $cfile) {
$base = '';
@@ -529,42 +520,42 @@ sub run {
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'});
+ 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));
+ my $dir = ($base eq '' ? $file : $self->mpc_dirname($file));
if (!$creator->cd($dir)) {
$self->error("Unable to change to directory: $dir");
$status++;
@@ -572,27 +563,27 @@ sub run {
}
$file = $base;
}
- my($diag) = 'Generating \'' . $self->extractType($name) .
- '\' output using ';
+ 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) . '(/)?';
+ 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();
+ my $start = time();
if (!$creator->generate($file)) {
$self->error("Unable to process: " .
($file eq '' ? 'default input' : $file));
$status++;
last;
}
- my($total) = time() - $start;
+ my $total = time() - $start;
$self->diagnostic('Generation Time: ' .
(int($total / 60) > 0 ? int($total / 60) . 'm ' : '') .
($total % 60) . 's');
@@ -606,7 +597,7 @@ sub run {
## 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;
+ my $total = time() - $startTime;
$self->diagnostic(' Total Time: ' .
(int($total / 60) > 0 ? int($total / 60) . 'm ' : '') .
($total % 60) . 's');
diff --git a/modules/FeatureParser.pm b/modules/FeatureParser.pm
index 711728d0..825dbe94 100644
--- a/modules/FeatureParser.pm
+++ b/modules/FeatureParser.pm
@@ -22,10 +22,10 @@ use vars qw(@ISA);
# ************************************************************
sub new {
- my($class) = shift;
- my($features) = shift;
- my(@files) = @_;
- my($self) = $class->SUPER::new();
+ my $class = shift;
+ my $features = shift;
+ my @files = @_;
+ my $self = $class->SUPER::new();
## Set the values associative array
$self->{'values'} = {};
@@ -37,7 +37,7 @@ sub new {
if (!$status) {
## We only want to warn the user about problems
## with the feature file.
- my($lnumber) = $self->get_line_number();
+ my $lnumber = $self->get_line_number();
$self->warning($self->mpc_basename($f) . ": line $lnumber: $warn");
}
}
@@ -58,11 +58,9 @@ sub new {
sub parse_line {
- my($self) = shift;
- my($if) = shift;
- my($line) = shift;
- my($status) = 1;
- my($error) = undef;
+ my($self, $if, $line) = @_;
+ my $status = 1;
+ my $error;
if ($line eq '') {
}
@@ -79,15 +77,13 @@ sub parse_line {
sub get_names {
- my($self) = shift;
- my(@names) = keys %{$self->{'values'}};
+ my @names = keys %{$_[0]->{'values'}};
return \@names;
}
sub get_value {
- my($self) = shift;
- my($tag) = shift;
+ my($self, $tag) = @_;
return $self->{'values'}->{lc($tag)};
}
diff --git a/modules/GUID.pm b/modules/GUID.pm
index 83090928..2a1ecc05 100644
--- a/modules/GUID.pm
+++ b/modules/GUID.pm
@@ -17,13 +17,11 @@ use strict;
# ************************************************************
sub generate {
- my($out) = shift;
- my($in) = shift;
- my($cwd) = shift;
- my($chash) = GUID::hash($cwd);
- my($nhash) = GUID::hash($out);
- my($ihash) = GUID::hash($in);
- my($val) = 0xfeca1bad;
+ 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,
@@ -33,11 +31,11 @@ sub generate {
sub hash {
- my($str) = shift;
- my($value) = 0;
+ my $str = shift;
+ my $value = 0;
if (defined $str) {
- my($length) = length($str);
+ my $length = length($str);
for(my $i = 0; $i < $length; $i++) {
$value = ($value << 4) ^ ($value >> 28) ^ ord(substr($str, $i, 1));
}
diff --git a/modules/MakeWorkspaceBase.pm b/modules/MakeWorkspaceBase.pm
index a1a43bc6..4f125122 100644
--- a/modules/MakeWorkspaceBase.pm
+++ b/modules/MakeWorkspaceBase.pm
@@ -17,8 +17,7 @@ use strict;
# ************************************************************
sub targets {
- my($self) = shift;
- return $self->{'make_targets'};
+ return $_[0]->{'make_targets'};
}
sub workspace_file_prefix {
@@ -34,13 +33,12 @@ sub workspace_file_extension {
sub supports_make_coexistence {
- my($self) = shift;
- return ($self->workspace_file_extension() ne '');
+ return ($_[0]->workspace_file_extension() ne '');
}
sub workspace_file_name {
- my($self) = shift;
+ my $self = shift;
return $self->get_modified_workspace_name(
$self->workspace_file_prefix(),
$self->make_coexistence() ?
@@ -55,11 +53,7 @@ sub workspace_per_project {
sub workspace_preamble {
- my($self) = shift;
- my($fh) = shift;
- my($crlf) = shift;
- my($name) = shift;
- my($id) = shift;
+ my($self, $fh, $crlf, $name, $id) = @_;
$self->print_workspace_comment($fh,
'#----------------------------------------------------------------------------', $crlf,
@@ -79,25 +73,14 @@ sub workspace_preamble {
sub write_named_targets {
- my($self) = shift;
- my($fh) = shift;
- my($crlf) = shift;
- my($targnum) = shift;
- my($list) = shift;
- my($remain) = shift;
- my($targpre) = shift;
- my($allpre) = shift;
- my($trans) = shift;
- my($phony) = shift;
- my($andsym) = shift;
- my($maxline) = shift;
+ 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:';
+ my $all = 'all:';
foreach my $project (@$list) {
$all .= " $$trans{$project}";
}
@@ -115,7 +98,7 @@ sub write_named_targets {
}
}
- ## Print out all other targets here
+ ## Print out all other targets here
print $fh "$crlf$crlf$remain:$crlf";
$self->write_project_targets($fh, $crlf,
$targpre . '$(@)', $list, $andsym);
@@ -128,7 +111,7 @@ sub write_named_targets {
foreach my $number (@{$$targnum{$project}}) {
print $fh " $$trans{$$list[$number]}";
}
- }
+ }
print $fh $crlf;
$self->write_project_targets($fh, $crlf,
$targpre . $allpre . 'all',
@@ -147,15 +130,15 @@ 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();
+ 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")) {
- my($cmd) = ("$self" =~ /^nmake/i ? 'nmake' : 'make');
- my($stop) = ("$self" =~ /^bmake/i ? 'true' : 'false');
+ 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()))) {
@@ -188,7 +171,7 @@ sub post_workspace {
sub get_eclipse_cdtproject {
- my($self) = shift;
+ my $self = shift;
if (!defined $self->{'eclipse_cdtproject'}) {
$self->{'eclipse_cdtproject'} = [
'<?xml version="1.0" encoding="UTF-8"?>
@@ -256,7 +239,7 @@ sub get_eclipse_cdtproject {
sub get_eclipse_project {
- my($self) = shift;
+ my $self = shift;
if (!defined $self->{'eclipse_project'}) {
$self->{'eclipse_project'} = [
'<?xml version="1.0" encoding="UTF-8"?>
diff --git a/modules/Options.pm b/modules/Options.pm
index 19e62017..01bdf4ba 100644
--- a/modules/Options.pm
+++ b/modules/Options.pm
@@ -20,28 +20,28 @@ use ProjectCreator;
# Data Section
# ************************************************************
-my($deflang) = 'cplusplus';
-my(%languages) = ('cplusplus' => 1,
- 'csharp' => 1,
- 'java' => 1,
- 'vb' => 1,
- );
+my $deflang = 'cplusplus';
+my %languages = ('cplusplus' => 1,
+ 'csharp' => 1,
+ 'java' => 1,
+ 'vb' => 1,
+ );
# ************************************************************
# Subroutine Section
# ************************************************************
sub printUsage {
- my($self) = shift;
- my($msg) = shift;
- my($base) = shift;
- my($version) = shift;
- my(@types) = @_;
+ my $self = shift;
+ my $msg = shift;
+ my $base = shift;
+ my $version = shift;
+ my @types = @_;
if (defined $msg) {
print STDERR "ERROR: $msg\n";
}
- my($spaces) = (' ' x (length($base) + 8));
+ 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" .
@@ -57,12 +57,12 @@ sub printUsage {
$spaces . "[-relative_file <file name>] [-for_eclipse]\n" .
$spaces . "[-language <";
- my($olen) = length($spaces) + 12;
- my($len) = $olen;
- my($mlen) = 77;
- my(@keys) = sort keys %languages;
+ my $olen = length($spaces) + 12;
+ my $len = $olen;
+ my $mlen = 77;
+ my @keys = sort keys %languages;
for(my $i = 0; $i <= $#keys; $i++) {
- my($klen) = length($keys[$i]);
+ my $klen = length($keys[$i]);
$len += $klen;
if ($len > $mlen) {
print STDERR "\n$spaces ";
@@ -81,7 +81,7 @@ sub printUsage {
$len = $olen;
@keys = sort @types;
for(my $i = 0; $i <= $#keys; $i++) {
- my($klen) = length($keys[$i]);
+ my $klen = length($keys[$i]);
$len += $klen;
if ($len > $mlen) {
print STDERR "\n$spaces ";
@@ -181,20 +181,18 @@ sub optionError {
sub completion_command {
- my($self) = shift;
- my($name) = shift;
- my($types) = shift;
- 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)/:' ";
+ 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 keys %languages;
+ my @keys = sort keys %languages;
for(my $i = 0; $i <= $#keys; $i++) {
$str .= $keys[$i];
if ($i != $#keys) {
@@ -216,47 +214,47 @@ sub completion_command {
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) = undef;
- my($template) = undef;
- my($feature_f) = undef;
- my($gfeature_f) = undef;
- my($relative_f) = undef;
- my(@features) = ();
- my($nmodifier) = undef;
- my($into) = undef;
- my($hierarchy) = 0;
- my($language) = ($defaults ? $deflang : 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);
+ 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 ? $deflang : 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];
+ my $arg = $args[$i];
$arg =~ s/^--/-/;
if ($arg eq '-apply_project') {
@@ -281,10 +279,10 @@ sub options {
$self->optionError('-type requires an argument');
}
else {
- my($type) = lc($args[$i]);
+ my $type = lc($args[$i]);
if (defined $types->{$type}) {
- my($call) = $types->{$type};
- my($found) = 0;
+ my $call = $types->{$type};
+ my $found = 0;
foreach my $creator (@creators) {
if ($creator eq $call) {
$found = 1;
@@ -371,7 +369,7 @@ sub options {
}
elsif ($arg eq '-include') {
$i++;
- my($include) = $args[$i];
+ my $include = $args[$i];
if (!defined $include) {
$self->optionError('-include requires a directory argument');
}
@@ -408,7 +406,7 @@ sub options {
}
elsif ($arg eq '-name_modifier') {
$i++;
- my($nmod) = $args[$i];
+ my $nmod = $args[$i];
if (!defined $nmod) {
$self->optionError('-name_modifier requires a modifier argument');
}
@@ -437,14 +435,14 @@ sub options {
}
elsif ($arg eq '-relative') {
$i++;
- my($rel) = $args[$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;
+ my $name = $1;
+ my $val = $2;
$val =~ s/^\s+//;
$val =~ s/\s+$//;
@@ -466,14 +464,14 @@ sub options {
}
elsif ($arg eq '-ti') {
$i++;
- my($tmpi) = $args[$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;
+ my $key = $2;
+ my $name = $3;
if (defined $key) {
$ti{$key} = $name;
}
@@ -493,13 +491,13 @@ sub options {
}
elsif ($arg eq '-value_template') {
$i++;
- my($value) = $args[$i];
+ my $value = $args[$i];
if (!defined $value) {
$self->optionError('-value_template requires a variable assignment argument');
}
else {
- my(@values) = ();
- my($pc) = new ProjectCreator();
+ 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
@@ -507,7 +505,7 @@ sub options {
## used in ProjectCreator::update_template_variable().
push(@{$addtemp{$values[1]}}, [$values[0], $values[2], 1]);
- my($keywords) = ProjectCreator::getKeywords();
+ my $keywords = ProjectCreator::getKeywords();
if (defined $$keywords{$values[1]}) {
$self->warning($values[1] . ' is a project keyword; you ' .
'should use -value_project instead.');
@@ -520,13 +518,13 @@ sub options {
}
elsif ($arg eq '-value_project') {
$i++;
- my($value) = $args[$i];
+ my $value = $args[$i];
if (!defined $value) {
$self->optionError('-value_project requires a variable assignment argument');
}
else {
- my(@values) = ();
- my($pc) = new ProjectCreator();
+ 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]]);
@@ -589,9 +587,7 @@ sub options {
sub is_set {
- my($self) = shift;
- my($key) = shift;
- my($options) = shift;
+ my($self, $key, $options) = @_;
if (defined $options->{$key}) {
if (UNIVERSAL::isa($options->{$key}, 'ARRAY')) {
@@ -600,7 +596,7 @@ sub is_set {
}
}
elsif (UNIVERSAL::isa($options->{$key}, 'HASH')) {
- my(@keys) = keys %{$options->{$key}};
+ my @keys = keys %{$options->{$key}};
if (defined $keys[0]) {
return 'HASH';
}
diff --git a/modules/OutputMessage.pm b/modules/OutputMessage.pm
index f6b53920..855b4d14 100644
--- a/modules/OutputMessage.pm
+++ b/modules/OutputMessage.pm
@@ -16,30 +16,29 @@ use strict;
# Data Section
# ************************************************************
-my($debugtag) = 'DEBUG: ';
-my($infotag) = 'INFORMATION: ';
-my($warntag) = 'WARNING: ';
-my($errortag) = 'ERROR: ';
+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;
+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;
+ my $class = shift;
+ return bless {}, $class;
}
sub set_levels {
- my($str) = shift;
+ my $str = shift;
if (defined $str) {
$debug = ($str =~ /debug\s*=\s*(\d+)/i ? $1 : 0);
@@ -51,9 +50,7 @@ sub set_levels {
}
sub split_message {
- my($self) = shift;
- my($msg) = shift;
- my($spc) = shift;
+ my($self, $msg, $spc) = @_;
$msg =~ s/\.\s+/.\n$spc/g;
return $msg . "\n";
@@ -62,8 +59,7 @@ sub split_message {
sub details {
if ($details) {
- my($self) = shift;
- my($msg) = shift;
+ my($self, $msg) = @_;
print "$msg\n";
}
}
@@ -71,8 +67,7 @@ sub details {
sub diagnostic {
if ($diagnostic) {
- my($self) = shift;
- my($msg) = shift;
+ my($self, $msg) = @_;
print "$msg\n";
}
}
@@ -80,8 +75,7 @@ sub diagnostic {
sub debug {
if ($debug) {
- my($self) = shift;
- my($msg) = shift;
+ my($self, $msg) = @_;
print "$debugtag$msg\n";
}
}
@@ -89,8 +83,7 @@ sub debug {
sub information {
if ($information) {
- my($self) = shift;
- my($msg) = shift;
+ my($self, $msg) = @_;
print $infotag . $self->split_message($msg, ' ' x length($infotag));
}
}
@@ -98,17 +91,14 @@ sub information {
sub warning {
if ($warnings) {
- my($self) = shift;
- my($msg) = shift;
+ my($self, $msg) = @_;
print $warntag . $self->split_message($msg, ' ' x length($warntag));
}
}
sub error {
- my($self) = shift;
- my($msg) = shift;
- my($pre) = shift;
+ my($self, $msg, $pre) = @_;
if (defined $pre) {
print STDERR "$pre\n";
diff --git a/modules/Parser.pm b/modules/Parser.pm
index c1b247c7..a99937fe 100644
--- a/modules/Parser.pm
+++ b/modules/Parser.pm
@@ -24,16 +24,15 @@ use vars qw(@ISA);
# Data Section
# ************************************************************
-my(%filecache) = ();
+my %filecache;
# ************************************************************
# Subroutine Section
# ************************************************************
sub new {
- my($class) = shift;
- my($inc) = shift;
- my($self) = $class->SUPER::new();
+ my($class, $inc) = @_;
+ my $self = $class->SUPER::new();
$self->{'line_number'} = 0;
$self->{'include'} = $inc;
@@ -43,8 +42,7 @@ sub new {
sub strip_line {
- my($self) = shift;
- my($line) = shift;
+ my($self, $line) = @_;
++$self->{'line_number'};
$line =~ s/\/\/.*//;
@@ -64,12 +62,10 @@ sub preprocess_line {
sub read_file {
- my($self) = shift;
- my($input) = shift;
- my($cache) = shift;
- my($ih) = new FileHandle();
- my($status) = 1;
- my($errorString) = undef;
+ my($self, $input, $cache) = @_;
+ my $ih = new FileHandle();
+ my $status = 1;
+ my $errorString;
$self->{'line_number'} = 0;
if (open($ih, $input)) {
@@ -81,7 +77,7 @@ sub read_file {
}
while(<$ih>) {
- my($line) = $self->preprocess_line($ih, $_);
+ my $line = $self->preprocess_line($ih, $_);
## Push the line onto the array for this file
push(@{$filecache{$input}}, $line);
@@ -116,13 +112,12 @@ sub read_file {
sub cached_file_read {
- my($self) = shift;
- my($input) = shift;
- my($lines) = $filecache{$input};
+ my($self, $input) = @_;
+ my $lines = $filecache{$input};
if (defined $lines) {
- my($status) = 1;
- my($error) = undef;
+ my $status = 1;
+ my $error;
$self->{'line_number'} = 0;
foreach my $line (@$lines) {
++$self->{'line_number'};
@@ -140,35 +135,30 @@ sub cached_file_read {
sub get_line_number {
- my($self) = shift;
- return $self->{'line_number'};
+ return $_[0]->{'line_number'};
}
sub set_line_number {
- my($self) = shift;
- my($number) = shift;
+ my($self, $number) = @_;
$self->{'line_number'} = $number;
}
sub slash_to_backslash {
- my($self) = shift;
- my($file) = shift;
+ my($self, $file) = @_;
$file =~ s/\//\\/g;
return $file;
}
sub get_include_path {
- my($self) = shift;
- return $self->{'include'};
+ return $_[0]->{'include'};
}
sub search_include_path {
- my($self) = shift;
- my($file) = shift;
+ my($self, $file) = @_;
foreach my $include ('.', @{$self->{'include'}}) {
if (-r "$include/$file") {
@@ -181,8 +171,7 @@ sub search_include_path {
sub escape_regex_special {
- my($self) = shift;
- my($name) = shift;
+ my($self, $name) = @_;
$name =~ s/([\+\-\\\$\[\]\(\)\.])/\\$1/g;
return $name;
diff --git a/modules/ProjectCreator.pm b/modules/ProjectCreator.pm
index 62dba7ad..12e3a7be 100644
--- a/modules/ProjectCreator.pm
+++ b/modules/ProjectCreator.pm
@@ -27,51 +27,51 @@ use vars qw(@ISA);
# ************************************************************
## The basic extensions known to a project creator
-my($BaseClassExtension) = 'mpb';
-my($ProjectCreatorExtension) = 'mpc';
-my($TemplateExtension) = 'mpd';
-my($TemplateInputExtension) = 'mpt';
+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';
+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) = ('exename' => 1,
- 'sharedname' => 1,
- 'staticname' => 1,
- 'libpaths' => 3,
- 'recursive_libpaths' => 3,
- 'exeout' => 1,
- 'includes' => 3,
- 'recursive_includes' => 3,
- 'after' => 1,
- 'custom_only' => 1,
- 'libs' => 2,
- 'lit_libs' => 2,
- 'managed' => 1,
- 'pure_libs' => 2,
- 'pch_header' => 1,
- 'pch_source' => 1,
- 'prebuild' => 5,
- 'postbuild' => 5,
- 'dllout' => 1,
- 'libout' => 1,
- 'dynamicflags' => 3,
- 'staticflags' => 3,
- 'version' => 1,
- 'recurse' => 1,
- 'requires' => 3,
- 'avoids' => 3,
- 'tagname' => 1,
- 'tagchecks' => 1,
- 'macros' => 3,
- 'webapp' => 1,
- );
+my %validNames = ('exename' => 1,
+ 'sharedname' => 1,
+ 'staticname' => 1,
+ 'libpaths' => 3,
+ 'recursive_libpaths' => 3,
+ 'exeout' => 1,
+ 'includes' => 3,
+ 'recursive_includes' => 3,
+ 'after' => 1,
+ 'custom_only' => 1,
+ 'libs' => 2,
+ 'lit_libs' => 2,
+ 'managed' => 1,
+ 'pure_libs' => 2,
+ 'pch_header' => 1,
+ 'pch_source' => 1,
+ 'prebuild' => 5,
+ 'postbuild' => 5,
+ 'dllout' => 1,
+ 'libout' => 1,
+ 'dynamicflags' => 3,
+ 'staticflags' => 3,
+ 'version' => 1,
+ 'recurse' => 1,
+ 'requires' => 3,
+ 'avoids' => 3,
+ 'tagname' => 1,
+ 'tagchecks' => 1,
+ 'macros' => 3,
+ 'webapp' => 1,
+ );
## Custom definitions only
## Bit Meaning
@@ -80,144 +80,144 @@ my(%validNames) = ('exename' => 1,
## 2 Value is always scalar
## 3 Name can also be used in an 'optional' clause
## 4 Needs <%...%> conversion
-my(%customDefined) = ('automatic' => 0x04,
- 'dependent' => 0x14,
- 'command' => 0x14,
- 'commandflags' => 0x14,
- 'precommand' => 0x14,
- 'postcommand' => 0x14,
- 'inputext' => 0x01,
- 'libpath' => 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,
- 'source_outputext' => 0x0a,
- 'template_outputext' => 0x0a,
- 'header_outputext' => 0x0a,
- 'inline_outputext' => 0x0a,
- 'documentation_outputext' => 0x0a,
- 'resource_outputext' => 0x0a,
- 'generic_outputext' => 0x0a,
- );
+my %customDefined = ('automatic' => 0x04,
+ 'dependent' => 0x14,
+ 'command' => 0x14,
+ 'commandflags' => 0x14,
+ 'precommand' => 0x14,
+ 'postcommand' => 0x14,
+ 'inputext' => 0x01,
+ 'libpath' => 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,
+ '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,
- );
+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',
- );
+my @default_matching_assignments = ('recurse',
+ );
## These matching assingment arrays will get added, but only to the
## specific project component types.
-my(%default_matching_assignments) = ('source_files' => ['buildflags',
- 'managed',
- 'no_pch',
- ],
- );
+my %default_matching_assignments = ('source_files' => ['buildflags',
+ 'managed',
+ 'no_pch',
+ ],
+ );
## 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/';
+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';
+my $generic_key = 'generic_files';
# ************************************************************
# C++ Specific Component Settings
# ************************************************************
## 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" ],
- 'resource_files' => [ "\\.rc", ],
- );
+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" ],
+ 'resource_files' => [ "\\.rc", ],
+ );
## Exclude these extensions when auto generating the component values
-my(%cppec) = ('source_files' => $cppvc{'template_files'},
- );
+my %cppec = ('source_files' => $cppvc{'template_files'},
+ );
# ************************************************************
# C# Specific Component Settings
# ************************************************************
## Valid component names within a project along with the valid file extensions
-my(%csvc) = ('source_files' => [ "\\.cs" ],
- 'config_files' => [ "\\.config" ],
- 'resx_files' => [ "\\.resx", "\\.resources" ],
- 'aspx_files' => [ "\\.aspx" ],
- 'ico_files' => [ "\\.ico" ],
- 'documentation_files' => [ "README", "readme", "\\.doc", "\\.txt", "\\.html" ],
- );
+my %csvc = ('source_files' => [ "\\.cs" ],
+ 'config_files' => [ "\\.config" ],
+ 'resx_files' => [ "\\.resx", "\\.resources" ],
+ 'aspx_files' => [ "\\.aspx" ],
+ 'ico_files' => [ "\\.ico" ],
+ 'documentation_files' => [ "README", "readme", "\\.doc", "\\.txt", "\\.html" ],
+ );
-my(%csma) = ('source_files' => [ 'dependent_upon',
- 'subtype',
- ],
- 'resx_files' => [ 'dependent_upon',
- 'generates_source',
- 'subtype',
- ],
- );
+my %csma = ('source_files' => [ 'dependent_upon',
+ 'subtype',
+ ],
+ 'resx_files' => [ '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" ],
- );
+my %jvc = ('source_files' => [ "\\.java" ],
+ 'documentation_files' => [ "README", "readme", "\\.doc", "\\.txt", "\\.html" ],
+ );
# ************************************************************
# Visual Basic Specific Component Settings
# ************************************************************
## Valid component names within a project along with the valid file extensions
-my(%vbvc) = ('source_files' => [ "\\.vb" ],
- 'config_files' => [ "\\.config" ],
- 'resx_files' => [ "\\.resx" ],
- 'aspx_files' => [ "\\.aspx" ],
- 'ico_files' => [ "\\.ico" ],
- 'documentation_files' => [ "README", "readme", "\\.doc", "\\.txt", "\\.html" ],
- );
+my %vbvc = ('source_files' => [ "\\.vb" ],
+ 'config_files' => [ "\\.config" ],
+ 'resx_files' => [ "\\.resx" ],
+ 'aspx_files' => [ "\\.aspx" ],
+ 'ico_files' => [ "\\.ico" ],
+ 'documentation_files' => [ "README", "readme", "\\.doc", "\\.txt", "\\.html" ],
+ );
-my(%vbma) = ('source_files' => [ 'subtype' ],
- );
+my %vbma = ('source_files' => [ 'subtype' ],
+ );
# ************************************************************
# Language Specific Component Settings
@@ -230,57 +230,28 @@ my(%vbma) = ('source_files' => [ 'subtype' ],
# 2 Assignments available in standard file types
# 3 The entry point for executables
# 4 The language uses a C preprocessor
-my(%language) = ('cplusplus' => [ \%cppvc, \%cppec, {} , 'main', 1 ],
- 'csharp' => [ \%csvc, {}, \%csma, 'Main', 0 ],
- 'java' => [ \%jvc, {}, {} , 'main', 0 ],
- 'vb' => [ \%vbvc, {}, \%vbma, 'Main', 0 ],
- );
-my(%mains) = ();
+my %language = ('cplusplus' => [ \%cppvc, \%cppec, {} , 'main', 1 ],
+ 'csharp' => [ \%csvc, {}, \%csma, 'Main', 0 ],
+ 'java' => [ \%jvc, {}, {} , 'main', 0 ],
+ 'vb' => [ \%vbvc, {}, \%vbma, 'Main', 0 ],
+ );
+my %mains;
# ************************************************************
# Subroutine Section
# ************************************************************
sub new {
- my($class) = shift;
- my($global) = shift;
- my($inc) = shift;
- my($template) = shift;
- my($ti) = shift;
- my($dynamic) = shift;
- my($static) = shift;
- my($relative) = shift;
- my($addtemp) = shift;
- my($addproj) = shift;
- my($progress) = shift;
- my($toplevel) = shift;
- my($baseprojs) = shift;
- my($gfeature) = shift;
- my($relative_f) = shift;
- my($feature) = shift;
- my($features) = shift;
- my($hierarchy) = shift;
- my($exclude) = shift;
- my($makeco) = shift;
- my($nmod) = shift;
- my($applypj) = shift;
- my($genins) = shift;
- my($into) = shift;
- my($language) = shift;
- my($use_env) = shift;
- my($expandvars) = shift;
- my($gendot) = shift;
- my($comments) = shift;
- my($foreclipse) = shift;
- 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');
+ 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;
@@ -335,9 +306,9 @@ sub is_keyword {
sub read_global_configuration {
- my($self) = shift;
- my($input) = $self->get_global_cfg();
- my($status) = 1;
+ 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
@@ -364,7 +335,7 @@ sub convert_to_template_assignment {
## 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();
+ my $atemp = $self->get_addtemp();
foreach my $key (grep(/::$name$/, keys %$atemp)) {
$self->update_template_variable(0, $calledfrom, $key, $value);
}
@@ -464,7 +435,7 @@ sub process_assignment {
## 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};
+ my $mapped = $self->{'valid_names'}->{$name};
if (defined $mapped && UNIVERSAL::isa($mapped, 'ARRAY')) {
$self->parse_scoped_assignment($$mapped[0], 0,
$$mapped[1], $value,
@@ -530,7 +501,7 @@ sub get_assignment_for_modification {
## 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};
+ my $mapped = $self->{'valid_names'}->{$name};
if (defined $mapped && UNIVERSAL::isa($mapped, 'ARRAY')) {
$name = $$mapped[1];
@@ -539,7 +510,7 @@ sub get_assignment_for_modification {
}
## Get the assignment value
- my($value) = $self->get_assignment($name, $assign);
+ 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
@@ -555,18 +526,18 @@ sub get_assignment_for_modification {
sub begin_project {
my($self, $parents) = @_;
- my($status) = 1;
- my($error) = undef;
+ 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();
+ my $baseprojs = $self->get_baseprojs();
if (defined $parents) {
foreach my $base (@$baseprojs) {
- my($found) = 0;
+ my $found = 0;
foreach my $parent (@$parents) {
if ($base eq $parent) {
$found = 1;
@@ -586,8 +557,8 @@ sub begin_project {
if (defined $parents) {
foreach my $parent (@$parents) {
## Read in the parent onto ourself
- my($file) = $self->search_include_path(
- "$parent.$BaseClassExtension");
+ my $file = $self->search_include_path(
+ "$parent.$BaseClassExtension");
if (!defined $file) {
$file = $self->search_include_path(
"$parent.$ProjectCreatorExtension");
@@ -611,11 +582,11 @@ sub begin_project {
push(@{$self->{'reading_parent'}}, $file);
## Collect up some information about the inheritance tree
- my($tree) = $self->{'current_input'};
+ my $tree = $self->{'current_input'};
if (!defined $self->{'inheritance_tree'}->{$tree}) {
$self->{'inheritance_tree'}->{$tree} = {};
}
- my($hash) = $self->{'inheritance_tree'}->{$tree};
+ my $hash = $self->{'inheritance_tree'}->{$tree};
foreach my $p (@{$self->{'reading_parent'}}) {
if (!defined $$hash{$p}) {
$$hash{$p} = {};
@@ -670,11 +641,11 @@ sub begin_project {
sub get_process_project_type {
my($self, $types) = @_;
- my($type) = '';
- my($defcomp) = $self->get_default_component_name();
+ my $type = '';
+ my $defcomp = $self->get_default_component_name();
foreach my $t (split(/\s*,\s*/, $types)) {
- my($not) = ($t =~ s/^!\s*//);
+ my $not = ($t =~ s/^!\s*//);
if ($not) {
if ($t eq $self->{'pctype'}) {
$type = '';
@@ -708,8 +679,8 @@ sub parse_line {
if ($status && defined $values[0]) {
if ($values[0] eq $self->{'grammar_type'}) {
- my($name) = $values[1];
- my($typecheck) = $self->{'type_check'};
+ my $name = $values[1];
+ my $typecheck = $self->{'type_check'};
if (defined $name && $name eq '}') {
## Project Ending
if (!defined $self->{'reading_parent'}->[0] &&
@@ -719,7 +690,7 @@ sub parse_line {
## Perform any additions, subtractions
## or overrides for the project values.
- my($addproj) = $self->get_addproj();
+ my $addproj = $self->get_addproj();
foreach my $ap (keys %$addproj) {
if (defined $self->{'valid_names'}->{$ap}) {
foreach my $val (@{$$addproj{$ap}}) {
@@ -757,11 +728,11 @@ sub parse_line {
if ($status == 1) {
## Save the library name and location
foreach my $name ('sharedname', 'staticname') {
- my($val) = $self->get_assignment($name);
+ my $val = $self->get_assignment($name);
if (defined $val) {
- my($cwd) = $self->getcwd();
- my($start) = $self->getstartdir();
- my($amount) = 0;
+ my $cwd = $self->getcwd();
+ my $start = $self->getstartdir();
+ my $amount = 0;
if ($cwd eq $start) {
$amount = length($start);
}
@@ -885,8 +856,8 @@ sub parse_line {
}
}
elsif ($values[0] eq 'component') {
- my($comp) = $values[1];
- my($name) = $values[2];
+ my $comp = $values[1];
+ my $name = $values[2];
if (defined $name) {
$name =~ s/^\(\s*//;
$name =~ s/\s*\)$//;
@@ -895,7 +866,7 @@ sub parse_line {
$name = $self->get_default_component_name();
}
- my($vc) = $self->{'valid_components'};
+ my $vc = $self->{'valid_components'};
if (defined $$vc{$comp}) {
($status, $errorString) = $self->parse_components($ih, $comp, $name);
}
@@ -906,7 +877,7 @@ sub parse_line {
$loc, $add);
}
elsif ($comp eq 'specific') {
- my($type) = $self->get_process_project_type($name);
+ my $type = $self->get_process_project_type($name);
if ($type eq $self->{'pctype'} ||
$type eq $self->get_default_component_name()) {
($status, $errorString) = $self->parse_scope(
@@ -968,11 +939,11 @@ sub parse_line {
sub parse_scoped_assignment {
my($self, $tag, $type, $name, $value, $flags) = @_;
- my($over) = {};
- my($status) = 0;
+ my $over = {};
+ my $status = 0;
## Map the assignment name on a scoped assignment
- my($mapped) = $self->{'valid_names'}->{$name};
+ my $mapped = $self->{'valid_names'}->{$name};
if (defined $mapped && UNIVERSAL::isa($mapped, 'ARRAY')) {
$name = $$mapped[1];
}
@@ -1001,7 +972,7 @@ sub parse_scoped_assignment {
## 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);
+ my $outer = $self->get_assignment($name);
$self->process_assignment($name, $outer, $flags);
}
$self->process_assignment_add($name, $value, $flags);
@@ -1010,7 +981,7 @@ sub parse_scoped_assignment {
## 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);
+ my $outer = $self->get_assignment($name);
$self->process_assignment($name, $outer, $flags);
}
$self->process_assignment_sub($name, $value, $flags);
@@ -1021,23 +992,23 @@ sub parse_scoped_assignment {
sub update_template_variable {
- my($self) = shift;
- my($check) = shift;
- my(@values) = @_;
+ 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');
+ 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) = undef;
+ my $name;
if ($values[1] =~ /(.*::)(.*)/) {
- my($base) = $1;
- my($mapped) = $self->{'valid_names'}->{$2};
+ 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];
@@ -1045,13 +1016,13 @@ sub update_template_variable {
}
## Now modify the addtemp values
- my($atemp) = $self->get_addtemp();
+ 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);
+ my $value = $self->get_assignment($name);
if (defined $value) {
$atemp->{$values[1]} = [[0, $value, undef, $name]];
}
@@ -1064,7 +1035,7 @@ sub update_template_variable {
## 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]}});
+ 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,
@@ -1081,9 +1052,9 @@ sub update_template_variable {
sub handle_unknown_assignment {
- my($self) = shift;
- my($type) = shift;
- my(@values) = @_;
+ 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
@@ -1107,10 +1078,10 @@ sub handle_scoped_unknown {
}
else {
if (!defined $self->{'expanded'}->{$type}) {
- my($ok) = 1;
+ my $ok = 1;
while($line =~ /\$(\w+)/) {
- my($name) = $1;
- my($val) = '';
+ my $name = $1;
+ my $val = '';
if ($name eq 'PWD') {
$val = $self->getcwd();
}
@@ -1145,10 +1116,10 @@ sub handle_scoped_unknown {
sub process_component_line {
my($self, $tag, $line, $flags,
$grname, $current, $excarr, $comps, $count) = @_;
- my($status) = 1;
- my($error) = undef;
- my(%exclude) = ();
- my(@values) = ();
+ 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)) {
@@ -1160,8 +1131,8 @@ sub process_component_line {
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*//);
+ 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
@@ -1176,10 +1147,10 @@ sub process_component_line {
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);
+ 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+(.*)/) {
@@ -1200,7 +1171,7 @@ sub process_component_line {
}
## Keys used internally to MPC need to be in forward slash format.
- my($key) = $line;
+ my $key = $line;
$key =~ s/\\/\//g if ($self->{'convert_slashes'});
if (defined $out) {
if (!defined $self->{'custom_special_output'}->{$tag}) {
@@ -1223,7 +1194,7 @@ sub process_component_line {
## Set up the files array. If the line contains a wild card
## character use CORE::glob() to get the files specified.
- my(@files) = ();
+ my @files;
if ($line =~ /^"([^"]+)"$/) {
push(@files, $1);
}
@@ -1255,7 +1226,7 @@ sub process_component_line {
}
else {
## Set the flag overrides for each file
- my($over) = $self->{'flag_overrides'}->{$tag};
+ my $over = $self->{'flag_overrides'}->{$tag};
if (defined $over) {
foreach my $file (@files) {
$$over{$file} = $flags;
@@ -1282,17 +1253,17 @@ sub process_component_line {
sub parse_conditional {
my($self, $fh, $types, $tag, $flags,
$grname, $current, $exclude, $comps, $count) = @_;
- my($status) = 1;
- my($error) = undef;
- my($add) = 0;
- my($type) = $self->get_process_project_type($types);
+ my $status = 1;
+ my $error;
+ my $add = 0;
+ my $type = $self->get_process_project_type($types);
if ($type eq $self->{'pctype'}) {
$add = 1;
}
while(<$fh>) {
- my($line) = $self->preprocess_line($fh, $_);
+ my $line = $self->preprocess_line($fh, $_);
if ($line eq '') {
}
@@ -1318,17 +1289,17 @@ sub parse_conditional {
sub parse_components {
my($self, $fh, $tag, $name) = @_;
- my($current) = $defgroup;
- my($status) = 1;
- my($error) = undef;
- my($names) = {};
- my($comps) = {};
- my($set) = undef;
- my(%flags) = ();
- my(@exclude) = ();
- my($custom) = defined $self->{'generated_exts'}->{$tag};
- my($grtag) = $grouped_key . $tag;
- my($grname) = undef;
+ 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
@@ -1356,9 +1327,9 @@ sub parse_components {
$$comps{$current} = [];
}
- my($count) = 0;
+ my $count = 0;
while(<$fh>) {
- my($line) = $self->preprocess_line($fh, $_);
+ my $line = $self->preprocess_line($fh, $_);
if ($line eq '') {
}
@@ -1404,9 +1375,9 @@ sub parse_components {
## 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);
+ my $groups = $self->get_assignment($grtag);
if (defined $groups) {
- my($grarray) = $self->create_array($groups);
+ my $grarray = $self->create_array($groups);
if (scalar(@$grarray) == 1 && $$grarray[0] eq $defgroup) {
$self->process_assignment($grtag, undef);
}
@@ -1433,9 +1404,9 @@ sub parse_components {
## store an array of directories that the user supplied. Otherwise,
## we just store a 1.
if (defined $specialComponents{$tag}) {
- my(@dirs) = ();
+ my @dirs;
foreach my $name (keys %$names) {
- my($comps) = $$names{$name};
+ my $comps = $$names{$name};
foreach my $comp (keys %$comps) {
foreach my $item (@{$$comps{$comp}}) {
if (-d $item) {
@@ -1460,11 +1431,11 @@ sub parse_components {
## 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) = ();
+ my $alldir = $self->get_assignment('recurse') || $flags{'recurse'};
+ my %checked;
+ my @files;
foreach my $exc (@exclude) {
- my($dname) = $self->mpc_dirname($exc);
+ my $dname = $self->mpc_dirname($exc);
if (!defined $checked{$dname}) {
$checked{$dname} = 1;
push(@files, $self->generate_default_file_list($dname,
@@ -1504,10 +1475,10 @@ sub parse_verbatim {
## 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};
+ my $array = $self->{'verbatim'}->{$type}->{$loc};
while(<$fh>) {
- my($line) = $self->preprocess_line($fh, $_);
+ my $line = $self->preprocess_line($fh, $_);
if ($line =~ /^}$/) {
## This is not an error,
@@ -1525,11 +1496,11 @@ sub parse_verbatim {
sub process_feature {
my($self, $fh, $names, $parents) = @_;
- my($status) = 1;
- my($error) = undef;
+ my $status = 1;
+ my $error;
- my($requires) = '';
- my($avoids) = '';
+ my $requires = '';
+ my $avoids = '';
foreach my $name (@$names) {
if ($name =~ /^!\s*(.*)$/) {
if ($avoids ne '') {
@@ -1559,9 +1530,9 @@ sub process_feature {
## 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;
+ my $curly = 1;
while(<$fh>) {
- my($line) = $self->preprocess_line($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
@@ -1596,7 +1567,7 @@ sub process_array_assignment {
push(@{$$aref}, @$array);
}
elsif ($type == -1) {
- my($count) = scalar(@{$$aref});
+ my $count = scalar(@{$$aref});
for(my $i = 0; $i < $count; ++$i) {
foreach my $val (@$array) {
if ($$aref->[$i] eq $val) {
@@ -1631,22 +1602,22 @@ sub parse_define_custom {
return 0, "$tag has not yet been defined and can not be modified";
}
- my($status) = 0;
- my($errorString) = "Unable to process $tag";
+ 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;
+ my @keys = keys %custom;
push(@keys, @default_matching_assignments);
$self->{'matching_assignments'}->{$tag} = \@keys;
}
- my($optname) = undef;
- my($inscope) = 0;
+ my $optname;
+ my $inscope = 0;
while(<$fh>) {
- my($line) = $self->preprocess_line($fh, $_);
+ my $line = $self->preprocess_line($fh, $_);
if ($line eq '') {
}
@@ -1676,10 +1647,10 @@ sub parse_define_custom {
}
else {
if ($line =~ /(\w+)\s*\(([^\)]+)\)\s*(\+)?=\s*(.*)/) {
- my($name) = lc($1);
- my($opt) = $2;
- my($add) = $3;
- my(@val) = split(/\s*,\s*/, $4);
+ my $name = lc($1);
+ my $opt = $2;
+ my $add = $3;
+ my @val = split(/\s*,\s*/, $4);
## Fix $opt spacing
$opt =~ s/(\&\&|\|\|)/ $1 /g;
@@ -1710,8 +1681,8 @@ sub parse_define_custom {
## 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]};
+ my $value = $self->{'generated_exts'}->{$tag}->{
+ $self->{'valid_names'}->{$key}->[1]};
if (defined $value) {
## Bypass the process_assignment() defined in this class
## to avoid unwanted keyword mapping.
@@ -1736,16 +1707,14 @@ sub parse_define_custom {
last;
}
else {
- my(@values) = ();
+ my @values;
## If this returns true, then we've found an assignment
if ($self->parse_assignment($line, \@values)) {
- my($type) = $values[0];
- my($name) = $values[1];
- my($value) = $values[2];
+ my($type, $name, $value) = @values;
if (defined $customDefined{$name}) {
if (($customDefined{$name} & 0x01) != 0) {
$value = $self->escape_regex_special($value);
- my(@array) = split(/\s*,\s*/, $value);
+ my @array = split(/\s*,\s*/, $value);
$self->process_array_assignment(
\$self->{'valid_components'}->{$tag}, $type, \@array);
}
@@ -1788,7 +1757,7 @@ sub parse_define_custom {
## 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);
+ my @array = split(/\s*,\s*/, $value);
push(@array, '') if ($#array == -1);
## Process the array assignment after adjusting the values
@@ -1806,9 +1775,9 @@ sub parse_define_custom {
}
elsif ($line =~ /^(\w+)\s+(\w+)(\s*=\s*(\w+)?)?/) {
## Check for keyword mapping here
- my($keyword) = $1;
- my($newkey) = $2;
- my($mapkey) = $4;
+ my $keyword = $1;
+ my $newkey = $2;
+ my $mapkey = $4;
if ($keyword eq 'keyword') {
if (defined $self->{'valid_names'}->{$newkey}) {
$status = 0;
@@ -1939,8 +1908,8 @@ sub remove_duplicate_addition {
if ($name eq 'macros' || $name eq 'libpaths' ||
$name eq 'includes' || $name =~ /libs$/ ||
index($name, $grouped_key) == 0) {
- my($allowed) = '';
- my(%parts) = ();
+ my $allowed = '';
+ my %parts;
## Convert the array into keys for a hash table
@parts{@{$self->create_array($nval)}} = ();
@@ -1951,7 +1920,7 @@ sub remove_duplicate_addition {
$value = $self->modify_assignment_value($name, $value);
foreach my $val (@{$self->create_array($value)}) {
if (!exists $parts{$val}) {
- my($qt) = ($val =~ /\s/ ? '"' : '');
+ my $qt = ($val =~ /\s/ ? '"' : '');
$allowed .= $qt . $val . $qt . ' ';
}
}
@@ -1966,13 +1935,13 @@ sub remove_duplicate_addition {
sub read_template_input {
my($self, $tkey) = @_;
- my($status) = 1;
- my($errorString) = undef;
- my($file) = undef;
- my($tag) = undef;
- my($ti) = $self->get_ti_override();
- my($lang) = $self->get_language();
- my($override) = undef;
+ 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) {
@@ -2047,7 +2016,7 @@ sub read_template_input {
## Process the template input file
if (defined $file) {
- my($tfile) = $self->search_include_path("$file.$TemplateInputExtension");
+ my $tfile = $self->search_include_path("$file.$TemplateInputExtension");
if (defined $tfile) {
($status, $errorString) = $ti->read_file($tfile);
}
@@ -2091,7 +2060,7 @@ sub already_added {
## Remove the leading ./
$name =~ s/^\.\///;
- my($dsname) = "./$name";
+ my $dsname = "./$name";
foreach my $file (@$array) {
return 1 if ($file eq $name || $file eq $dsname);
@@ -2131,9 +2100,9 @@ sub evaluate_optional_option {
sub process_optional_option {
my($self, $opt, $value) = @_;
- my($status) = undef;
- my(@parts) = grep(!/^$/, split(/\s+/, $opt));
- my($pcount) = scalar(@parts);
+ 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 '||') {
@@ -2182,11 +2151,11 @@ sub add_optional_filename_portion {
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);
+ my $value = $self->get_applied_custom_keyword($name,
+ $gentype, $file);
## Convert the value into a hash map for easy lookup
- my(%values) = ();
+ my %values;
if (defined $value) {
@values{split(/\s+/, $value)} = ();
}
@@ -2206,10 +2175,10 @@ sub get_pre_keyword_array {
my($self, $keyword, $gentype, $tag, $file) = @_;
## Get the general pre extension array
- my(@array) = @{$self->{'generated_exts'}->{$gentype}->{$keyword}};
+ my @array = @{$self->{'generated_exts'}->{$gentype}->{$keyword}};
## Add the component specific pre extension array
- my(@additional) = ();
+ my @additional;
$tag =~ s/files$/$keyword/;
if (defined $self->{'generated_exts'}->{$gentype}->{$tag}) {
push(@additional, @{$self->{'generated_exts'}->{$gentype}->{$tag}});
@@ -2240,11 +2209,11 @@ sub add_explicit_output {
if (defined $self->{'custom_special_output'}->{$type} &&
defined $self->{'custom_special_output'}->{$type}->{$file}) {
if (defined $self->{'valid_components'}->{$tag}) {
- my(@files) = ();
+ my @files;
foreach my $check (@{$self->{'custom_special_output'}->{$type}->{$file}}) {
foreach my $regext (@{$self->{'valid_components'}->{$tag}}) {
if ($check =~ /$regext$/) {
- my($add) = 1;
+ my $add = 1;
if ($tag eq 'source_files') {
foreach my $tregext (@{$self->{'valid_components'}->{'template_files'}}) {
if ($check =~ /$tregext$/) {
@@ -2255,7 +2224,7 @@ sub add_explicit_output {
}
if ($add) {
## If gendir was specified, then we need to account for that
- my($dir) = '';
+ my $dir = '';
if (defined $self->{'flag_overrides'}->{$type} &&
defined $self->{'flag_overrides'}->{$type}->{$file} &&
defined $self->{'flag_overrides'}->{$type}->{$file}->{'gendir'} &&
@@ -2284,16 +2253,16 @@ sub add_explicit_output {
sub generated_filenames {
my($self, $part, $type, $tag, $file, $noext, $arrs) = @_;
- my(@array) = ();
- 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(@exts) = (defined $self->{'generated_exts'}->{$type}->{$tag} ?
- @{$self->{'generated_exts'}->{$type}->{$tag}} : ());
+ my @array;
+ 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 @exts = (defined $self->{'generated_exts'}->{$type}->{$tag} ?
+ @{$self->{'generated_exts'}->{$type}->{$tag}} : ());
if (!defined $exts[0]) {
- my($backtag) = $tag;
+ my $backtag = $tag;
if ($backtag =~ s/files$/outputext/) {
$self->add_optional_filename_portion($type, $backtag,
$file, \@exts);
@@ -2306,8 +2275,8 @@ sub generated_filenames {
## is nothing for us to do.
}
else {
- my($dir) = '';
- my($base) = undef;
+ my $dir = '';
+ my $base;
## Correctly deal with pre filename and directories
if ($part =~ /(.*[\/\\])([^\/\\]+)$/) {
@@ -2333,7 +2302,7 @@ sub generated_filenames {
## Loop through creating all of the possible file names
foreach my $pe (@pearr) {
- my(@genfile) = ();
+ my @genfile;
$pe =~ s/\\\././g;
foreach my $pf (@pfarr) {
$pf =~ s/\\\././g;
@@ -2368,7 +2337,7 @@ sub add_generated_files {
## actual file insertion and grouping.
## Get the generated filenames
- my(@added) = ();
+ my @added;
foreach my $file (keys %$arr) {
foreach my $gen ($self->generated_filenames($$arr{$file}, $gentype,
$tag, $file, 1)) {
@@ -2377,12 +2346,12 @@ sub add_generated_files {
}
if (defined $added[0]) {
- my($names) = $self->{$tag};
+ 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) = ();
+ my @all;
+ my %dircomp;
foreach my $name (keys %$names) {
foreach my $key (keys %{$$names{$name}}) {
push(@all, @{$$names{$name}->{$key}});
@@ -2395,7 +2364,7 @@ sub add_generated_files {
## 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) = ();
+ my @oktoadd;
foreach my $file (@added) {
if (!$self->already_added(\@all, $file)) {
push(@oktoadd, $file);
@@ -2405,10 +2374,10 @@ sub add_generated_files {
## 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])});
+ my $key = (defined $group ? $group :
+ $dircomp{$self->mpc_dirname($oktoadd[0])});
if (!defined $key) {
- my($check) = $oktoadd[0];
+ my $check = $oktoadd[0];
foreach my $regext (@{$self->{'valid_components'}->{$tag}}) {
if ($check =~ s/$regext$//) {
last;
@@ -2420,7 +2389,7 @@ sub add_generated_files {
foreach my $ckey (keys %{$self->{$vc}->{$name}}) {
if ($ckey ne $defgroup) {
foreach my $ofile (@{$self->{$vc}->{$name}->{$ckey}}) {
- my($file) = $ofile;
+ my $file = $ofile;
foreach my $regext (@{$self->{'valid_components'}->{$vc}}) {
if ($file =~ s/$regext$//) {
last;
@@ -2461,12 +2430,12 @@ sub add_generated_files {
sub search_for_entry {
my($self, $file, $marray, $preproc) = @_;
- my($name) = undef;
- my($fh) = new FileHandle();
+ my $name;
+ my $fh = new FileHandle();
if (open($fh, $file)) {
- my($poundifed) = 0;
- my($commented) = 0;
+ my $poundifed = 0;
+ my $commented = 0;
while(<$fh>) {
if (!$commented) {
@@ -2553,12 +2522,12 @@ sub find_main_file {
sub generate_default_target_names {
- my($self) = shift;
+ my $self = shift;
if (!$self->exe_target()) {
- my($sharedname) = $self->get_assignment('sharedname');
- my($staticname) = $self->get_assignment('staticname');
- my($shared_empty) = undef;
+ my $sharedname = $self->get_assignment('sharedname');
+ my $staticname = $self->get_assignment('staticname');
+ my $shared_empty;
if (defined $sharedname) {
if ($sharedname eq '') {
@@ -2580,8 +2549,8 @@ sub generate_default_target_names {
## 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);
+ my @sources = $self->get_component_list('source_files', 1);
+ my $exename = $self->find_main_file(\@sources);
if (defined $exename) {
$self->process_assignment('exename', $exename);
}
@@ -2608,7 +2577,7 @@ sub generate_default_target_names {
## 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');
+ my $sharedname = $self->get_assignment('sharedname');
if (defined $sharedname) {
$self->process_assignment('sharedname', undef);
}
@@ -2616,7 +2585,7 @@ sub generate_default_target_names {
## Check for the use of an asterisk in the name
foreach my $key ('exename', 'sharedname', 'staticname') {
- my($value) = $self->get_assignment($key);
+ my $value = $self->get_assignment($key);
if (defined $value && index($value, '*') >= 0) {
$value = $self->fill_type_name($value,
$self->{'unmodified_project_name'});
@@ -2628,15 +2597,15 @@ sub generate_default_target_names {
sub generate_default_pch_filenames {
my($self, $files) = @_;
- my($pchhdef) = (defined $self->get_assignment('pch_header'));
- my($pchcdef) = (defined $self->get_assignment('pch_source'));
+ 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) = undef;
- my($cmatching) = undef;
+ 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
@@ -2678,9 +2647,9 @@ sub generate_default_pch_filenames {
sub fix_pch_filenames {
- my($self) = shift;
+ my $self = shift;
foreach my $type ('pch_header', 'pch_source') {
- my($pch) = $self->get_assignment($type);
+ my $pch = $self->get_assignment($type);
if (defined $pch && $pch eq '') {
$self->process_assignment($type, undef);
}
@@ -2689,12 +2658,12 @@ sub fix_pch_filenames {
sub remove_extra_pch_listings {
- my($self) = shift;
- my(@pchs) = ('pch_header', 'pch_source');
- my(@tags) = ('header_files', 'source_files');
+ 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]);
+ my $pch = $self->get_assignment($pchs[$j]);
if (defined $pch) {
## If we are converting slashes, then we need to
@@ -2702,12 +2671,12 @@ sub remove_extra_pch_listings {
$pch =~ s/\\/\//g if ($self->{'convert_slashes'});
## Find out which files are duplicated
- my($names) = $self->{$tags[$j]};
+ my $names = $self->{$tags[$j]};
foreach my $name (keys %$names) {
- my($comps) = $$names{$name};
+ my $comps = $$names{$name};
foreach my $key (keys %$comps) {
- my($array) = $$comps{$key};
- my($count) = scalar(@$array);
+ my $array = $$comps{$key};
+ my $count = scalar(@$array);
for(my $i = 0; $i < $count; ++$i) {
if ($pch eq $$array[$i]) {
splice(@$array, $i, 1);
@@ -2723,9 +2692,9 @@ sub remove_extra_pch_listings {
sub sift_files {
my($self, $files, $exts, $pchh, $pchc, $tag, $array, $alldir) = @_;
- my(@saved) = ();
- my($saverc) = (!$alldir && $tag eq 'resource_files');
- my($havec) = (defined $self->{'exclude_components'}->{$tag});
+ my @saved;
+ my $saverc = (!$alldir && $tag eq 'resource_files');
+ my $havec = (defined $self->{'exclude_components'}->{$tag});
foreach my $ext (@$exts) {
foreach my $file (grep(/$ext$/, @$files)) {
@@ -2733,7 +2702,7 @@ sub sift_files {
if ((!defined $pchh || $file ne $pchh) &&
(!defined $pchc || $file ne $pchc)) {
if ($havec) {
- my($exclude) = 0;
+ my $exclude = 0;
foreach my $exc (@{$self->{'exclude_components'}->{$tag}}) {
if ($file =~ /$exc$/) {
$exclude = 1;
@@ -2764,9 +2733,9 @@ sub sift_files {
push(@$array, $saved[0]);
}
else {
- my($pjname) = $self->escape_regex_special(
- $self->transform_file_name(
- $self->get_assignment('project_name')));
+ 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) {
@@ -2783,11 +2752,11 @@ sub sift_files {
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);
+ 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);
}
@@ -2797,18 +2766,18 @@ sub correct_generated_files {
my($self, $defcomp, $exts, $tag, $array) = @_;
if (defined $sourceComponents{$tag}) {
- my($grtag) = $grouped_key . $tag;
+ my $grtag = $grouped_key . $tag;
foreach my $gentype (keys %{$self->{'generated_exts'}}) {
## 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) = undef;
- my(@input) = ();
+ 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};
+ my $names = $self->{$gentype};
foreach my $name (keys %$names) {
foreach my $key (keys %{$$names{$name}}) {
push(@input, @{$$names{$name}->{$key}});
@@ -2819,22 +2788,22 @@ sub correct_generated_files {
}
if (defined $input[0]) {
- my(@front) = ();
- my(@copy) = @$array;
+ my @front;
+ my @copy = @$array;
@$array = ();
foreach my $input (@input) {
- my($part) = $self->remove_wanted_extension(
- $input,
- $self->{'valid_components'}->{$gentype});
+ my $part = $self->remove_wanted_extension(
+ $input,
+ $self->{'valid_components'}->{$gentype});
- my(@files) = $self->generated_filenames($part, $gentype,
- $tag, $input);
+ my @files = $self->generated_filenames($part, $gentype,
+ $tag, $input);
if (defined $copy[0]) {
- my($found) = 0;
+ my $found = 0;
foreach my $file (@files) {
for(my $i = 0; $i < scalar(@copy); $i++) {
- my($re) = $self->escape_regex_special($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.
@@ -2854,12 +2823,12 @@ sub correct_generated_files {
## file extension and see if it matches one in the accepted
## extensions.
if (defined $files[0]) {
- my($ext) = undef;
+ my $ext;
if ($files[0] =~ /.*(\.[^\.]+)$/) {
$ext = $self->escape_regex_special($1);
}
if (defined $ext) {
- my($efound) = undef;
+ my $efound;
foreach my $possible (@$exts) {
if ($ext eq $possible) {
$efound = 1;
@@ -2882,7 +2851,7 @@ sub correct_generated_files {
}
}
else {
- my($ext) = $$exts[0];
+ my $ext = $$exts[0];
foreach my $file (@files) {
if ($file =~ /$ext$/) {
push(@front, $file);
@@ -2923,23 +2892,23 @@ sub correct_generated_files {
sub generate_default_components {
my($self, $files, $passed) = @_;
- my($vc) = $self->{'valid_components'};
- my($ovc) = $language{$self->get_language()}->[0];
- my(@tags) = (defined $passed ? $passed :
- sort { if (defined $$ovc{$a}) {
- if (!defined $$ovc{$b}) {
- return 1;
- }
- }
- elsif (defined $$ovc{$b}) {
- return -1;
- }
- return $a cmp $b;
- } keys %$vc);
- 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 $vc = $self->{'valid_components'};
+ my $ovc = $language{$self->get_language()}->[0];
+ my @tags = (defined $passed ? $passed :
+ sort { if (defined $$ovc{$a}) {
+ if (!defined $$ovc{$b}) {
+ return 1;
+ }
+ }
+ elsif (defined $$ovc{$b}) {
+ return -1;
+ }
+ return $a cmp $b;
+ } keys %$vc);
+ 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();
## The order of @tags does make a difference in the way that generated
## files get added. Hence the sort call on the valid component keys to
@@ -2948,21 +2917,21 @@ sub generate_default_components {
foreach my $tag (@tags) {
if (!defined $self->{'generated_exts'}->{$tag} ||
$self->{'generated_exts'}->{$tag}->{'automatic'}) {
- my($exts) = $$vc{$tag};
+ my $exts = $$vc{$tag};
if (defined $$exts[0]) {
if (defined $self->{$tag}) {
## If the tag is defined, then process directories
- my($names) = $self->{$tag};
+ my $names = $self->{$tag};
foreach my $name (keys %$names) {
- my($comps) = $$names{$name};
+ my $comps = $$names{$name};
foreach my $comp (keys %$comps) {
- my($array) = $$comps{$comp};
+ my $array = $$comps{$comp};
if (defined $passed) {
$self->sift_files($files, $exts, $pchh, $pchc, $tag, $array);
}
else {
- my(@built) = ();
- my($alldirs) = 1;
+ my @built;
+ my $alldirs = 1;
foreach my $file (@$array) {
if (-d $file) {
my @portion;
@@ -3003,10 +2972,10 @@ sub generate_default_components {
else {
## Generate default values for undefined tags
$self->{$tag} = {};
- my($comps) = {};
+ my $comps = {};
$self->{$tag}->{$defcomp} = $comps;
$$comps{$defgroup} = [];
- my($array) = $$comps{$defgroup};
+ my $array = $$comps{$defgroup};
$self->{'defaulted'}->{$tag} = 1;
@@ -3023,9 +2992,9 @@ sub generate_default_components {
sub remove_duplicated_files {
my($self, $dest, $source) = @_;
- my($names) = $self->{$dest};
- my(@slist) = $self->get_component_list($source, 1);
- my(%shash) = ();
+ my $names = $self->{$dest};
+ my @slist = $self->get_component_list($source, 1);
+ my %shash;
## Convert the array into keys for a hash table
@shash{@slist} = ();
@@ -3033,8 +3002,8 @@ sub remove_duplicated_files {
## Find out which source files are listed
foreach my $name (keys %$names) {
foreach my $key (keys %{$$names{$name}}) {
- my($array) = $$names{$name}->{$key};
- my($count) = scalar(@$array);
+ 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]}) {
@@ -3051,11 +3020,11 @@ sub remove_duplicated_files {
sub generated_source_listed {
my($self, $gent, $tag, $arr, $sext) = @_;
- my($names) = $self->{$tag};
+ my $names = $self->{$tag};
## Find out which generated source files are listed
foreach my $name (keys %$names) {
- my($comps) = $$names{$name};
+ my $comps = $$names{$name};
foreach my $key (keys %$comps) {
foreach my $val (@{$$comps{$key}}) {
foreach my $i (keys %$arr) {
@@ -3088,12 +3057,12 @@ sub list_default_generated {
## need to add the generated files
if (defined $self->{$gentype}) {
## Build up the list of files
- my(%arr) = ();
- my($names) = $self->{$gentype};
- my($group) = undef;
+ my %arr;
+ my $names = $self->{$gentype};
+ my $group;
foreach my $name (keys %$names) {
foreach my $key (keys %{$$names{$name}}) {
- my($array) = $$names{$name}->{$key};
+ my $array = $$names{$name}->{$key};
if ($key ne $defgroup) {
$group = $key;
@@ -3127,11 +3096,11 @@ sub list_default_generated {
sub prepend_gendir {
my($self, $created, $ofile, $gentype) = @_;
- my($key) = undef;
+ my $key;
if (defined $self->{'flag_overrides'}->{$gentype}) {
foreach my $ext (@{$self->{'valid_components'}->{$gentype}}) {
- my($e) = $ext;
+ my $e = $ext;
$e =~ s/\\//g;
$key = "$ofile$e";
if (defined $self->{'flag_overrides'}->{$gentype}->{$key}) {
@@ -3145,7 +3114,7 @@ sub prepend_gendir {
if (defined $key) {
foreach my $ma (@{$self->{'matching_assignments'}->{$gentype}}) {
if ($ma eq 'gendir') {
- my($dir) = $self->{'flag_overrides'}->{$gentype}->{$key}->{$ma};
+ my $dir = $self->{'flag_overrides'}->{$gentype}->{$key}->{$ma};
if (defined $dir) {
## Convert the file to unix style for basename
$created =~ s/\\/\//g;
@@ -3164,18 +3133,18 @@ sub prepend_gendir {
sub list_generated_file {
my($self, $gentype, $tag, $array, $file, $ofile) = @_;
- my($count) = 0;
+ my $count = 0;
## Save the length of the basename for later. We can not convert the
## slashes on $file as it needs to keep the back slashes since that's
## what comes from generated_filenames() below. This is, of course, if
## we are converting slashes in the first place.
- my($fcopy) = $file;
+ my $fcopy = $file;
$fcopy =~ s/.*[\/\\]//;
- my($blen) = length($fcopy);
+ my $blen = length($fcopy);
foreach my $gen ($self->get_component_list($gentype, 1)) {
- my($input) = $gen;
+ my $input = $gen;
foreach my $ext (@{$self->{'valid_components'}->{$gentype}}) {
## Remove the extension.
## If it works, then we can exit this loop.
@@ -3224,13 +3193,13 @@ sub list_generated_file {
sub add_corresponding_component_files {
my($self, $filecomp, $tag) = @_;
- my($grname) = $grouped_key . $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};
+ 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} &&
@@ -3243,17 +3212,17 @@ sub add_corresponding_component_files {
}
## Create an array of extensions for the files we want to add
- my(@exts) = ();
+ 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;
+ my $adddefaultgroup = 0;
+ my $oktoadddefault = 0;
foreach my $sfile (keys %$filecomp) {
- my($found) = 0;
+ my $found = 0;
foreach my $ext (@exts) {
if (exists $scfiles{"$sfile$ext"}) {
$found = 1;
@@ -3263,8 +3232,8 @@ sub add_corresponding_component_files {
if (!$found) {
## Get the array of files for the selected component name
- my($array) = [];
- my($comp) = $$filecomp{$sfile};
+ my $array = [];
+ my $comp = $$filecomp{$sfile};
foreach my $name (keys %$names) {
if (defined $$names{$name}->{$comp}) {
$array = $$names{$name}->{$comp};
@@ -3281,7 +3250,7 @@ sub add_corresponding_component_files {
if (!$found) {
foreach my $ext (@exts) {
if (-r "$sfile$ext") {
- my($file) = "$sfile$ext";
+ my $file = "$sfile$ext";
if (!$self->already_added($array, $file)) {
push(@$array, $file);
++$found;
@@ -3298,8 +3267,8 @@ sub add_corresponding_component_files {
$adddefaultgroup = 1;
}
else {
- my($compexists) = undef;
- my($grval) = $self->get_assignment($grname);
+ my $compexists;
+ my $grval = $self->get_assignment($grname);
if (defined $grval) {
foreach my $grkey (@{$self->create_array($grval)}) {
if ($grkey eq $comp) {
@@ -3337,8 +3306,8 @@ sub add_corresponding_component_files {
sub get_default_project_name {
- my($self) = shift;
- my($name) = $self->{'current_input'};
+ my $self = shift;
+ my $name = $self->{'current_input'};
if ($name eq '') {
$name = $self->transform_file_name($self->base_directory());
@@ -3360,17 +3329,17 @@ sub get_default_project_name {
sub remove_excluded {
- my($self) = shift;
- my(@tags) = @_;
+ my $self = shift;
+ my @tags = @_;
## Process each file type and remove the excluded files
foreach my $tag (@tags) {
- my($names) = $self->{$tag};
+ my $names = $self->{$tag};
foreach my $name (keys %$names) {
foreach my $comp (keys %{$$names{$name}}) {
- my($count) = scalar(@{$$names{$name}->{$comp}});
+ my $count = scalar(@{$$names{$name}->{$comp}});
for(my $i = 0; $i < $count; ++$i) {
- my($file) = $$names{$name}->{$comp}->[$i];
+ my $file = $$names{$name}->{$comp}->[$i];
if (defined $self->{'remove_files'}->{$tag}->{$file}) {
splice(@{$$names{$name}->{$comp}}, $i, 1);
--$i;
@@ -3405,7 +3374,7 @@ sub remove_excluded {
sub generate_defaults {
- my($self) = shift;
+ my $self = shift;
## Generate default project name
if (!defined $self->get_assignment('project_name')) {
@@ -3413,9 +3382,9 @@ sub generate_defaults {
}
## Generate the default pch file names (if needed)
- my(@files) = $self->generate_default_file_list(
- '.', [],
- undef, $self->get_assignment('recurse'));
+ 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
@@ -3437,9 +3406,9 @@ sub generate_defaults {
## 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) = reverse sort { return 1 if $a eq 'source_files';
- return -1 if $b eq 'source_files';
- return $a cmp $b; } keys %{$self->{'valid_components'}};
+ my @vc = reverse sort { return 1 if $a eq 'source_files';
+ return -1 if $b eq 'source_files';
+ return $a cmp $b; } keys %{$self->{'valid_components'}};
foreach my $gentype (keys %{$self->{'generated_exts'}}) {
$self->list_default_generated($gentype, \@vc);
}
@@ -3450,13 +3419,13 @@ sub generate_defaults {
## Collect up all of the source files that have already been listed
## with the extension removed.
- my(%sourcecomp) = ();
+ my %sourcecomp;
foreach my $sourcetag (keys %sourceComponents) {
- my($names) = $self->{$sourcetag};
+ my $names = $self->{$sourcetag};
foreach my $name (keys %$names) {
foreach my $comp (keys %{$$names{$name}}) {
foreach my $sfile (@{$$names{$name}->{$comp}}) {
- my($mod) = $sfile;
+ my $mod = $sfile;
$mod =~ s/\.[^\.]+$//;
$sourcecomp{$mod} = $comp;
}
@@ -3475,14 +3444,14 @@ sub generate_defaults {
foreach my $tag (keys %specialComponents) {
if (!$self->{'special_supplied'}->{$tag} ||
UNIVERSAL::isa($self->{'special_supplied'}->{$tag}, 'ARRAY')) {
- my($names) = $self->{$tag};
+ 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'};
+ my $ok = $self->{'defaulted'}->{'source_files'};
if (!$ok) {
- my(@all) = ();
+ my @all;
foreach my $name (keys %$names) {
foreach my $key (keys %{$$names{$name}}) {
push(@all, @{$$names{$name}->{$key}});
@@ -3494,10 +3463,10 @@ sub generate_defaults {
## 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;
+ my $fileref = \@files;
if (defined $self->{'special_supplied'}->{$tag} &&
UNIVERSAL::isa($self->{'special_supplied'}->{$tag}, 'ARRAY')) {
- my(@special) = ();
+ my @special;
foreach my $dir (@{$self->{'special_supplied'}->{$tag}}) {
push(@special, $self->generate_default_file_list(
$dir, [], undef,
@@ -3513,7 +3482,7 @@ sub generate_defaults {
## 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'}};
+ my @rmkeys = keys %{$self->{'remove_files'}};
if (defined $rmkeys[0]) {
$self->remove_excluded(@rmkeys);
}
@@ -3531,7 +3500,7 @@ sub set_project_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();
+ my $nmod = $self->get_name_modifier();
if (defined $nmod) {
$nmod =~ s/\*/$name/g;
@@ -3546,28 +3515,26 @@ sub set_project_name {
sub project_name {
- my($self) = shift;
- return $self->get_assignment('project_name');
+ return $_[0]->get_assignment('project_name');
}
sub lib_target {
- my($self) = shift;
+ my $self = shift;
return (defined $self->get_assignment('sharedname') ||
defined $self->get_assignment('staticname'));
}
sub exe_target {
- my($self) = shift;
- return (defined $self->get_assignment('exename'));
+ return (defined $_[0]->get_assignment('exename'));
}
sub get_component_list {
my($self, $tag, $noconvert) = @_;
- my($names) = $self->{$tag};
- my(@list) = ();
+ my $names = $self->{$tag};
+ my @list;
foreach my $name (keys %$names) {
foreach my $key (keys %{$$names{$name}}) {
@@ -3595,7 +3562,7 @@ sub get_component_list {
sub check_custom_output {
my($self, $based, $cinput, $ainput, $type, $comps) = @_;
- my(@outputs) = ();
+ my @outputs;
foreach my $array ($self->generated_filenames($cinput, $based,
$type, $ainput, 0, 1)) {
@@ -3611,9 +3578,9 @@ sub check_custom_output {
last;
}
else {
- my($base) = $built;
+ my $base = $built;
$base =~ s/\\/\//g if ($self->{'convert_slashes'});
- my($re) = $self->escape_regex_special($self->mpc_basename($base));
+ 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.
@@ -3631,11 +3598,11 @@ sub check_custom_output {
sub get_special_value {
- my($self) = shift;
- my($type) = shift;
- my($cmd) = shift;
- my($based) = shift;
- my(@params) = @_;
+ my $self = shift;
+ my $type = shift;
+ my $cmd = shift;
+ my $based = shift;
+ my @params = @_;
if ($type eq 'feature') {
return $self->get_feature_value($cmd, $based);
@@ -3655,7 +3622,7 @@ sub get_feature_value {
my($self, $cmd, $based) = @_;
if ($cmd eq 'value') {
- my($val) = $self->{'feature_parser'}->get_value($based);
+ my $val = $self->{'feature_parser'}->get_value($based);
if (defined $val && $val != 0) {
return 1;
}
@@ -3667,7 +3634,7 @@ sub get_feature_value {
sub get_grouped_value {
my($self, $type, $cmd, $based) = @_;
- my($value) = undef;
+ my $value;
## Make it all lower case
$type = lc($type);
@@ -3680,14 +3647,14 @@ sub get_grouped_value {
$type .= 's';
}
- my($names) = $self->{$type};
+ my $names = $self->{$type};
if ($cmd eq 'files') {
foreach my $name (keys %$names) {
- my($comps) = $$names{$name};
+ my $comps = $$names{$name};
foreach my $comp (keys %$comps) {
if ($comp eq $based) {
if ($self->{'convert_slashes'}) {
- my(@converted) = ();
+ my @converted;
foreach my $file (@{$$comps{$comp}}) {
push(@converted, $self->slash_to_backslash($file));
}
@@ -3697,7 +3664,7 @@ sub get_grouped_value {
$value = $$comps{$comp};
}
if ($self->{'sort_files'}) {
- my(@sorted) = sort { $self->file_sorter($a, $b) } @$value;
+ my @sorted = sort { $self->file_sorter($a, $b) } @$value;
$value = \@sorted;
}
last;
@@ -3718,8 +3685,8 @@ sub get_grouped_value {
sub get_command_subs {
- my($self) = shift;
- my(%valid) = ();
+ my $self = shift;
+ my %valid;
## Add the built-in OS compatibility commands
if (UNIVERSAL::isa($self, 'WinProjectBase') ||
@@ -3761,10 +3728,10 @@ sub replace_parameters {
my($self, $str, $valid, $nowarn, $input, $output) = @_;
while ($str =~ /<%(\w+)(\(\w+\))?%>/) {
- my($name) = $1;
- my($modifier) = $2;
+ my $name = $1;
+ my $modifier = $2;
if (defined $modifier) {
- my($tmp) = $name;
+ my $tmp = $name;
$name = $modifier;
$name =~ s/[\(\)]//g;
$modifier = $tmp;
@@ -3772,7 +3739,7 @@ sub replace_parameters {
if (exists $$valid{$name}) {
if (defined $$valid{$name}) {
- my($replace) = $$valid{$name};
+ my $replace = $$valid{$name};
if (defined $modifier) {
if ($modifier eq 'noextension') {
$replace =~ s/\.[^\.]+$//;
@@ -3813,8 +3780,8 @@ sub replace_parameters {
sub convert_command_parameters {
my($self, $ktype, $str, $input, $output) = @_;
- my(%nowarn) = ();
- my(%valid) = %{$self->{'command_subs'}};
+ 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));
@@ -3840,10 +3807,10 @@ sub convert_command_parameters {
$valid{'gendir'} = '.' if (!defined $valid{'gendir'});
if (defined $output) {
- my($first) = 1;
+ my $first = 1;
$valid{'output'} = "@$output";
foreach my $out (@$output) {
- my($noext) = $out;
+ my $noext = $out;
$noext =~ s/(\.[^\.]+)$//;
$valid{'output_ext'} = $1;
@@ -3857,7 +3824,7 @@ sub convert_command_parameters {
## Add in the specific types of output files
if (defined $output) {
foreach my $type (keys %{$self->{'valid_components'}}) {
- my($key) = $type;
+ my $key = $type;
$key =~ s/s$//gi;
$nowarn{$key} = 1;
$nowarn{$key . '_noext'} = 1;
@@ -3879,20 +3846,20 @@ sub convert_command_parameters {
sub get_custom_value {
- my($self) = shift;
- my($cmd) = shift;
- my($based) = shift;
- my(@params) = @_;
- my($value) = undef;
+ 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);
+ 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) = undef;
+ my $once;
for(my $i = 0; $i < scalar(@array); ++$i) {
if (-d $array[$i]) {
if (!defined $once) {
@@ -3901,7 +3868,7 @@ sub get_custom_value {
'pchc' => $self->get_assignment('pch_source'),
};
}
- my(@built) = ();
+ my @built;
$self->sift_default_file_list($based, $array[$i], \@built,
$self->{'valid_components'}->{$based},
$$once{'recurse'},
@@ -3914,17 +3881,17 @@ sub get_custom_value {
$value = \@array;
$self->{'custom_output_files'} = {};
- my(%vcomps) = ();
+ my %vcomps;
foreach my $vc (keys %{$self->{'valid_components'}}) {
- my(@comps) = $self->get_component_list($vc);
+ 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;
+ my @outputs;
+ my $ainput = $input;
+ my $cinput = $input;
## Remove the extension
$cinput =~ s/\.[^\.]+$//;
@@ -3944,7 +3911,7 @@ sub get_custom_value {
if (defined $self->{'custom_special_output'}->{$based} &&
defined $self->{'custom_special_output'}->{$based}->{$ainput}) {
foreach my $file (@{$self->{'custom_special_output'}->{$based}->{$ainput}}) {
- my($found) = 0;
+ my $found = 0;
foreach my $output (@outputs) {
if ($output eq $file) {
$found = 1;
@@ -3984,7 +3951,7 @@ sub get_custom_value {
## 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;
+ my $matched = 0;
foreach my $text (@{$self->{'valid_components'}->{'template_files'}}) {
if ($file =~ /$text$/) {
$matched = 1;
@@ -4005,7 +3972,7 @@ sub get_custom_value {
if (defined $self->{'custom_output_files'}) {
$value = [];
foreach my $file (@{$self->{'custom_output_files'}->{$based}}) {
- my($source) = 0;
+ my $source = 0;
foreach my $ext (@{$self->{'valid_components'}->{'source_files'}}) {
if ($file =~ /$ext$/) {
$source = 1;
@@ -4028,7 +3995,7 @@ sub get_custom_value {
}
}
elsif ($cmd eq 'inputexts') {
- my(@array) = @{$self->{'valid_components'}->{$based}};
+ my @array = @{$self->{'valid_components'}->{$based}};
foreach my $val (@array) {
$val =~ s/\\\.//g;
}
@@ -4058,12 +4025,12 @@ sub get_custom_value {
sub check_features {
my($self, $requires, $avoids, $info) = @_;
- my($status) = 1;
- my($why) = undef;
+ my $status = 1;
+ my $why;
if (defined $requires) {
foreach my $require (split(/\s+/, $requires)) {
- my($fval) = $self->{'feature_parser'}->get_value($require);
+ my $fval = $self->{'feature_parser'}->get_value($require);
## By default, if the feature is not listed, then it is enabled.
if (defined $fval && !$fval) {
@@ -4084,7 +4051,7 @@ sub check_features {
if ($status) {
if (defined $avoids) {
foreach my $avoid (split(/\s+/, $avoids)) {
- my($fval) = $self->{'feature_parser'}->get_value($avoid);
+ my $fval = $self->{'feature_parser'}->get_value($avoid);
## By default, if the feature is not listed, then it is enabled.
if (!defined $fval || $fval) {
@@ -4134,9 +4101,9 @@ sub need_to_write_project {
sub write_output_file {
my($self, $webapp) = @_;
- my($status) = 0;
- my($error) = undef;
- my($tover) = $self->get_template_override();
+ my $status = 0;
+ my $error;
+ my $tover = $self->get_template_override();
my @templates = $self->get_template();
## The template override will override all templates
@@ -4160,7 +4127,7 @@ sub write_output_file {
## If the template file does not contain a path, then we
## will search through the include paths for it.
- my($tfile) = undef;
+ my $tfile;
if ($template =~ /[\/\\]/i) {
$tfile = $template;
}
@@ -4176,7 +4143,7 @@ sub write_output_file {
$self->{'current_template'});
last if (!$status);
- my($tp) = new TemplateParser($self);
+ my $tp = new TemplateParser($self);
## Set the project_file assignment for the template parser
$self->process_assignment('project_file', $name);
@@ -4185,12 +4152,12 @@ sub write_output_file {
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');
+ 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);
+ my @copy = @$cb;
+ my $s = shift(@copy);
&$s(@copy, $name, $pjname, @list);
}
elsif (UNIVERSAL::isa($cb, 'CODE')) {
@@ -4202,13 +4169,13 @@ sub write_output_file {
}
if ($self->get_toplevel()) {
- my($outdir) = $self->get_outdir();
- my($oname) = $name;
+ my $outdir = $self->get_outdir();
+ my $oname = $name;
$name = "$outdir/$name";
- my($fh) = new FileHandle();
- my($dir) = $self->mpc_dirname($name);
+ my $fh = new FileHandle();
+ my $dir = $self->mpc_dirname($name);
if ($dir ne '.') {
mkpath($dir, 0, 0777);
@@ -4220,10 +4187,10 @@ sub write_output_file {
}
elsif ($self->compare_output()) {
## First write the output to a temporary file
- my($tmp) = "$outdir/MPC$>.$$";
- my($different) = 1;
+ my $tmp = "$outdir/MPC$>.$$";
+ my $different = 1;
if (open($fh, ">$tmp")) {
- my($lines) = $tp->get_lines();
+ my $lines = $tp->get_lines();
foreach my $line (@$lines) {
print $fh $line;
}
@@ -4258,7 +4225,7 @@ sub write_output_file {
}
else {
if (open($fh, ">$name")) {
- my($lines) = $tp->get_lines();
+ my $lines = $tp->get_lines();
foreach my $line (@$lines) {
print $fh $line;
}
@@ -4291,22 +4258,22 @@ sub write_output_file {
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();
+ 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};
+ my $names = $self->{$vc};
foreach my $name (keys %$names) {
foreach my $key (keys %{$$names{$name}}) {
- my($array) = $$names{$name}->{$key};
+ my $array = $$names{$name}->{$key};
if (defined $$array[0]) {
print $fh "$vc:\n";
foreach my $file (@$array) {
@@ -4318,16 +4285,16 @@ sub write_install_file {
}
}
if ($self->exe_target()) {
- my($exeout) = $self->get_assignment('exeout');
+ 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'));
+ 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";
@@ -4350,10 +4317,10 @@ sub write_install_file {
sub write_project {
- my($self) = shift;
- my($status) = 2;
- my($error) = undef;
- my($progress) = $self->get_progress_callback();
+ my $self = shift;
+ my $status = 2;
+ my $error;
+ my $progress = $self->get_progress_callback();
if (defined $progress) {
&$progress();
@@ -4382,13 +4349,13 @@ sub write_project {
if ($self->{'escape_spaces'}) {
foreach my $name ('exename', 'sharedname', 'staticname',
'exeout', 'dllout', 'libout') {
- my($value) = $self->get_assignment($name);
+ 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};
+ my $names = $self->{$key};
foreach my $name (keys %$names) {
foreach my $key (keys %{$$names{$name}}) {
foreach my $file (@{$$names{$name}->{$key}}) {
@@ -4411,8 +4378,8 @@ sub write_project {
}
}
elsif ($self->warn_useless_project()) {
- my($msg) = $self->transform_file_name($self->project_file_name()) .
- " has no useful targets.";
+ my $msg = $self->transform_file_name($self->project_file_name()) .
+ " has no useful targets.";
if ($self->{'current_input'} eq '') {
$self->information($msg);
@@ -4428,39 +4395,36 @@ sub write_project {
sub get_project_info {
- my($self) = shift;
- return $self->{'project_info'};
+ return $_[0]->{'project_info'};
}
sub get_lib_locations {
- my($self) = shift;
- return $self->{'lib_locations'};
+ return $_[0]->{'lib_locations'};
}
sub get_inheritance_tree {
- my($self) = shift;
- return $self->{'inheritance_tree'};
+ return $_[0]->{'inheritance_tree'};
}
sub set_component_extensions {
- my($self) = shift;
- my($vc) = $self->{'valid_components'};
- my($ec) = $self->{'exclude_components'};
+ 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}});
+ my $ov = $self->override_valid_component_extensions($key,
+ @{$$vc{$key}});
if (defined $ov) {
$$vc{$key} = $ov;
}
}
foreach my $key (keys %$ec) {
- my($ov) = $self->override_exclude_component_extensions($key,
- @{$$ec{$key}});
+ my $ov = $self->override_exclude_component_extensions($key,
+ @{$$ec{$key}});
if (defined $ov) {
$$ec{$key} = $ov;
}
@@ -4475,7 +4439,7 @@ sub set_source_listing_callback {
sub reset_values {
- my($self) = shift;
+ my $self = shift;
## Only put data structures that need to be cleared
## out when the mpc file is done being read, not at the
@@ -4488,8 +4452,8 @@ sub reset_values {
sub add_default_matching_assignments {
- my($self) = shift;
- my($lang) = $self->get_language();
+ my $self = shift;
+ my $lang = $self->get_language();
if (defined $lang) {
foreach my $key (keys %{$language{$lang}->[0]}) {
@@ -4507,17 +4471,17 @@ sub add_default_matching_assignments {
sub reset_generating_types {
- my($self) = shift;
- my($lang) = $self->get_language();
+ my $self = shift;
+ my $lang = $self->get_language();
if (defined $lang) {
- 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,
- );
+ 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} = {};
@@ -4535,8 +4499,8 @@ sub reset_generating_types {
sub get_template_input {
- my($self) = shift;
- my($lang) = $self->get_language();
+ 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
@@ -4601,14 +4565,14 @@ sub update_project_info {
sub adjust_value {
my($self, $names, $value, $tp) = @_;
- my($atemp) = $self->get_addtemp();
+ 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;
+ my $lname = lc($name);
+ my $base = $lname;
$base =~ s/.*:://;
## If the template variable is a complex name, then we need to make
@@ -4636,14 +4600,14 @@ sub adjust_value {
}
}
- my($replace) = (defined $self->{'valid_names'}->{$base} &&
- ($self->{'valid_names'}->{$base} & 0x04) == 0);
+ 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]);
+ my $arr = $self->create_array($$val[1]);
if ($$val[0] > 0) {
if (!defined $value) {
$value = '';
@@ -4672,7 +4636,7 @@ sub adjust_value {
}
elsif ($$val[0] < 0) {
if (defined $value) {
- my($parts) = undef;
+ my $parts;
if (UNIVERSAL::isa($value, 'ARRAY')) {
$parts = $value;
}
@@ -4683,7 +4647,7 @@ sub adjust_value {
$value = [];
foreach my $part (@$parts) {
if ($part ne '') {
- my($found) = 0;
+ my $found = 0;
foreach my $ae (@$arr) {
if ($part eq $ae) {
$found = 1;
@@ -4713,12 +4677,12 @@ sub adjust_value {
sub get_verbatim {
my($self, $marker) = @_;
- my($str) = undef;
- my($thash) = $self->{'verbatim'}->{$self->{'pctype'}};
+ my $str;
+ my $thash = $self->{'verbatim'}->{$self->{'pctype'}};
if (defined $thash) {
if (defined $thash->{$marker}) {
- my($crlf) = $self->crlf();
+ my $crlf = $self->crlf();
foreach my $line (@{$thash->{$marker}}) {
if (!defined $str) {
$str = '';
@@ -4746,7 +4710,7 @@ sub generate_recursive_input_list {
sub get_modified_project_file_name {
my($self, $name, $ext) = @_;
- my($nmod) = $self->get_name_modifier();
+ 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
@@ -4760,20 +4724,18 @@ sub get_modified_project_file_name {
sub get_valid_names {
- my($self) = shift;
- return $self->{'valid_names'};
+ return $_[0]->{'valid_names'};
}
sub get_feature_parser {
- my($self) = shift;
- return $self->{'feature_parser'};
+ return $_[0]->{'feature_parser'};
}
sub preserve_assignment_order {
my($self, $name) = @_;
- my($mapped) = $self->{'valid_names'}->{$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
@@ -4789,7 +4751,7 @@ sub preserve_assignment_order {
sub add_to_template_input_value {
my($self, $name) = @_;
- my($mapped) = $self->{'valid_names'}->{$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
@@ -4813,13 +4775,13 @@ sub translate_value {
my($self, $key, $val) = @_;
if ($key eq 'after' && $val ne '') {
- my($arr) = $self->create_array($val);
+ 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();
+ my $nmod = $self->get_name_modifier();
if (defined $nmod) {
$nmod =~ s/\*/$entry/g;
$entry = $nmod;
@@ -4855,7 +4817,7 @@ sub project_file_name {
sub remove_non_custom_settings {
- my($self) = shift;
+ my $self = shift;
## Remove any files that may have automatically been added
## to this project
@@ -4890,7 +4852,7 @@ sub remove_wanted_extension {
sub resolve_alias {
if (index($_[1], 'install') >= 0) {
- my($resolved) = $_[1];
+ my $resolved = $_[1];
if ($resolved =~ s/(.*::)install$/$1exeout/) {
}
elsif ($resolved eq 'install') {
@@ -4904,23 +4866,23 @@ sub resolve_alias {
sub create_feature_parser {
my($self, $features, $feature) = @_;
- my($gfeature) = $self->{'gfeature_file'};
- my($typefeaturef) = (defined $gfeature ?
- $self->mpc_dirname($gfeature) . '/' : '') .
- $self->{'pctype'} . '.features';
+ 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);
+ my $searched = $self->search_include_path($feature);
$feature = $searched if (defined $searched);
}
- my($fp) = new FeatureParser($features,
- $gfeature,
- $typefeaturef,
- $feature);
+ my $fp = new FeatureParser($features,
+ $gfeature,
+ $typefeaturef,
+ $feature);
- my($slo) = $fp->get_value($static_libs_feature);
+ my $slo = $fp->get_value($static_libs_feature);
if (!defined $slo) {
- my($sval) = $self->get_static() || 0;
+ my $sval = $self->get_static() || 0;
$fp->parse_line(undef,
$static_libs_feature . ' = ' . $sval);
}
@@ -4944,8 +4906,8 @@ sub restore_state_helper {
}
}
elsif ($skey eq 'ti') {
- my($lang) = $self->get_language();
- my(@keys) = keys %$old;
+ 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} ||
@@ -4966,8 +4928,7 @@ sub restore_state_helper {
sub get_initial_relative_values {
- my($self) = shift;
- return $self->{'expanded'}, 1;
+ return $_[0]->{'expanded'}, 1;
}
sub add_main_function {
@@ -5003,7 +4964,7 @@ sub getKeywords {
}
sub getValidComponents {
- my($language) = shift;
+ my $language = shift;
return (defined $language{$language} ? $language{$language}->[0] : undef);
}
@@ -5161,8 +5122,7 @@ sub get_dll_template_input_file {
sub get_template {
- my($self) = shift;
- return $self->{'pctype'};
+ return $_[0]->{'pctype'};
}
sub requires_forward_slashes {
diff --git a/modules/StringProcessor.pm b/modules/StringProcessor.pm
index 306d7776..037e3766 100644
--- a/modules/StringProcessor.pm
+++ b/modules/StringProcessor.pm
@@ -17,14 +17,12 @@ use strict;
# ************************************************************
sub parse_assignment {
- my($self) = shift;
- my($line) = shift;
- my($values) = shift;
+ 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);
+ my $op = ($3 eq '+=' ? 1 : $3 eq '-=' ? -1 : 0);
push(@$values, $op, $self->resolve_alias(lc($1)), $4);
return 1;
}
@@ -34,9 +32,8 @@ sub parse_assignment {
sub extractType {
- my($self) = shift;
- my($name) = shift;
- my($type) = $name;
+ my($self, $name) = @_;
+ my $type = $name;
if ($name =~ /(.*)(Project|Workspace)Creator/) {
$type = $1;
@@ -47,12 +44,11 @@ sub extractType {
sub process_special {
- my($self) = shift;
- my($line) = shift;
+ my($self, $line) = @_;
## Replace all escaped double quotes and escaped backslashes
## with special characters
- my($escaped) = ($line =~ s/\\\\/\01/g);
+ my $escaped = ($line =~ s/\\\\/\01/g);
$escaped |= ($line =~ s/\\"/\02/g);
## Un-escape all other characters
@@ -72,12 +68,11 @@ sub process_special {
sub create_array {
- my($self) = shift;
- my($line) = shift;
- my(@array) = ();
+ my($self, $line) = @_;
+ my @array;
## Replace all escaped double and single quotes with special characters
- my($escaped) = ($line =~ s/\\\"/\01/g);
+ my $escaped = ($line =~ s/\\\"/\01/g);
$escaped |= ($line =~ s/\\\'/\02/g);
$escaped |= ($line =~ s/\\ /\03/g);
$escaped |= ($line =~ s/\\\t/\04/g);
diff --git a/modules/TemplateInputReader.pm b/modules/TemplateInputReader.pm
index 1ad7e037..b01cb707 100644
--- a/modules/TemplateInputReader.pm
+++ b/modules/TemplateInputReader.pm
@@ -21,16 +21,15 @@ use vars qw(@ISA);
# Data Section
# ************************************************************
-my($mpt) = 'mpt';
+my $mpt = 'mpt';
# ************************************************************
# Subroutine Section
# ************************************************************
sub new {
- my($class) = shift;
- my($inc) = shift;
- my($self) = Parser::new($class, $inc);
+ my($class, $inc) = @_;
+ my $self = Parser::new($class, $inc);
$self->{'values'} = {};
$self->{'cindex'} = 0;
@@ -42,20 +41,18 @@ sub new {
sub parse_line {
- my($self) = shift;
- my($ih) = shift;
- my($line) = shift;
- my($status) = 1;
- my($errorString) = undef;
- my($current) = $self->{'current'};
+ 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
- my($rname) = $1;
+ my $rname = $1;
$rname =~ s/\s+$//;
- my($name) = lc($rname);
+ my $name = lc($rname);
$self->{'realnames'}->{$name} = $rname;
if (!defined $$current[$self->{'cindex'}]->{$name}) {
@@ -75,9 +72,9 @@ sub parse_line {
}
}
elsif ($line =~ /^(\w+)\s*(\+=|=)\s*(.*)?/) {
- my($name) = lc($1);
- my($op) = $2;
- my($value) = $3;
+ my $name = lc($1);
+ my $op = $2;
+ my $value = $3;
if (defined $value) {
$value = $self->create_array($value);
@@ -94,9 +91,9 @@ sub parse_line {
}
}
elsif ($line =~ /^conditional_include\s+"([\w\s\-\+\/\\\.]+)"$/) {
- my($file) = $self->search_include_path("$1.$mpt");
+ my $file = $self->search_include_path("$1.$mpt");
if (defined $file) {
- my($ol) = $self->get_line_number();
+ my $ol = $self->get_line_number();
($status, $errorString) = $self->read_file($file);
$self->set_line_number($ol);
}
@@ -111,15 +108,13 @@ sub parse_line {
sub get_value {
- my($self) = shift;
- my($tag) = shift;
+ my($self, $tag) = @_;
return $self->{'values'}->{lc($tag)};
}
sub get_realname {
- my($self) = shift;
- my($tag) = shift;
+ my($self, $tag) = @_;
return $self->{'realnames'}->{lc($tag)};
}
diff --git a/modules/TemplateParser.pm b/modules/TemplateParser.pm
index 019fff04..ab5038cd 100644
--- a/modules/TemplateParser.pm
+++ b/modules/TemplateParser.pm
@@ -29,63 +29,62 @@ use vars qw(@ISA);
# 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
-my(%keywords) = ('if' => 0,
- 'else' => 0,
- 'endif' => 0,
- 'noextension' => 2,
- 'dirname' => 5,
- 'basename' => 0,
- 'basenoextension' => 0,
- 'foreach' => 0,
- 'forfirst' => 0,
- 'fornotfirst' => 0,
- 'fornotlast' => 0,
- 'forlast' => 0,
- 'endfor' => 0,
- 'eval' => 0,
- 'comment' => 0,
- 'marker' => 0,
- 'uc' => 0,
- 'lc' => 0,
- 'ucw' => 0,
- 'normalize' => 2,
- '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' => 2,
- );
-
-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',
- );
+my %keywords = ('if' => 0,
+ 'else' => 0,
+ 'endif' => 0,
+ 'noextension' => 2,
+ 'dirname' => 5,
+ 'basename' => 0,
+ 'basenoextension' => 0,
+ 'foreach' => 0,
+ 'forfirst' => 0,
+ 'fornotfirst' => 0,
+ 'fornotlast' => 0,
+ 'forlast' => 0,
+ 'endfor' => 0,
+ 'eval' => 0,
+ 'comment' => 0,
+ 'marker' => 0,
+ 'uc' => 0,
+ 'lc' => 0,
+ 'ucw' => 0,
+ 'normalize' => 2,
+ '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' => 2,
+ );
+
+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) = shift;
- my($prjc) = shift;
- my($self) = $class->SUPER::new();
+ my($class, $prjc) = @_;
+ my $self = $class->SUPER::new();
$self->{'prjc'} = $prjc;
$self->{'ti'} = $prjc->get_template_input();
@@ -123,8 +122,7 @@ sub new {
sub tp_basename {
- my($self) = shift;
- my($file) = shift;
+ my($self, $file) = @_;
if ($self->{'cslashes'}) {
$file =~ s/.*[\/\\]//;
@@ -137,9 +135,8 @@ sub tp_basename {
sub validated_dirname {
- my($self) = shift;
- my($file) = shift;
- my($index) = rindex($file, ($self->{'cslashes'} ? '\\' : '/'));
+ my($self, $file) = @_;
+ my $index = rindex($file, ($self->{'cslashes'} ? '\\' : '/'));
if ($index >= 0) {
return $self->{'prjc'}->validated_directory(substr($file, 0, $index));
@@ -151,9 +148,8 @@ sub validated_dirname {
sub tp_dirname {
- my($self) = shift;
- my($file) = shift;
- my($index) = rindex($file, ($self->{'cslashes'} ? '\\' : '/'));
+ my($self, $file) = @_;
+ my $index = rindex($file, ($self->{'cslashes'} ? '\\' : '/'));
if ($index >= 0) {
return substr($file, 0, $index);
@@ -192,12 +188,12 @@ sub append_current {
$_[0]->{'eval_str'} .= $_[1];
}
else {
- my($value) = $_[1];
- my($scope) = $_[0]->{'scopes'};
+ my $value = $_[1];
+ my $scope = $_[0]->{'scopes'};
while(defined $$scope{'scope'}) {
$scope = $$scope{'scope'};
if (defined $$scope{'escape'}) {
- my($key) = $$scope{'escape'};
+ my $key = $$scope{'escape'};
if ($key eq '\\') {
$value =~ s/\\/\\\\/g;
}
@@ -218,9 +214,8 @@ sub append_current {
sub split_parameters {
- my($self) = shift;
- my($str) = shift;
- my(@params) = ();
+ my($self, $str) = @_;
+ my @params;
while($str =~ /^(\w+\([^\)]+\))\s*,\s*(.*)/) {
push(@params, $1);
@@ -238,25 +233,24 @@ sub split_parameters {
sub set_current_values {
- my($self) = shift;
- my($name) = shift;
- my($set) = 0;
+ 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'};
+ 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);
+ 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) = ();
+ my %copy;
foreach my $key (keys %$value) {
$copy{$key} = $self->{'prjc'}->adjust_value(
[$name . '::' . $key, $name], $$value{$key}, $self);
@@ -277,14 +271,13 @@ sub set_current_values {
sub get_value {
- my($self) = shift;
- my($name) = shift;
- my($value) = undef;
- my($counter) = $self->{'foreach'}->{'count'};
- my($fromprj) = 0;
- my($scope) = undef;
- my($sname) = undef;
- my($adjust) = 1;
+ my($self, $name) = @_;
+ my $value;
+ my $counter = $self->{'foreach'}->{'count'};
+ my $fromprj = 0;
+ my $scope;
+ my $sname;
+ my $adjust = 1;
## $name should always be all lower-case
$name = lc($name);
@@ -325,8 +318,8 @@ sub get_value {
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);
+ my $uvalue = $self->{'prjc'}->adjust_value([$sname, $name],
+ [], $self);
if (defined $$uvalue[0]) {
$value = $uvalue;
$adjust = 0;
@@ -354,9 +347,9 @@ sub get_value {
## 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);
+ my $pre = $1;
+ my $post = $2;
+ my $base = $self->get_value($pre);
if (defined $base) {
$value = $self->{'prjc'}->get_special_value(
@@ -386,9 +379,9 @@ sub get_value {
## 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);
+ my $pjval = $self->{'prjc'}->get_assignment($name);
if (defined $pjval) {
- my(@copy) = @$value;
+ my @copy = @$value;
if (!UNIVERSAL::isa($pjval, 'ARRAY')) {
$pjval = $self->create_array($pjval);
}
@@ -402,15 +395,15 @@ sub get_value {
sub get_value_with_default {
- my($self) = shift;
- my($name) = lc(shift);
- my($value) = $self->get_value($name);
+ 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) = undef;
+ my $counter = $self->{'foreach'}->{'count'};
+ my $sname;
if ($counter >= 0) {
## Find the outer most scope for our variable name
@@ -447,17 +440,17 @@ sub get_value_with_default {
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) = undef;
+ 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\((.*)\)$/) {
- my($over) = $self->get_flag_overrides($3);
+ my $over = $self->get_flag_overrides($3);
$name = $2;
if (defined $over) {
$val = $self->create_array($over);
@@ -470,12 +463,12 @@ sub process_foreach {
else {
## Pull out modifying commands first
while ($val =~ /(\w+)\((.+)\)/) {
- my($cmd) = $1;
- $val = $2;
+ 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);
+ my @params = $self->split_parameters($val);
$val = \@params;
last;
}
@@ -491,9 +484,9 @@ sub process_foreach {
@values = @$val;
}
else {
- my($names) = $self->create_array($val);
+ my $names = $self->create_array($val);
foreach my $n (@$names) {
- my($vals) = $self->get_value($n);
+ my $vals = $self->get_value($n);
if (defined $vals && $vals ne '') {
if (!UNIVERSAL::isa($vals, 'ARRAY')) {
$vals = $self->create_array($vals);
@@ -520,8 +513,8 @@ sub process_foreach {
$self->{'foreach'}->{'text'}->[$index] = '';
if (defined $values[0]) {
- my($scope) = $self->{'foreach'}->{'scope'}->[$index];
- my($base) = $self->{'foreach'}->{'base'}->[$index];
+ my $scope = $self->{'foreach'}->{'scope'}->[$index];
+ my $base = $self->{'foreach'}->{'base'}->[$index];
$$scope{'forlast'} = '';
$$scope{'fornotlast'} = 1;
@@ -531,14 +524,14 @@ sub process_foreach {
## If the foreach values are mixed (HASH and SCALAR), then
## remove the SCALAR values.
if ($check_for_mixed) {
- my(%mixed) = ();
- my($mixed) = 0;
+ my %mixed;
+ my $mixed = 0;
foreach my $mval (@values) {
$mixed{$mval} = $self->set_current_values($mval);
$mixed |= $mixed{$mval};
}
if ($mixed) {
- my(@nvalues) = ();
+ my @nvalues;
foreach my $key (sort keys %mixed) {
if ($mixed{$key}) {
push(@nvalues, $key);
@@ -547,7 +540,7 @@ sub process_foreach {
## Set the new values only if they are different
## from the original (except for order).
- my(@sorted) = sort(@values);
+ my @sorted = sort(@values);
if (@sorted != @nvalues) {
@values = @nvalues;
}
@@ -555,7 +548,7 @@ sub process_foreach {
}
for(my $i = 0; $i <= $#values; ++$i) {
- my($value) = $values[$i];
+ my $value = $values[$i];
## Set the corresponding values in the temporary scope
$self->set_current_values($value);
@@ -600,16 +593,15 @@ sub process_foreach {
sub handle_endif {
- my($self) = shift;
- my($name) = shift;
- my($end) = pop(@{$self->{'sstack'}});
+ my($self, $name) = @_;
+ my $end = pop(@{$self->{'sstack'}});
pop(@{$self->{'lstack'}});
if (!defined $end) {
return "Unmatched $name";
}
else {
- my($in) = index($end, $name);
+ my $in = index($end, $name);
if ($in == 0) {
$self->{'if_skip'} = 0;
}
@@ -623,19 +615,18 @@ sub handle_endif {
sub handle_endfor {
- my($self) = shift;
- my($name) = shift;
- my($end) = pop(@{$self->{'sstack'}});
+ my($self, $name) = @_;
+ my $end = pop(@{$self->{'sstack'}});
pop(@{$self->{'lstack'}});
if (!defined $end) {
return "Unmatched $name";
}
else {
- my($in) = index($end, $name);
+ my $in = index($end, $name);
if ($in == 0) {
- my($index) = $self->{'foreach'}->{'count'};
- my($error) = $self->process_foreach();
+ my $index = $self->{'foreach'}->{'count'};
+ my $error = $self->process_foreach();
if (!defined $error) {
--$self->{'foreach'}->{'count'};
$self->append_current($self->{'foreach'}->{'text'}->[$index]);
@@ -652,24 +643,23 @@ sub handle_endfor {
sub get_flag_overrides {
- my($self) = shift;
- my($name) = shift;
- my($type) = undef;
+ my($self, $name) = @_;
+ my $type;
## Split the name and type parameters
($name, $type) = split(/,\s*/, $name);
- my($file) = $self->get_value($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) = undef;
+ 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);
+ my $ct = $self->get_value($pre);
$name = $ct if (defined $ct);
}
elsif ($pre =~ /^grouped_(.*_file)$/) {
@@ -677,25 +667,25 @@ sub get_flag_overrides {
}
}
- my($fo) = $self->{'prjc'}->{'flag_overrides'};
- my($key) = (defined $$fo{$name . 's'} ? $name . 's' :
- (defined $$fo{$name} ? $name : undef));
+ 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;
+ 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 $dir = $self->mpc_dirname($ustyle);
- my($of) = (defined $$fo{$key}->{$ustyle} ? $ustyle :
- (defined $$fo{$key}->{$dir} ? $dir : undef));
+ my $of = (defined $$fo{$key}->{$ustyle} ? $ustyle :
+ (defined $$fo{$key}->{$dir} ? $dir : undef));
if (defined $of) {
- my($prjc) = $self->{'prjc'};
+ 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};
+ 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
@@ -718,8 +708,7 @@ sub get_flag_overrides {
sub get_multiple {
- my($self) = shift;
- my($name) = shift;
+ my($self, $name) = @_;
return $self->doif_multiple(
$self->create_array(
$self->get_value_with_default($name)));
@@ -727,8 +716,7 @@ sub get_multiple {
sub doif_multiple {
- my($self) = shift;
- my($value) = shift;
+ my($self, $value) = @_;
if (defined $value) {
return (scalar(@$value) > 1);
@@ -738,12 +726,11 @@ sub doif_multiple {
sub handle_multiple {
- my($self) = shift;
- my($name) = shift;
- my($val) = $self->get_value_with_default($name);
+ my($self, $name) = @_;
+ my $val = $self->get_value_with_default($name);
if (defined $val) {
- my($array) = $self->create_array($val);
+ my $array = $self->create_array($val);
$self->append_current(scalar(@$array));
}
else {
@@ -753,15 +740,13 @@ sub handle_multiple {
sub get_starts_with {
- my($self) = shift;
- my($str) = shift;
+ my($self, $str) = @_;
return $self->doif_starts_with([$str]);
}
sub doif_starts_with {
- my($self) = shift;
- my($val) = shift;
+ my($self, $val) = @_;
if (defined $val) {
my($name, $pattern) = $self->split_parameters("@$val");
@@ -774,11 +759,10 @@ sub doif_starts_with {
sub handle_starts_with {
- my($self) = shift;
- my($str) = shift;
+ my($self, $str) = @_;
if (defined $str) {
- my($val) = $self->doif_starts_with([$str]);
+ my $val = $self->doif_starts_with([$str]);
if (defined $val) {
$self->append_current($val);
@@ -791,15 +775,13 @@ sub handle_starts_with {
sub get_ends_with {
- my($self) = shift;
- my($str) = shift;
+ my($self, $str) = @_;
return $self->doif_ends_with([$str]);
}
sub doif_ends_with {
- my($self) = shift;
- my($val) = shift;
+ my($self, $val) = @_;
if (defined $val) {
my($name, $pattern) = $self->split_parameters("@$val");
@@ -812,11 +794,10 @@ sub doif_ends_with {
sub handle_ends_with {
- my($self) = shift;
- my($str) = shift;
+ my($self, $str) = @_;
if (defined $str) {
- my($val) = $self->doif_ends_with([$str]);
+ my $val = $self->doif_ends_with([$str]);
if (defined $val) {
$self->append_current($val);
@@ -829,12 +810,11 @@ sub handle_ends_with {
sub handle_keyname_used {
- my($self) = shift;
- my($str) = shift;
+ my($self, $str) = @_;
if (defined $str) {
my($name, $key) = $self->split_parameters($str);
- my($file) = $self->get_value_with_default($name);
+ my $file = $self->get_value_with_default($name);
if (defined $self->{'keyname_used'}->{$file}->{$key}) {
$self->append_current($self->{'keyname_used'}->{$file}->{$key}++);
}
@@ -846,14 +826,13 @@ sub handle_keyname_used {
sub handle_scope {
- my($self) = shift;
- my($str) = shift;
+ my($self, $str) = @_;
if (defined $str) {
my($state, $func, $param) = $self->split_parameters($str);
if (defined $state) {
- my($pscope) = undef;
- my($scope) = $self->{'scopes'};
+ my $pscope;
+ my $scope = $self->{'scopes'};
while(defined $$scope{'scope'}) {
$pscope = $scope;
@@ -887,15 +866,13 @@ sub handle_scope {
}
sub get_has_extension {
- my($self) = shift;
- my($str) = shift;
+ my($self, $str) = @_;
return $self->doif_has_extension([$str]);
}
sub doif_has_extension {
- my($self) = shift;
- my($val) = shift;
+ my($self, $val) = @_;
if (defined $val) {
return ($self->tp_basename(
@@ -906,11 +883,10 @@ sub doif_has_extension {
sub handle_has_extension {
- my($self) = shift;
- my($str) = shift;
+ my($self, $str) = @_;
if (defined $str) {
- my($val) = $self->doif_has_extension([$str]);
+ my $val = $self->doif_has_extension([$str]);
if (defined $val) {
$self->append_current($val);
@@ -923,15 +899,13 @@ sub handle_has_extension {
sub get_contains {
- my($self) = shift;
- my($str) = shift;
+ my($self, $str) = @_;
return $self->doif_contains([$str]);
}
sub doif_contains {
- my($self) = shift;
- my($val) = shift;
+ my($self, $val) = @_;
if (defined $val) {
my($name, $pattern) = $self->split_parameters("@$val");
@@ -944,11 +918,10 @@ sub doif_contains {
sub handle_contains {
- my($self) = shift;
- my($str) = shift;
+ my($self, $str) = @_;
if (defined $str) {
- my($val) = $self->doif_contains([$str]);
+ my $val = $self->doif_contains([$str]);
if (defined $val) {
$self->append_current($val);
@@ -961,24 +934,21 @@ sub handle_contains {
sub get_remove_from {
- my($self) = shift;
- my($str) = shift;
+ my($self, $str) = @_;
return $self->doif_remove_from($str);
}
sub doif_remove_from {
- my($self) = shift;
- my($str) = shift;
- my(@params) = $self->split_parameters($str);
- my(@removed) = $self->perform_remove_from(\@params);
+ 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) = shift;
- my($val) = shift;
+ my($self, $val) = @_;
my($source, $pattern, $target, $tremove) = @$val;
## $source should be a component name (e.g., source_files,
@@ -989,12 +959,12 @@ sub perform_remove_from {
## $tremove from the end of it.
if (defined $source && defined $target &&
defined $self->{'values'}->{$source}) {
- my($tval) = $self->get_value_with_default($target);
+ 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}});
+ 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));
@@ -1013,12 +983,11 @@ sub perform_remove_from {
sub handle_remove_from {
- my($self) = shift;
- my($str) = shift;
+ my($self, $str) = @_;
if (defined $str) {
- my(@params) = $self->split_parameters($str);
- my($val) = $self->perform_remove_from(\@params);
+ my @params = $self->split_parameters($str);
+ my $val = $self->perform_remove_from(\@params);
if (defined $val) {
$self->append_current("@$val");
@@ -1028,15 +997,13 @@ sub handle_remove_from {
sub get_compares {
- my($self) = shift;
- my($str) = shift;
+ my($self, $str) = @_;
return $self->doif_compares([$str]);
}
sub doif_compares {
- my($self) = shift;
- my($val) = shift;
+ my($self, $val) = @_;
if (defined $val) {
my($name, $pattern) = $self->split_parameters("@$val");
@@ -1049,11 +1016,10 @@ sub doif_compares {
sub handle_compares {
- my($self) = shift;
- my($str) = shift;
+ my($self, $str) = @_;
if (defined $str) {
- my($val) = $self->doif_compares([$str]);
+ my $val = $self->doif_compares([$str]);
if (defined $val) {
$self->append_current($val);
@@ -1066,12 +1032,11 @@ sub handle_compares {
sub get_reverse {
- my($self) = shift;
- my($name) = shift;
- my($value) = $self->get_value_with_default($name);
+ my($self, $name) = @_;
+ my $value = $self->get_value_with_default($name);
if (defined $value) {
- my(@array) = $self->perform_reverse($self->create_array($value));
+ my @array = $self->perform_reverse($self->create_array($value));
return \@array;
}
@@ -1080,31 +1045,28 @@ sub get_reverse {
sub perform_reverse {
- my($self) = shift;
- my($value) = shift;
+ my($self, $value) = @_;
return reverse(@$value);
}
sub handle_reverse {
- my($self) = shift;
- my($name) = shift;
- my($val) = $self->get_value_with_default($name);
+ my($self, $name) = @_;
+ my $val = $self->get_value_with_default($name);
if (defined $val) {
- my(@array) = $self->perform_reverse($self->create_array($val));
+ my @array = $self->perform_reverse($self->create_array($val));
$self->append_current("@array");
}
}
sub get_sort {
- my($self) = shift;
- my($name) = shift;
- my($value) = $self->get_value_with_default($name);
+ my($self, $name) = @_;
+ my $value = $self->get_value_with_default($name);
if (defined $value) {
- my(@array) = $self->perform_sort($self->create_array($value));
+ my @array = $self->perform_sort($self->create_array($value));
return \@array;
}
@@ -1113,31 +1075,28 @@ sub get_sort {
sub perform_sort {
- my($self) = shift;
- my($value) = shift;
+ my($self, $value) = @_;
return sort(@$value);
}
sub handle_sort {
- my($self) = shift;
- my($name) = shift;
- my($val) = $self->get_value_with_default($name);
+ my($self, $name) = @_;
+ my $val = $self->get_value_with_default($name);
if (defined $val) {
- my(@array) = $self->perform_sort($self->create_array($val));
+ my @array = $self->perform_sort($self->create_array($val));
$self->append_current("@array");
}
}
sub get_uniq {
- my($self) = shift;
- my($name) = shift;
- my($value) = $self->get_value_with_default($name);
+ my($self, $name) = @_;
+ my $value = $self->get_value_with_default($name);
if (defined $value) {
- my(@array) = $self->perform_uniq($self->create_array($value));
+ my @array = $self->perform_uniq($self->create_array($value));
return \@array;
}
@@ -1146,32 +1105,29 @@ sub get_uniq {
sub perform_uniq {
- my($self) = shift;
- my($value) = shift;
- my(%value) = ();
+ my($self, $value) = @_;
+ my %value;
@value{@$value} = ();
return sort(keys %value);
}
sub handle_uniq {
- my($self) = shift;
- my($name) = shift;
- my($val) = $self->get_value_with_default($name);
+ my($self, $name) = @_;
+ my $val = $self->get_value_with_default($name);
if (defined $val) {
- my(@array) = $self->perform_uniq($self->create_array($val));
+ my @array = $self->perform_uniq($self->create_array($val));
$self->append_current("@array");
}
}
sub process_compound_if {
- my($self) = shift;
- my($str) = shift;
+ my($self, $str) = @_;
if (index($str, '||') >= 0) {
- my($ret) = 0;
+ my $ret = 0;
foreach my $v (split(/\s*\|\|\s*/, $str)) {
$ret |= $self->process_compound_if($v);
if ($ret != 0) {
@@ -1181,7 +1137,7 @@ sub process_compound_if {
return 0;
}
elsif (index($str, '&&') >= 0) {
- my($ret) = 1;
+ my $ret = 1;
foreach my $v (split(/\s*\&\&\s*/, $str)) {
$ret &&= $self->process_compound_if($v);
if ($ret == 0) {
@@ -1192,15 +1148,15 @@ sub process_compound_if {
}
else {
## See if we need to reverse the return value
- my($not) = 0;
+ my $not = 0;
if ($str =~ /^!+(.*)/) {
$not = 1;
$str = $1;
}
## Get the value based on the string
- my(@cmds) = ();
- my($val) = undef;
+ my @cmds;
+ my $val;
while ($str =~ /(\w+)\((.+)\)(.*)/) {
if ($3 eq '') {
push(@cmds, $1);
@@ -1216,13 +1172,13 @@ sub process_compound_if {
if (defined $cmds[0]) {
## Start out calling get_xxx on the string
- my($type) = 0x01;
- my($prefix) = 'get_';
+ 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";
+ my $func = "$prefix$cmd";
$val = $self->$func($val);
## Now that we have a value, we need to switch over
@@ -1240,7 +1196,7 @@ sub process_compound_if {
}
## See if any portion of the value is defined and not empty
- my($ret) = 0;
+ my $ret = 0;
if (defined $val) {
if (UNIVERSAL::isa($val, 'ARRAY')) {
foreach my $v (@$val) {
@@ -1260,9 +1216,8 @@ sub process_compound_if {
sub handle_if {
- my($self) = shift;
- my($val) = shift;
- my($name) = 'endif';
+ my($self, $val) = @_;
+ my $name = 'endif';
push(@{$self->{'lstack'}},
"<%if($val)%> (" . $self->get_line_number() . '?)');
@@ -1280,9 +1235,9 @@ sub handle_if {
sub handle_else {
- my($self) = shift;
- my(@scopy) = @{$self->{'sstack'}};
- my($index) = index($scopy[$#scopy], 'endif');
+ my $self = shift;
+ my @scopy = @{$self->{'sstack'}};
+ my $index = index($scopy[$#scopy], 'endif');
if ($index >= 0) {
if ($index == 0) {
$self->{'if_skip'} ^= 1;
@@ -1299,15 +1254,15 @@ sub handle_else {
sub handle_foreach {
- my($self) = shift;
- my($val) = lc(shift);
- my($name) = 'endfor';
- my($errorString) = undef;
+ 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) = undef;
+ my $base = 1;
+ my $vname;
if ($val =~ /flag_overrides\([^\)]+\)/) {
}
elsif ($val =~ /([^,]*),(.*)/) {
@@ -1344,7 +1299,7 @@ sub handle_foreach {
## with variables that can be used with the -> operator
if (defined $vname) {
foreach my $ref (keys %arrow_op_ref) {
- my($name_re) = $ref . 's';
+ my $name_re = $ref . 's';
if ($val =~ /^$ref\->/ || $val =~ /^$name_re$/) {
$errorString = 'The foreach variable can not be ' .
'named when dealing with ' .
@@ -1355,7 +1310,7 @@ sub handle_foreach {
}
push(@{$self->{'sstack'}}, $name);
- my($index) = ++$self->{'foreach'}->{'count'};
+ my $index = ++$self->{'foreach'}->{'count'};
$self->{'foreach'}->{'base'}->[$index] = $base;
$self->{'foreach'}->{'name'}->[$index] = $vname;
@@ -1373,9 +1328,7 @@ sub handle_foreach {
sub handle_special {
- my($self) = shift;
- my($name) = shift;
- my($val) = shift;
+ my($self, $name, $val) = @_;
## If $name (fornotlast, forfirst, etc.) is set to 1
## Then we append the $val onto the current string that's
@@ -1387,29 +1340,26 @@ sub handle_special {
sub handle_uc {
- my($self) = shift;
- my($name) = shift;
+ my($self, $name) = @_;
$self->append_current(uc($self->get_value_with_default($name)));
}
sub handle_lc {
- my($self) = shift;
- my($name) = shift;
+ my($self, $name) = @_;
$self->append_current(lc($self->get_value_with_default($name)));
}
sub handle_ucw {
- my($self) = shift;
- my($name) = shift;
- my($val) = $self->get_value_with_default($name);
+ 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);
+ my $uc = uc($1);
$val =~ s/[_\s][a-z]/ $uc/;
}
$self->append_current($val);
@@ -1417,34 +1367,30 @@ sub handle_ucw {
sub perform_normalize {
- my($self) = shift;
- my($value) = shift;
+ my($self, $value) = @_;
$value =~ tr/\/\\\-$()./_/;
return $value;
}
sub handle_normalize {
- my($self) = shift;
- my($name) = shift;
- my($val) = $self->get_value_with_default($name);
+ my($self, $name) = @_;
+ my $val = $self->get_value_with_default($name);
$self->append_current($self->perform_normalize($val));
}
sub perform_noextension {
- my($self) = shift;
- my($value) = shift;
+ my($self, $value) = @_;
$value =~ s/\.[^\.]+$//;
return $value;
}
sub handle_noextension {
- my($self) = shift;
- my($name) = shift;
- my($val) = $self->get_value_with_default($name);
+ my($self, $name) = @_;
+ my $val = $self->get_value_with_default($name);
$self->append_current($self->perform_noextension($val));
}
@@ -1466,7 +1412,7 @@ sub perform_full_path {
## 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);
+ my $dir = $self->mpc_dirname($value);
if (-e $dir) {
$dir = Cwd::abs_path($dir);
}
@@ -1476,7 +1422,7 @@ sub perform_full_path {
## (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'});
@@ -1485,39 +1431,36 @@ sub perform_full_path {
sub handle_full_path {
- my($self) = shift;
- my($name) = shift;
- my($val) = $self->get_value_with_default($name);
+ my($self, $name) = @_;
+ my $val = $self->get_value_with_default($name);
$self->append_current($self->perform_full_path($val));
}
sub evaluate_nested_functions {
- my($self) = shift;
- my($name) = shift;
- my($val) = shift;
+ my($self, $name, $val) = @_;
## Get the value based on the string
- my(@cmds) = ($name);
+ 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_';
+ my $type = 0x01;
+ my $prefix = 'get_';
foreach my $cmd (reverse @cmds) {
if (defined $keywords{$cmd} && ($keywords{$cmd} & $type) != 0) {
- my($func) = "$prefix$cmd";
+ my $func = "$prefix$cmd";
if ($type == 0x01) {
$val = $self->$func($val);
$val = [ $val ] if (!UNIVERSAL::isa($val, 'ARRAY'));
}
else {
- my(@array) = $self->$func($val);
+ my @array = $self->$func($val);
$val = \@array;
}
@@ -1537,15 +1480,13 @@ sub evaluate_nested_functions {
}
sub get_dirname {
- my($self) = shift;
- my($name) = shift;
+ my($self, $name) = @_;
return $self->doif_dirname($self->get_value_with_default($name));
}
sub doif_dirname {
- my($self) = shift;
- my($value) = shift;
+ my($self, $value) = @_;
if (defined $value) {
$value = $self->validated_dirname($value);
@@ -1556,8 +1497,7 @@ sub doif_dirname {
sub handle_dirname {
- my($self) = shift;
- my($name) = shift;
+ my($self, $name) = @_;
$self->append_current(
$self->validated_dirname($self->get_value_with_default($name)));
@@ -1565,8 +1505,7 @@ sub handle_dirname {
sub handle_basename {
- my($self) = shift;
- my($name) = shift;
+ my($self, $name) = @_;
$self->append_current(
$self->tp_basename($self->get_value_with_default($name)));
@@ -1574,9 +1513,8 @@ sub handle_basename {
sub handle_basenoextension {
- my($self) = shift;
- my($name) = shift;
- my($val) = $self->tp_basename($self->get_value_with_default($name));
+ my($self, $name) = @_;
+ my $val = $self->tp_basename($self->get_value_with_default($name));
$val =~ s/\.[^\.]+$//;
$self->append_current($val);
@@ -1584,9 +1522,8 @@ sub handle_basenoextension {
sub handle_flag_overrides {
- my($self) = shift;
- my($name) = shift;
- my($value) = $self->get_flag_overrides($name);
+ my($self, $name) = @_;
+ my $value = $self->get_flag_overrides($name);
if (defined $value) {
$self->append_current($value);
@@ -1595,9 +1532,8 @@ sub handle_flag_overrides {
sub handle_marker {
- my($self) = shift;
- my($name) = shift;
- my($val) = $self->{'prjc'}->get_verbatim($name);
+ my($self, $name) = @_;
+ my $val = $self->{'prjc'}->get_verbatim($name);
if (defined $val) {
$self->append_current($val);
@@ -1606,9 +1542,8 @@ sub handle_marker {
sub handle_eval {
- my($self) = shift;
- my($name) = shift;
- my($val) = $self->get_value_with_default($name);
+ my($self, $name) = @_;
+ my $val = $self->get_value_with_default($name);
if (defined $val) {
if (index($val, "<%eval($name)%>") >= 0) {
@@ -1636,32 +1571,29 @@ sub handle_eval {
sub handle_pseudo {
- my($self) = shift;
- my($name) = shift;
+ my($self, $name) = @_;
$self->append_current($self->{'cmds'}->{$name});
}
sub get_duplicate_index {
- my($self) = shift;
- my($name) = shift;
+ my($self, $name) = @_;
return $self->doif_duplicate_index($self->get_value_with_default($name));
}
sub doif_duplicate_index {
- my($self) = shift;
- my($value) = shift;
+ my($self, $value) = @_;
if (defined $value) {
- my($base) = lc($self->tp_basename($value));
- my($path) = $self->validated_dirname($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;
+ my $index = 1;
foreach my $file (@{$self->{'dupfiles'}->{$base}}) {
if ($file eq $path) {
return $index;
@@ -1679,11 +1611,10 @@ sub doif_duplicate_index {
sub handle_duplicate_index {
- my($self) = shift;
- my($name) = shift;
+ my($self, $name) = @_;
- my($value) = $self->doif_duplicate_index(
- $self->get_value_with_default($name));
+ my $value = $self->doif_duplicate_index(
+ $self->get_value_with_default($name));
if (defined $value) {
$self->append_current($value);
}
@@ -1691,15 +1622,13 @@ sub handle_duplicate_index {
sub get_transdir {
- my($self) = shift;
- my($name) = shift;
+ my($self, $name) = @_;
return $self->doif_transdir($self->get_value_with_default($name));
}
sub doif_transdir {
- my($self) = shift;
- my($value) = shift;
+ my($self, $value) = @_;
if ($value =~ /([\/\\])/) {
return $self->{'prjc'}->translate_directory(
@@ -1711,9 +1640,8 @@ sub doif_transdir {
sub handle_transdir {
- my($self) = shift;
- my($name) = shift;
- my($value) = $self->doif_transdir($self->get_value_with_default($name));
+ my($self, $name) = @_;
+ my $value = $self->doif_transdir($self->get_value_with_default($name));
if (defined $value) {
$self->append_current($value);
@@ -1722,19 +1650,18 @@ sub handle_transdir {
sub prepare_parameters {
- my($self) = shift;
- my($prefix) = shift;
- my($input) = $self->get_value($prefix . '->input_file');
- my($output) = undef;
+ 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);
+ my $size = scalar(@$output);
for(my $i = 0; $i < $size; ++$i) {
- my($fo) = $self->get_flag_overrides($prefix . '->input_file, gendir');
+ my $fo = $self->get_flag_overrides($prefix . '->input_file, gendir');
if (defined $fo) {
$$output[$i] = ($fo eq '.' ? '' : $fo . '/') .
$self->tp_basename($$output[$i]);
@@ -1750,15 +1677,14 @@ sub prepare_parameters {
sub process_name {
- my($self) = shift;
- my($line) = shift;
- my($length) = 0;
- my($errorString) = undef;
+ 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;
+ my $name = lc($1);
+ my $val = $3;
$length += length($name);
if (defined $val) {
@@ -1802,7 +1728,7 @@ sub process_name {
$self->evaluate_nested_functions($name, $val);
}
else {
- my($func) = 'handle_' . $name;
+ my $func = 'handle_' . $name;
$self->$func($val);
if ($self->{'error_in_handle'}) {
$errorString = $self->{'error_in_handle'};
@@ -1826,10 +1752,10 @@ sub process_name {
}
}
else {
- my($error) = $line;
- my($length) = length($line);
+ my $error = $line;
+ my $length = length($line);
for(my $i = 0; $i < $length; ++$i) {
- my($part) = substr($line, $i, 2);
+ my $part = substr($line, $i, 2);
if ($part eq '%>') {
$error = substr($line, 0, $i + 2);
last;
@@ -1843,9 +1769,9 @@ sub process_name {
sub collect_data {
- my($self) = shift;
- my($prjc) = $self->{'prjc'};
- my($cwd) = $self->getcwd();
+ my $self = shift;
+ my $prjc = $self->{'prjc'};
+ my $cwd = $self->getcwd();
## Set the current working directory
$cwd =~ s/\//\\/g if ($self->{'cslashes'});
@@ -1853,7 +1779,7 @@ sub collect_data {
## Collect the components into {'values'} somehow
foreach my $key (keys %{$prjc->{'valid_components'}}) {
- my(@list) = $prjc->get_component_list($key);
+ my @list = $prjc->get_component_list($key);
if (defined $list[0]) {
$self->{'values'}->{$key} = \@list;
}
@@ -1863,8 +1789,8 @@ sub collect_data {
## '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');
+ 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;
@@ -1896,7 +1822,7 @@ sub collect_data {
## 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']);
+ 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
@@ -1905,7 +1831,7 @@ sub collect_data {
## 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');
+ my $version = $prjc->get_assignment('version');
if (defined $version) {
$self->{'values'}->{'win_version'} =
WinVersionTranslator::translate($version);
@@ -1914,11 +1840,9 @@ sub collect_data {
sub parse_line {
- my($self) = $_[0];
- #my($ih) = $_[1];
- my($line) = $_[2];
- my($errorString) = undef;
- my($startempty) = ($line eq '');
+ my($self, $ih, $line) = @_;
+ my $errorString;
+ my $startempty = ($line eq '');
## If processing a foreach or the line only
## contains a keyword, then we do
@@ -1933,9 +1857,9 @@ sub parse_line {
$self->{'built'} = '';
}
- my($start) = index($line, '<%');
+ my $start = index($line, '<%');
if ($start >= 0) {
- my($append_name) = undef;
+ my $append_name;
if ($start > 0) {
if (!$self->{'if_skip'}) {
$self->append_current(substr($line, 0, $start));
@@ -1943,11 +1867,11 @@ sub parse_line {
$line = substr($line, $start);
}
- my($nlen) = 0;
+ my $nlen = 0;
foreach my $item (split('<%', $line)) {
- my($name) = 1;
- my($length) = length($item);
- my($endi) = index($item, '%>');
+ my $name = 1;
+ my $length = length($item);
+ my $endi = index($item, '%>');
for(my $i = 0; $i < $length; ++$i) {
if ($i == $endi) {
++$i;
@@ -1967,8 +1891,8 @@ sub parse_line {
}
}
elsif ($name) {
- my($efcheck) = (index($item, 'endfor%>') == 0);
- my($focheck) = ($efcheck ? 0 : (index($item, 'foreach(') == 0));
+ my $efcheck = (index($item, 'endfor%>') == 0);
+ my $focheck = ($efcheck ? 0 : (index($item, 'foreach(') == 0));
if ($focheck && $self->{'foreach'}->{'count'} >= 0) {
++$self->{'foreach'}->{'nested'};
@@ -2032,23 +1956,22 @@ sub parse_line {
sub parse_file {
- my($self) = shift;
- my($input) = shift;
+ my($self, $input) = @_;
$self->collect_data();
my($status, $errorString) = $self->cached_file_read($input);
if ($status) {
if (defined $self->{'sstack'}->[0]) {
- my($sstack) = $self->{'sstack'};
- my($lstack) = $self->{'lstack'};
+ my $sstack = $self->{'sstack'};
+ my $lstack = $self->{'lstack'};
$status = 0;
$errorString = "Missing an '$$sstack[0]' starting at $$lstack[0]";
}
}
if (!$status) {
- my($linenumber) = $self->get_line_number();
+ my $linenumber = $self->get_line_number();
$errorString = "$input: line $linenumber:\n$errorString";
}
@@ -2057,8 +1980,7 @@ sub parse_file {
sub get_lines {
- my($self) = shift;
- return $self->{'lines'};
+ return $_[0]->{'lines'};
}
diff --git a/modules/VCProjectBase.pm b/modules/VCProjectBase.pm
index 03991556..7b2eb9b9 100644
--- a/modules/VCProjectBase.pm
+++ b/modules/VCProjectBase.pm
@@ -28,7 +28,7 @@ sub compare_output {
sub require_dependencies {
- my($self) = shift;
+ my $self = shift;
## Only write dependencies for non-static projects
## and static exe projects, unless the user wants the
diff --git a/modules/Version.pm b/modules/Version.pm
index 9d71771b..00ac9c53 100644
--- a/modules/Version.pm
+++ b/modules/Version.pm
@@ -17,8 +17,8 @@ use strict;
# ************************************************************
## This is the starting major and minor version
-my($version) = '3.6';
-my($once) = 1;
+my $version = '3.6';
+my $once = 1;
# ************************************************************
# Subroutine Section
@@ -34,7 +34,7 @@ sub get {
## 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;
+ my $base = -1;
if (open(CLH, ::getBasePath() . '/ChangeLog')) {
while(<CLH>) {
if (/^\w\w\w\s\w\w\w\s/) {
diff --git a/modules/WinProjectBase.pm b/modules/WinProjectBase.pm
index 08ae89ba..4a2bc7bb 100644
--- a/modules/WinProjectBase.pm
+++ b/modules/WinProjectBase.pm
@@ -16,7 +16,7 @@ use strict;
# Data Section
# ************************************************************
-my($max_win_env) = 'MPC_MAX_WIN_FILE_LENGTH';
+my $max_win_env = 'MPC_MAX_WIN_FILE_LENGTH';
# ************************************************************
# Subroutine Section
@@ -35,8 +35,7 @@ sub case_insensitive {
sub translate_directory {
- my($self) = shift;
- my($dir) = shift;
+ my($self, $dir) = @_;
## Call the base class version
$dir = $self->DirectoryManager::translate_directory($dir);
@@ -49,10 +48,10 @@ sub translate_directory {
## 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;
+ 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) {
@@ -70,8 +69,7 @@ sub translate_directory {
sub validated_directory {
- my($self) = shift;
- my($dir) = shift;
+ my($self, $dir) = @_;
## $(...) could contain a drive letter and Windows can not
## make a directory that resembles a drive letter. So, we have
@@ -86,8 +84,7 @@ sub validated_directory {
sub crlf {
- my($self) = shift;
- return $self->windows_crlf();
+ return $_[0]->windows_crlf();
}
diff --git a/modules/WinWorkspaceBase.pm b/modules/WinWorkspaceBase.pm
index 2a8c2746..aea68f99 100644
--- a/modules/WinWorkspaceBase.pm
+++ b/modules/WinWorkspaceBase.pm
@@ -17,8 +17,7 @@ use strict;
# ************************************************************
sub crlf {
- my($self) = shift;
- return $self->windows_crlf();
+ return $_[0]->windows_crlf();
}
diff --git a/modules/WorkspaceCreator.pm b/modules/WorkspaceCreator.pm
index 3d08aa57..34464e6b 100644
--- a/modules/WorkspaceCreator.pm
+++ b/modules/WorkspaceCreator.pm
@@ -25,70 +25,41 @@ use vars qw(@ISA);
# Data Section
# ************************************************************
-my($wsext) = 'mwc';
-my($wsbase) = 'mwb';
+my $wsext = 'mwc';
+my $wsbase = 'mwb';
## Valid names for assignments within a workspace
-my(%validNames) = ('cmdline' => 1,
- 'implicit' => 1,
- );
+my %validNames = ('cmdline' => 1,
+ 'implicit' => 1,
+ );
## Singleton hash maps of project information
-my(%allprinfo) = ();
-my(%allprojects) = ();
-my(%allliblocs) = ();
+my %allprinfo;
+my %allprojects;
+my %allliblocs;
## Global previous workspace names
-my(%previous_workspace_name) = ();
+my %previous_workspace_name;
## Constant aggregated workspace type name
-my($aggregated) = 'aggregated_workspace';
+my $aggregated = 'aggregated_workspace';
-my($onVMS) = DirectoryManager::onVMS();
+my $onVMS = DirectoryManager::onVMS();
# ************************************************************
# Subroutine Section
# ************************************************************
sub new {
- my($class) = shift;
- my($global) = shift;
- my($inc) = shift;
- my($template) = shift;
- my($ti) = shift;
- my($dynamic) = shift;
- my($static) = shift;
- my($relative) = shift;
- my($addtemp) = shift;
- my($addproj) = shift;
- my($progress) = shift;
- my($toplevel) = shift;
- my($baseprojs) = shift;
- my($gfeature) = shift;
- my($relative_f) = shift;
- my($feature) = shift;
- my($features) = shift;
- my($hierarchy) = shift;
- my($exclude) = shift;
- my($makeco) = shift;
- my($nmod) = shift;
- my($applypj) = shift;
- my($genins) = shift;
- my($into) = shift;
- my($language) = shift;
- my($use_env) = shift;
- my($expandvars) = shift;
- my($gendot) = shift;
- my($comments) = shift;
- my($foreclipse) = shift;
- 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');
+ 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
@@ -124,7 +95,7 @@ sub new {
$self->{'workspace_comments'} = $comments;
if (defined $$exclude[0]) {
- my($type) = $self->{'wctype'};
+ my $type = $self->{'wctype'};
if (!defined $self->{'exclude'}->{$type}) {
$self->{'exclude'}->{$type} = [];
}
@@ -174,7 +145,7 @@ sub parse_line {
## Was the line recognized?
if ($status && defined $values[0]) {
if ($values[0] eq $self->{'grammar_type'}) {
- my($name) = $values[1];
+ my $name = $values[1];
if (defined $name && $name eq '}') {
if (!defined $self->{'reading_parent'}->[0]) {
## Fill in all the default values
@@ -209,7 +180,7 @@ sub parse_line {
if (defined $values[2]) {
foreach my $parent (@{$values[2]}) {
## Read in the parent onto ourself
- my($file) = $self->search_include_path("$parent.$wsbase");
+ my $file = $self->search_include_path("$parent.$wsbase");
if (!defined $file) {
$file = $self->search_include_path("$parent.$wsext");
}
@@ -282,7 +253,7 @@ sub parse_line {
}
}
elsif ($values[0] eq 'component') {
- my(%copy) = %{defined $flags ? $flags : $self->get_assignment_hash()};
+ my %copy = %{defined $flags ? $flags : $self->get_assignment_hash()};
($status, $error) = $self->parse_scope($ih,
$values[1],
$values[2],
@@ -301,7 +272,7 @@ sub parse_line {
foreach my $expfile ($line =~ /[\?\*\[\]]/ ? $self->mpc_glob($line) :
$line) {
if ($expfile =~ /\.$wsext$/) {
- my(%copy) = %{defined $flags ? $flags : $self->get_assignment_hash()};
+ my %copy = %{defined $flags ? $flags : $self->get_assignment_hash()};
($status, $error) = $self->aggregated_workspace($expfile, \%copy);
last if (!$status);
}
@@ -318,13 +289,13 @@ sub parse_line {
sub aggregated_workspace {
my($self, $file, $flags) = @_;
- my($fh) = new FileHandle();
+ 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 $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;
@@ -333,7 +304,7 @@ sub aggregated_workspace {
$self->{'scoped_basedir'} = $self->mpc_dirname($file);
while(<$fh>) {
- my($line) = $self->preprocess_line($fh, $_);
+ my $line = $self->preprocess_line($fh, $_);
($status, $error, @values) = $self->parse_known($line);
## Was the line recognized?
@@ -341,7 +312,7 @@ sub aggregated_workspace {
if (defined $values[0]) {
if ($values[0] eq $self->{'grammar_type'}) {
if (defined $values[2]) {
- my($name) = $self->mpc_basename($file);
+ my $name = $self->mpc_basename($file);
$name =~ s/\.[^\.]+$//;
$status = 0;
$error = 'Aggregated workspace (' . $name .
@@ -401,7 +372,7 @@ sub parse_scope {
sub process_types {
my($self, $typestr) = @_;
- my(%types) = ();
+ my %types;
@types{split(/\s*,\s*/, $typestr)} = ();
## If there is a negation at all, add our
@@ -425,16 +396,16 @@ sub process_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;
+ 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, $_);
+ my $line = $self->preprocess_line($fh, $_);
if ($line eq '') {
}
@@ -498,7 +469,7 @@ sub parse_exclude {
## 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, $_);
+ my $line = $self->preprocess_line($fh, $_);
if ($line =~ /^(\w+)\s*(\([^\)]+\))?\s*{$/) {
++$count;
@@ -525,17 +496,17 @@ sub parse_exclude {
sub parse_associate {
my($self, $fh, $assoc_key) = @_;
- my($status) = 0;
- my($errorString) = 'Unable to process associate';
- my($count) = 1;
- my(@projects) = ();
+ 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, $_);
+ my $line = $self->preprocess_line($fh, $_);
if ($line eq '') {
}
@@ -602,8 +573,8 @@ sub excluded {
sub handle_scoped_end {
my($self, $type, $flags) = @_;
- my($status) = 1;
- my($error) = undef;
+ my $status = 1;
+ my $error;
if ($type eq $aggregated &&
!defined $self->{'handled_scopes'}->{$type}) {
@@ -611,7 +582,7 @@ sub handle_scoped_end {
## scoped_basedir. We have to do it now otherwise, $PWD will be the
## wrong directory if it's done later.
if (defined $$flags{'cmdline'}) {
- my($dir) = $self->getcwd() . '/' . $self->{'scoped_basedir'};
+ my $dir = $self->getcwd() . '/' . $self->{'scoped_basedir'};
$$flags{'cmdline'} =~ s/\$PWD(\W)/$dir$1/g;
$$flags{'cmdline'} =~ s/\$PWD$/$dir/;
}
@@ -627,14 +598,14 @@ sub handle_scoped_end {
sub handle_scoped_unknown {
my($self, $fh, $type, $flags, $line) = @_;
- my($status) = 1;
- my($error) = undef;
- my($dupchk) = undef;
+ my $status = 1;
+ my $error;
+ my $dupchk;
if ($line =~ /^\w+.*{/) {
if (defined $fh) {
- my(@values) = ();
- my($tc) = $self->{$self->{'type_check'}};
+ 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;
@@ -654,7 +625,7 @@ sub handle_scoped_unknown {
if ($self->path_is_relative($line)) {
$line = $self->{'scoped_basedir'} . ($line ne '.' ? "/$line" : '');
}
- my(%dup) = ();
+ my %dup;
@dup{@{$self->{'project_files'}}} = ();
$dupchk = \%dup;
@@ -667,7 +638,7 @@ sub handle_scoped_unknown {
}
if (-d $line) {
- my(@files) = ();
+ my @files;
$self->search_for_files([ $line ], \@files, $$flags{'implicit'});
## If we are generating implicit projects within a scope, then
@@ -675,10 +646,10 @@ sub handle_scoped_unknown {
## there is an mpc file. Otherwise, the projects will be added
## twice.
if ($$flags{'implicit'}) {
- my(%remove) = ();
+ my %remove;
foreach my $file (@files) {
if ($file =~ /\.mpc$/) {
- my($exc) = $file;
+ my $exc = $file;
do {
$exc = $self->mpc_dirname($exc);
$remove{$exc} = 1;
@@ -686,7 +657,7 @@ sub handle_scoped_unknown {
}
}
- my(@acceptable) = ();
+ my @acceptable;
foreach my $file (@files) {
if (!defined $remove{$file}) {
push(@acceptable, $file);
@@ -738,14 +709,14 @@ sub handle_scoped_unknown {
sub search_for_files {
my($self, $files, $array, $impl) = @_;
- my($excluded) = 0;
+ my $excluded = 0;
foreach my $file (@$files) {
if (-d $file) {
- my(@f) = $self->generate_default_file_list(
- $file,
- $self->{'exclude'}->{$self->{'wctype'}},
- \$excluded);
+ my @f = $self->generate_default_file_list(
+ $file,
+ $self->{'exclude'}->{$self->{'wctype'}},
+ \$excluded);
$self->search_for_files(\@f, $array, $impl);
if ($impl) {
$file =~ s/^\.\///;
@@ -774,10 +745,10 @@ sub search_for_files {
sub remove_duplicate_projects {
my($self, $list) = @_;
- my($count) = scalar(@$list);
+ my $count = scalar(@$list);
for(my $i = 0; $i < $count; ++$i) {
- my($file) = $$list[$i];
+ my $file = $$list[$i];
foreach my $inner (@$list) {
if ($file ne $inner &&
$file eq $self->mpc_dirname($inner) && ! -d $inner) {
@@ -793,18 +764,18 @@ sub remove_duplicate_projects {
sub generate_default_components {
my($self, $files, $impl, $excluded) = @_;
- my($pjf) = $self->{'project_files'};
+ my $pjf = $self->{'project_files'};
if (defined $$pjf[0]) {
## If we have files, then process directories
- my(@built) = ();
+ 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'}});
+ 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'}) {
@@ -848,8 +819,8 @@ sub generate_default_components {
sub get_default_workspace_name {
- my($self) = shift;
- my($name) = $self->{'current_input'};
+ my $self = shift;
+ my $name = $self->{'current_input'};
if ($name eq '') {
$name = $self->base_directory();
@@ -868,7 +839,7 @@ sub get_default_workspace_name {
sub generate_defaults {
- my($self) = shift;
+ my $self = shift;
## Generate default workspace name
if (!defined $self->{'workspace_name'}) {
@@ -877,9 +848,9 @@ sub generate_defaults {
## 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() . '/';
+ my @original;
+ my $top = $self->getcwd() . '/';
+ my $start = $self->getstartdir() . '/';
if ($start ne $top && $top =~ s/^$start//) {
foreach my $exclude (@{$self->{'exclude'}->{$self->{'wctype'}}}) {
@@ -888,11 +859,11 @@ sub generate_defaults {
}
}
- my($excluded) = 0;
- my(@files) = $self->generate_default_file_list(
- '.',
- $self->{'exclude'}->{$self->{'wctype'}},
- \$excluded);
+ my $excluded = 0;
+ my @files = $self->generate_default_file_list(
+ '.',
+ $self->{'exclude'}->{$self->{'wctype'}},
+ \$excluded);
## Generate default components
$self->generate_default_components(\@files,
@@ -907,14 +878,12 @@ sub generate_defaults {
sub get_workspace_name {
- my($self) = shift;
- return $self->{'workspace_name'};
+ return $_[0]->{'workspace_name'};
}
sub get_current_output_name {
- my($self) = shift;
- return $self->{'current_output'};
+ return $_[0]->{'current_output'};
}
@@ -982,24 +951,24 @@ sub write_and_compare_file {
sub write_workspace {
my($self, $creator, $addfile) = @_;
- my($status) = 1;
- my($error) = undef;
- my($duplicates) = 0;
+ 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();
+ 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) = ();
+ my %names;
foreach my $project (@{$self->{'projects'}}) {
- my($name) = lc($self->{'project_info'}->{$project}->[0]);
+ my $name = lc($self->{'project_info'}->{$project}->[0]);
if (defined $names{$name}) {
++$duplicates;
$self->error("Duplicate case-insensitive project '$name'. " .
@@ -1016,9 +985,9 @@ sub write_workspace {
$self->{'per_project_workspace_name'} = 1;
}
- my($name) = $self->transform_file_name($self->workspace_file_name());
+ my $name = $self->transform_file_name($self->workspace_file_name());
- my($abort_creation) = 0;
+ my $abort_creation = 0;
if ($duplicates > 0) {
$abort_creation = 1;
$error = "Duplicate case-insensitive project names are " .
@@ -1069,17 +1038,17 @@ sub write_workspace {
}
if ($addfile && $self->{'generate_dot'}) {
- my($dh) = new FileHandle();
- my($wsname) = $self->get_workspace_name();
+ 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);
+ 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];
+ my $pname = $self->{'project_info'}->{$project}->[0];
foreach my $number (@{$targnum{$project}}) {
print $dh " $pname -> ",
"$self->{'project_info'}->{$list[$number]}->[0];\n";
@@ -1106,12 +1075,12 @@ sub write_workspace {
sub save_project_info {
my($self, $gen, $gpi, $gll, $dir, $projects, $pi, $ll) = @_;
- my($c) = 0;
+ 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;
+ my $full = ($dir ne '.' ? "$dir/" : '') . $pj;
push(@$projects, $full);
## Get the corresponding generated project info and save it
@@ -1128,8 +1097,8 @@ sub save_project_info {
sub topname {
my($self, $file) = @_;
- my($dir) = '.';
- my($rest) = $file;
+ my $dir = '.';
+ my $rest = $file;
if ($file =~ /^([^\/\\]+)[\/\\](.*)/) {
$dir = $1;
$rest = $2;
@@ -1140,18 +1109,18 @@ sub topname {
sub generate_hierarchy {
my($self, $creator, $origproj, $originfo) = @_;
- my($current) = undef;
- my(@saved) = ();
- my(%sinfo) = ();
- my($cwd) = $self->getcwd();
+ 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};
+ 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);
@@ -1207,20 +1176,20 @@ sub generate_hierarchy {
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();
+ 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.
@@ -1234,26 +1203,26 @@ sub generate_project_files {
foreach my $ofile (@{$self->{'project_files'}}) {
if (!$self->excluded($ofile)) {
- my($file) = $ofile;
- my($dir) = $self->mpc_dirname($file);
- my($restore) = 0;
+ 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'};
+ 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'};
+ 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();
+ my %parameters = $self->current_parameters();
$self->process_cmdline($cmdline, \%parameters);
## Set the parameters on the creator
@@ -1271,7 +1240,7 @@ sub generate_project_files {
## 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();
+ my $bps = $creator->get_baseprojs();
push(@$bps, split(/\s+/, $impl));
$restore = 1;
$self->{'cacheok'} = 0;
@@ -1279,15 +1248,15 @@ sub generate_project_files {
}
## Generate the key for this project file
- my($prkey) = $self->getcwd() . '/' .
- ($file eq '' ? $dir : $file) . "-$postkey";
+ 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) = {};
+ 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};
@@ -1358,7 +1327,7 @@ sub generate_project_files {
## 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'};
+ my $orig = $self->{'workspace_name'};
$self->generate_hierarchy($creator, \@projects, \%pi);
$self->{'workspace_name'} = $orig;
}
@@ -1373,7 +1342,7 @@ sub generate_project_files {
sub array_contains {
my($self, $left, $right) = @_;
- my(%check) = ();
+ my %check;
## Initialize the hash keys with the left side array
@check{@$left} = ();
@@ -1391,8 +1360,8 @@ sub array_contains {
sub non_intersection {
my($self, $left, $right, $over) = @_;
- my($status) = 0;
- my(%check) = ();
+ my $status = 0;
+ my %check;
## Initialize the hash keys with the left side array
@check{@$left} = ();
@@ -1419,8 +1388,8 @@ sub indirect_dependency {
return 1;
}
else {
- my($deps) = $self->create_array(
- $self->{'project_info'}->{$ccheck}->[1]);
+ 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"} &&
@@ -1436,8 +1405,8 @@ sub indirect_dependency {
sub add_implicit_project_dependencies {
my($self, $creator, $cwd) = @_;
- my(%bidir) = ();
- my(%save) = ();
+ my %bidir;
+ my %save;
## Take the current working directory and regular expression'ize it.
$cwd = $self->escape_regex_special($cwd);
@@ -1448,7 +1417,7 @@ sub add_implicit_project_dependencies {
## 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'}};
+ my @pflkeys = keys %{$self->{'project_file_list'}};
foreach my $key (@pflkeys) {
foreach my $ikey (@pflkeys) {
## Not the same project and
@@ -1459,7 +1428,7 @@ sub add_implicit_project_dependencies {
$self->{'project_file_list'}->{$ikey}->[1]) &&
(!defined $bidir{$ikey} ||
!$self->array_contains($bidir{$ikey}, [$key]))) {
- my(@over) = ();
+ my @over;
if ($self->non_intersection(
$self->{'project_file_list'}->{$key}->[2],
$self->{'project_file_list'}->{$ikey}->[2],
@@ -1474,17 +1443,17 @@ sub add_implicit_project_dependencies {
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);
+ 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;
+ my $ccheck = $append;
$ccheck =~ s/"//g;
if ($dir ne '') {
$dir .= '/';
@@ -1517,60 +1486,55 @@ sub add_implicit_project_dependencies {
sub get_projects {
- my($self) = shift;
- return $self->{'projects'};
+ return $_[0]->{'projects'};
}
sub get_project_info {
- my($self) = shift;
- return $self->{'project_info'};
+ return $_[0]->{'project_info'};
}
sub get_lib_locations {
- my($self) = shift;
- return $self->{'lib_locations'};
+ return $_[0]->{'lib_locations'};
}
sub get_first_level_directory {
my($self, $file) = @_;
- my($dir) = undef;
+
if (($file =~ tr/\///) > 0) {
- $dir = $file;
+ my $dir = $file;
$dir =~ s/^([^\/]+\/).*/$1/;
$dir =~ s/\/+$//;
+ return $dir;
}
- else {
- $dir = '.';
- }
- return $dir;
+
+ return '.';
}
sub get_associated_projects {
- my($self) = shift;
- return $self->{'associated'};
+ return $_[0]->{'associated'};
}
sub sort_within_group {
my($self, $list, $start, $end) = @_;
- my($deps) = undef;
- my(%seen) = ();
- my($ccount) = 0;
- my($cmax) = ($end - $start) + 1;
- my($previ) = -1;
- my($prevpjs) = [];
- my($movepjs) = [];
+ 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";
+ my $key = "@$list";
if ($seen{$key} ||
(defined $$movepjs[0] && defined $$prevpjs[0] &&
$$movepjs[0] == $$prevpjs[0] && $$movepjs[1] == $$prevpjs[1])) {
@@ -1582,11 +1546,11 @@ sub sort_within_group {
## Detect circular dependencies
if ($ccount > $cmax) {
- my(@prjs) = ();
+ my @prjs;
foreach my $mvgr (@$movepjs) {
push(@prjs, $$list[$mvgr]);
}
- my($other) = $$movepjs[0] - 1;
+ my $other = $$movepjs[0] - 1;
if ($other < $start || $other == $$movepjs[1] || !defined $$list[$other]) {
$other = undef;
}
@@ -1610,10 +1574,10 @@ sub sort_within_group {
$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;
+ 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
@@ -1626,7 +1590,7 @@ sub sort_within_group {
## 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];
+ my $save = $$list[$j];
for(my $k = $j; $k > $i; --$k) {
$$list[$k] = $$list[$k - 1];
}
@@ -1649,12 +1613,12 @@ sub sort_within_group {
sub build_dependency_chain {
my($self, $name, $len, $list, $ni, $glen, $groups, $map, $gdeps) = @_;
- my($deps) = $self->get_validated_ordering($name);
+ 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};
+ my $mapped = $$map{$dep};
if (defined $mapped) {
for(my $i = 0; $i < $len; $i++) {
if ($$list[$i] eq $mapped) {
@@ -1666,7 +1630,7 @@ sub build_dependency_chain {
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]);
+ my $ldep = $self->mpc_basename($$list[$k]);
if (!exists $$gdeps{$ldep}) {
$$gdeps{$ldep} = 1;
$self->build_dependency_chain($$list[$k],
@@ -1692,36 +1656,36 @@ sub build_dependency_chain {
sub sort_by_groups {
my($self, $list, $grindex) = @_;
- my(@groups) = @$grindex;
- my($llen) = scalar(@$list);
+ 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) = ();
+ my %dupcheck;
foreach my $proj (@$list) {
- my($base) = $self->mpc_basename($proj);
+ my $base = $self->mpc_basename($proj);
if (defined $dupcheck{$base}) {
return;
}
$dupcheck{$base} = $proj;
}
- my(%circular_checked) = ();
+ 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) = ();
+ 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) = ();
+ my %dirs;
foreach my $gdep (keys %gdeps) {
$dirs{$self->mpc_dirname($dupcheck{$gdep})} = 1;
}
@@ -1729,10 +1693,10 @@ sub sort_by_groups {
## 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();
+ my $cwd = $self->getcwd();
+ my $start = $self->getstartdir();
if ($cwd ne $start) {
- my($startre) = $self->escape_regex_special($start);
+ my $startre = $self->escape_regex_special($start);
delete $dirs{'.'};
$cwd =~ s/^$startre[\\\/]//;
$dirs{$cwd} = 1;
@@ -1740,7 +1704,7 @@ sub sort_by_groups {
}
## Display a warining to the user
- my(@keys) = sort keys %dirs;
+ my @keys = sort keys %dirs;
$self->warning('Circular directory dependency detected in the ' .
($self->{'current_input'} eq '' ?
'default' : $self->{'current_input'}) .
@@ -1754,9 +1718,9 @@ sub sort_by_groups {
}
## Build up the group dependencies
- my(%gdeps) = ();
+ my %gdeps;
for(my $i = $groups[$gi]->[0]; $i <= $groups[$gi]->[1]; ++$i) {
- my($deps) = $self->get_validated_ordering($$list[$i]);
+ my $deps = $self->get_validated_ordering($$list[$i]);
if (defined $$deps[0]) {
@gdeps{@$deps} = ();
}
@@ -1767,11 +1731,11 @@ sub sort_by_groups {
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) = ();
+ 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];
+ my $offset = $groups[$gj]->[1] - $groups[$gi]->[1];
for(my $j = $groups[$gi]->[1]; $j >= $groups[$gi]->[0]; --$j) {
$$list[$j + $offset] = $$list[$j];
}
@@ -1780,12 +1744,12 @@ sub sort_by_groups {
}
## Update the group indices
- my($shiftamt) = ($groups[$gi]->[1] - $groups[$gi]->[0]) + 1;
+ 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]};
+ my @grsave = @{$groups[$gi]};
$grsave[0] += $offset;
$grsave[1] += $offset;
for(my $j = $gi; $j < $gj; ++$j) {
@@ -1810,8 +1774,8 @@ sub sort_by_groups {
sub sort_dependencies {
my($self, $projects, $groups) = @_;
- my(@list) = sort { return $self->sort_projects_by_directory($a, $b) + 0;
- } @$projects;
+ 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.
@@ -1824,10 +1788,10 @@ sub sort_dependencies {
## and was true, sort with directory groups in mind
if (!defined $groups || $groups) {
## First determine the individual groups
- my(@grindex) = ();
- my($previous) = [0, undef];
+ my @grindex;
+ my $previous = [0, undef];
for(my $li = 0; $li <= $#list; ++$li) {
- my($dir) = $self->get_first_level_directory($list[$li]);
+ my $dir = $self->get_first_level_directory($list[$li]);
if (!defined $previous->[1]) {
$previous = [$li, $dir];
}
@@ -1861,17 +1825,17 @@ sub sort_dependencies {
sub number_target_deps {
my($self, $projects, $pjs, $targets, $groups) = @_;
- my(@list) = $self->sort_dependencies($projects, $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];
+ my $project = $list[$i];
if (defined $$pjs{$project}) {
my($name, $deps) = @{$$pjs{$project}};
if (defined $deps && $deps ne '') {
- my(@numbers) = ();
- my(%dhash) = ();
+ my @numbers;
+ my %dhash;
@dhash{@{$self->create_array($deps)}} = ();
## For each dependency, search in the sorted list
@@ -1904,13 +1868,13 @@ sub number_target_deps {
sub project_target_translation {
my($self, $case) = @_;
- my(%map) = ();
+ 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];
+ 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.
@@ -1941,13 +1905,13 @@ sub process_cmdline {
$self->{'cacheok'} = 1;
if (defined $cmdline && $cmdline ne '') {
- my($args) = $self->create_array($cmdline);
+ my $args = $self->create_array($cmdline);
## Look for environment variables
foreach my $arg (@$args) {
while($arg =~ /\$(\w+)/) {
- my($name) = $1;
- my($val) = '';
+ my $name = $1;
+ my $val = '';
if ($name eq 'PWD') {
$val = $self->getcwd();
}
@@ -1958,10 +1922,10 @@ sub process_cmdline {
}
}
- my($options) = $self->options('MWC', {}, 0, @$args);
+ my $options = $self->options('MWC', {}, 0, @$args);
if (defined $options) {
foreach my $key (keys %$options) {
- my($type) = $self->is_set($key, $options);
+ my $type = $self->is_set($key, $options);
if (!defined $type) {
## This option was not used, so we ignore it
@@ -2003,10 +1967,10 @@ sub process_cmdline {
}
## 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');
+ 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;
@@ -2019,8 +1983,8 @@ sub process_cmdline {
sub current_parameters {
- my($self) = shift;
- my(%parameters) = $self->save_state();
+ my $self = shift;
+ my %parameters = $self->save_state();
## We always want the project creator to generate a toplevel
$parameters{'toplevel'} = 1;
@@ -2029,8 +1993,8 @@ sub current_parameters {
sub project_creator {
- my($self) = shift;
- my($str) = "$self";
+ my $self = shift;
+ my $str = "$self";
## NOTE: If the subclassed WorkspaceCreator name prefix does not
## match the name prefix of the ProjectCreator, this code
@@ -2043,8 +2007,8 @@ sub project_creator {
## 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();
+ 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
@@ -2087,15 +2051,14 @@ sub sort_files {
sub make_coexistence {
- my($self) = shift;
- return $self->{'coexistence'};
+ return $_[0]->{'coexistence'};
}
sub get_modified_workspace_name {
my($self, $name, $ext, $nows) = @_;
- my($nmod) = $self->get_name_modifier();
- my($oname) = $name;
+ my $nmod = $self->get_name_modifier();
+ my $oname = $name;
if (defined $nmod) {
$nmod =~ s/\*/$name/g;
@@ -2111,16 +2074,16 @@ sub get_modified_workspace_name {
return "$name$ext";
}
- my($pwd) = $self->getcwd();
- my($type) = $self->{'wctype'};
- my($wsname) = $self->get_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");
+ my $prefix = ($oname eq $wsname ? $name : "$name.$wsname");
$previous_workspace_name{$type}->{$pwd} = $wsname;
while($self->file_written("$prefix" .
($self->{'modified_count'} > 0 ?
@@ -2145,7 +2108,7 @@ sub generate_recursive_input_list {
sub verify_build_ordering {
- my($self) = shift;
+ my $self = shift;
foreach my $project (@{$self->{'projects'}}) {
$self->get_validated_ordering($project);
}
@@ -2154,7 +2117,7 @@ sub verify_build_ordering {
sub get_validated_ordering {
my($self, $project) = @_;
- my($deps) = undef;
+ my $deps;
if (defined $self->{'ordering_cache'}->{$project}) {
$deps = $self->{'ordering_cache'}->{$project};
@@ -2165,10 +2128,10 @@ sub get_validated_ordering {
my($name, $dstr) = @{$self->{'project_info'}->{$project}};
if (defined $dstr && $dstr ne '') {
$deps = $self->create_array($dstr);
- my($dlen) = scalar(@$deps);
+ my $dlen = scalar(@$deps);
for(my $i = 0; $i < $dlen; $i++) {
- my($dep) = $$deps[$i];
- my($found) = 0;
+ 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'}}) {
@@ -2207,10 +2170,10 @@ sub get_validated_ordering {
sub source_listing_callback {
- my($self) = shift;
- my($project_file) = shift;
- my($project_name) = shift;
- my($cwd) = $self->getcwd();
+ my $self = shift;
+ my $project_file = shift;
+ my $project_name = shift;
+ my $cwd = $self->getcwd();
$self->{'project_file_list'}->{$project_name} = [ $project_file,
$cwd, \@_ ];
}
@@ -2218,8 +2181,8 @@ sub source_listing_callback {
sub sort_projects_by_directory {
my($self, $left, $right) = @_;
- my($sa) = index($left, '/');
- my($sb) = index($right, '/');
+ my $sa = index($left, '/');
+ my $sb = index($right, '/');
if ($sa >= 0 && $sb == -1) {
return 1;
@@ -2246,12 +2209,12 @@ sub get_relative_dep_file {
}
if (defined $self->{'project_file_list'}->{$dep}) {
- my($base) = $self->{'project_file_list'}->{$dep}->[1];
- my(@dirs) = grep(!/^$/, split('/', $base));
- my($last) = -1;
+ 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];
+ my $dir = $dirs[$i];
if ($project =~ s/^$dir\///) {
$last = $i;
}
@@ -2260,17 +2223,17 @@ sub get_relative_dep_file {
}
}
- my($dependee) = $self->{'project_file_list'}->{$dep}->[0];
+ my $dependee = $self->{'project_file_list'}->{$dep}->[0];
if ($last == -1) {
return $base . '/' . $dependee;
}
else {
- my($built) = '';
+ my $built = '';
for(my $i = $last + 1; $i <= $#dirs; $i++) {
$built .= $dirs[$i] . '/';
}
$built .= $dependee;
- my($dircount) = ($project =~ tr/\///);
+ my $dircount = ($project =~ tr/\///);
return ('../' x $dircount) . $built;
}
}
@@ -2279,9 +2242,9 @@ sub get_relative_dep_file {
sub create_command_line_string {
- my($self) = shift;
- my(@args) = @_;
- my($str) = undef;
+ my $self = shift;
+ my @args = @_;
+ my $str;
foreach my $arg (@args) {
$arg =~ s/^\-\-/-/;
@@ -2298,8 +2261,8 @@ sub create_command_line_string {
sub print_workspace_comment {
- my($self) = shift;
- my($fh) = shift;
+ my $self = shift;
+ my $fh = shift;
if ($self->{'workspace_comments'}) {
foreach my $line (@_) {
@@ -2310,14 +2273,13 @@ sub print_workspace_comment {
sub get_initial_relative_values {
- my($self) = shift;
+ my $self = shift;
return $self->get_relative(), $self->get_expand_vars();
}
sub get_secondary_relative_values {
- my($self) = shift;
- return \%ENV, $self->get_expand_vars();
+ return \%ENV, $_[0]->get_expand_vars();
}
@@ -2328,15 +2290,15 @@ sub convert_all_variables {
sub workspace_file_name {
- my($self) = shift;
+ 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);
+ my $self = shift;
+ my $line = $self->SUPER::relative(shift);
$line =~ s/\\/\//g;
return $line;
}
diff --git a/modules/WorkspaceHelper.pm b/modules/WorkspaceHelper.pm
index 17c694d0..8c50e07c 100644
--- a/modules/WorkspaceHelper.pm
+++ b/modules/WorkspaceHelper.pm
@@ -16,14 +16,14 @@ use strict;
# Data Section
# ************************************************************
-my(%required) = ();
+my %required;
# ************************************************************
# Subroutine Section
# ************************************************************
sub get {
- my($type) = shift;
+ my $type = shift;
## Create the helper name
$type =~ s/Creator/Helper/;
@@ -52,16 +52,13 @@ sub get {
sub new {
- my($class) = shift;
- return bless {
- }, $class;
+ my $class = shift;
+ return bless {}, $class;
}
sub modify_value {
- my($self) = shift;
- my($name) = shift;
- my($value) = shift;
+ my($self, $name, $value) = @_;
return $value;
}
diff --git a/mpc.pl b/mpc.pl
index 1fcfd350..34ed0c1f 100755
--- a/mpc.pl
+++ b/mpc.pl
@@ -19,7 +19,7 @@ use FindBin;
use File::Spec;
use File::Basename;
-my($basePath) = $FindBin::Bin;
+my $basePath = $FindBin::Bin;
if ($^O eq 'VMS') {
$basePath = File::Spec->rel2abs(dirname($0)) if ($basePath eq '');
$basePath = VMS::Filespec::unixify($basePath);
@@ -40,5 +40,5 @@ sub getBasePath {
# Main Section
# ************************************************************
-my($driver) = new Driver($basePath, basename($0));
+my $driver = new Driver($basePath, basename($0));
exit($driver->run(@ARGV));
diff --git a/mwc.pl b/mwc.pl
index 1fcfd350..34ed0c1f 100755
--- a/mwc.pl
+++ b/mwc.pl
@@ -19,7 +19,7 @@ use FindBin;
use File::Spec;
use File::Basename;
-my($basePath) = $FindBin::Bin;
+my $basePath = $FindBin::Bin;
if ($^O eq 'VMS') {
$basePath = File::Spec->rel2abs(dirname($0)) if ($basePath eq '');
$basePath = VMS::Filespec::unixify($basePath);
@@ -40,5 +40,5 @@ sub getBasePath {
# Main Section
# ************************************************************
-my($driver) = new Driver($basePath, basename($0));
+my $driver = new Driver($basePath, basename($0));
exit($driver->run(@ARGV));
diff --git a/prj_install.pl b/prj_install.pl
index 29bf003e..ae8c00cf 100755
--- a/prj_install.pl
+++ b/prj_install.pl
@@ -22,35 +22,35 @@ use File::Basename;
# Data Section
# ******************************************************************
-my($insext) = 'ins';
-my($version) = '1.9';
-my(%defaults) = ('header_files' => 1,
- 'idl_files' => 1,
- 'inline_files' => 1,
- 'pidl_files' => 1,
- 'template_files' => 1,
- 'mpb_files' => 1,
- );
-
-my(%special) = ('exe_output' => 1,
- 'lib_output' => 1,
- );
-
-my(%actual) = ();
-my(%base) = ();
-my(%override) = ();
-my($keepgoing) = 0;
+my $insext = 'ins';
+my $version = '1.9';
+my %defaults = ('header_files' => 1,
+ 'idl_files' => 1,
+ 'inline_files' => 1,
+ 'pidl_files' => 1,
+ 'template_files' => 1,
+ 'mpb_files' => 1,
+ );
+
+my %special = ('exe_output' => 1,
+ 'lib_output' => 1,
+ );
+
+my %actual;
+my %base;
+my %override;
+my $keepgoing = 0;
eval 'symlink("", "");';
-my($hasSymlink) = ($@ eq '');
+my $hasSymlink = ($@ eq '');
# ******************************************************************
# Subroutine Section
# ******************************************************************
sub rm_updirs {
- my($path) = shift;
- my(@parts) = split(/[\/\\]/, $path);
+ my $path = shift;
+ my @parts = split(/[\/\\]/, $path);
## Split the path into parts and check for '..'. If we find one
## and the previous entry wasn't one, then we can remove them both.
@@ -64,21 +64,18 @@ sub rm_updirs {
}
sub copyFiles {
- my($files) = shift;
- my($insdir) = shift;
- my($symlink) = shift;
- my($verbose) = shift;
- my($type) = ($symlink ? 'link' : 'copy');
- my($cwd) = getcwd();
+ my($files, $insdir, $symlink, $verbose) = @_;
+ my $type = ($symlink ? 'link' : 'copy');
+ my $cwd = getcwd();
foreach my $file (@$files) {
- my($dest) = rm_updirs($insdir . '/' .
- (defined $actual{$file} ?
- "$actual{$file}/" .
- basename($file) : $file));
- my($fulldir) = dirname($dest);
+ my $dest = rm_updirs($insdir . '/' .
+ (defined $actual{$file} ?
+ "$actual{$file}/" .
+ basename($file) : $file));
+ my $fulldir = dirname($dest);
if (! -d $fulldir) {
- my($tmp) = '';
+ my $tmp = '';
foreach my $part (split(/[\/\\]/, $fulldir)) {
$tmp .= $part . '/';
mkdir($tmp, 0755);
@@ -89,7 +86,7 @@ sub copyFiles {
if ($verbose) {
print '', ($symlink ? 'Linking' : 'Copying'), " to $dest\n";
}
- my($status) = undef;
+ my $status;
if ($symlink) {
unlink($dest);
$status = symlink("$cwd/$file", $dest);
@@ -118,9 +115,7 @@ sub copyFiles {
sub determineSpecialName {
- my($tag) = shift;
- my($dir) = shift;
- my($info) = shift;
+ my($tag, $dir, $info) = @_;
my($insdir, $name) = split(/\s+/, $info);
if (defined $name) {
@@ -131,10 +126,10 @@ sub determineSpecialName {
$insdir = '';
}
- my($odir) = ($dir eq '' ? '.' : $dir) . '/' . $insdir;
+ my $odir = ($dir eq '' ? '.' : $dir) . '/' . $insdir;
if ($tag eq 'exe_output') {
- my(@exes) = ();
- my($fh) = new FileHandle();
+ my @exes;
+ my $fh = new FileHandle();
if (opendir($fh, $odir)) {
foreach my $file (grep(!/^\.\.?$/, readdir($fh))) {
if ($file =~ /^$name$/ ||
@@ -147,8 +142,8 @@ sub determineSpecialName {
return @exes;
}
elsif ($tag eq 'lib_output') {
- my(@libs) = ();
- my($fh) = new FileHandle();
+ my @libs;
+ my $fh = new FileHandle();
if (opendir($fh, $odir)) {
foreach my $file (grep(!/^\.\.?$/, readdir($fh))) {
if ($file =~ /^lib$name\.(a|so|sl)/ ||
@@ -166,11 +161,11 @@ sub determineSpecialName {
sub replaceVariables {
- my($line) = shift;
+ my $line = shift;
while($line =~ /(\$\(([^)]+)\))/) {
- my($whole) = $1;
- my($name) = $2;
- my($val) = (defined $ENV{$name} ? $ENV{$name} : '');
+ my $whole = $1;
+ my $name = $2;
+ my $val = (defined $ENV{$name} ? $ENV{$name} : '');
$line =~ s/\$\([^)]+\)/$val/;
}
return $line;
@@ -178,18 +173,16 @@ sub replaceVariables {
sub loadInsFiles {
- my($files) = shift;
- my($tags) = shift;
- my($verbose) = shift;
- my($fh) = new FileHandle();
- my(@copy) = ();
+ my($files, $tags, $verbose) = @_;
+ my $fh = new FileHandle();
+ my @copy;
foreach my $file (@$files) {
if (open($fh, $file)) {
if ($verbose) {
print "Loading $file\n";
}
- my($base) = dirname($file);
+ my $base = dirname($file);
if ($base eq '.') {
$base = '';
}
@@ -198,9 +191,9 @@ sub loadInsFiles {
$base .= '/';
}
- my($current) = undef;
+ my $current;
while(<$fh>) {
- my($line) = $_;
+ my $line = $_;
$line =~ s/^\s+//;
$line =~ s/\s+$//;
@@ -215,7 +208,7 @@ sub loadInsFiles {
}
elsif (defined $current) {
$line = replaceVariables($line);
- my($start) = $#copy + 1;
+ my $start = $#copy + 1;
if (defined $special{$current}) {
push(@copy, determineSpecialName($current, $base, $line));
}
@@ -249,11 +242,11 @@ sub loadInsFiles {
sub getInsFiles {
- my($file) = shift;
- my(@files) = ();
+ my $file = shift;
+ my @files;
if (-d $file) {
- my($fh) = new FileHandle();
+ my $fh = new FileHandle();
if (opendir($fh, $file)) {
foreach my $f (grep(!/^\.\.?$/, readdir($fh))) {
push(@files, getInsFiles("$file/$f"));
@@ -269,12 +262,12 @@ sub getInsFiles {
sub usageAndExit {
- my($msg) = shift;
+ my $msg = shift;
if (defined $msg) {
print STDERR "$msg\n";
}
- my($base) = basename($0);
- my($spc) = ' ' x (length($base) + 8);
+ my $base = basename($0);
+ my $spc = ' ' x (length($base) + 8);
print STDERR "$base v$version\n",
"Usage: $base [-a tag1[,tagN]] [-b tag=dir] ",
($hasSymlink ? '[-l] ' : ''), "[-o tag=dir]\n",
@@ -291,7 +284,7 @@ sub usageAndExit {
"-v Enables verbose mode.\n",
"\n",
"The default set of tags are:\n";
- my($first) = 1;
+ my $first = 1;
foreach my $key (sort keys %defaults) {
print STDERR '', ($first ? '' : ', '), $key;
$first = 0;
@@ -305,15 +298,15 @@ sub usageAndExit {
# Main Section
# ******************************************************************
-my($verbose) = undef;
-my($first) = 1;
-my($insdir) = undef;
-my($symlink) = undef;
-my(@insfiles) = ();
-my(%tags) = %defaults;
+my $verbose;
+my $first = 1;
+my $insdir;
+my $symlink;
+my @insfiles;
+my %tags = %defaults;
for(my $i = 0; $i <= $#ARGV; ++$i) {
- my($arg) = $ARGV[$i];
+ my $arg = $ARGV[$i];
if ($arg =~ /^-/) {
if ($arg eq '-a') {
++$i;
@@ -403,8 +396,8 @@ elsif (!defined $insfiles[0]) {
exit(1);
}
-my($status) = 1;
-my(@files) = loadInsFiles(\@insfiles, \%tags, $verbose);
+my $status = 1;
+my @files = loadInsFiles(\@insfiles, \%tags, $verbose);
if (defined $files[0]) {
$status = (copyFiles(\@files, $insdir, $symlink, $verbose) ? 0 : 1);
}
diff --git a/registry.pl b/registry.pl
index de8dbe14..021d484c 100755
--- a/registry.pl
+++ b/registry.pl
@@ -21,27 +21,26 @@ use File::Basename;
# Data Section
# ******************************************************************
-my($Registry) = undef;
-my($MPC_ROOT) = $FindBin::Bin;
+my $Registry;
+my $MPC_ROOT = $FindBin::Bin;
$MPC_ROOT =~ s!/!\\!g;
-my($version) = '1.3';
-my(%types) = ('nmake' => ['NMAKE', 'NMAKE'],
- 'bmake' => ['Borland Make', 'Borland Make'],
- 'vc6' => ['DSW', 'DSP'],
- 'vc71' => ['SLN 7.1', 'VCPROJ 7.1'],
- 'vc8' => ['SLN 8.0', 'VCPROJ 8.0'],
- 'vc9' => ['SLN 9.0', 'VCPROJ 9.0'],
- );
+my $version = '1.3';
+my %types = ('nmake' => ['NMAKE', 'NMAKE'],
+ 'bmake' => ['Borland Make', 'Borland Make'],
+ 'vc6' => ['DSW', 'DSP'],
+ 'vc71' => ['SLN 7.1', 'VCPROJ 7.1'],
+ 'vc8' => ['SLN 8.0', 'VCPROJ 8.0'],
+ 'vc9' => ['SLN 9.0', 'VCPROJ 9.0'],
+ );
# ******************************************************************
# Subroutine Section
# ******************************************************************
sub set_ext_icon {
- my($ext) = shift;
- my($num) = shift;
- my($extf) = $ext . 'file';
+ my($ext, $num) = @_;
+ my $extf = $ext . 'file';
$Registry->{"HKEY_CLASSES_ROOT/.$ext/"} = {'/' => $extf};
$Registry->{"HKEY_CLASSES_ROOT/$extf/"} = {};
$Registry->{"HKEY_CLASSES_ROOT/$extf/DefaultIcon/"} =
@@ -50,17 +49,16 @@ sub set_ext_icon {
sub set_dir_command {
- my($type) = shift;
- my($desc) = shift;
- my($shell) = 'HKEY_CLASSES_ROOT/Directory/shell';
- my($hash) = $Registry->{$shell};
+ my($type, $desc) = @_;
+ my $shell = 'HKEY_CLASSES_ROOT/Directory/shell';
+ my $hash = $Registry->{$shell};
if (!defined $hash) {
$Registry->{$shell} = {};
$hash = $Registry->{$shell};
}
- my($key) = 'MPC' . uc($type) . '/';
+ my $key = 'MPC' . uc($type) . '/';
$hash->{$key} = {'/' => "MPC -> $desc"};
$key .= 'command/';
@@ -69,17 +67,16 @@ sub set_dir_command {
sub set_mwc_command {
- my($type) = shift;
- my($desc) = shift;
- my($shell) = 'HKEY_CLASSES_ROOT/mwcfile/shell';
- my($hash) = $Registry->{$shell};
+ my($type, $desc) = @_;
+ my $shell = 'HKEY_CLASSES_ROOT/mwcfile/shell';
+ my $hash = $Registry->{$shell};
if (!defined $hash) {
$Registry->{$shell} = {};
$hash = $Registry->{$shell};
}
- my($key) = 'MPC' . uc($type) . '/';
+ my $key = 'MPC' . uc($type) . '/';
$hash->{$key} = {'/' => "MPC -> $desc"};
$key .= 'command/';
@@ -90,17 +87,16 @@ sub set_mwc_command {
sub set_mpc_command {
- my($type) = shift;
- my($desc) = shift;
- my($shell) = 'HKEY_CLASSES_ROOT/mpcfile/shell';
- my($hash) = $Registry->{$shell};
+ my($type, $desc) = @_;
+ my $shell = 'HKEY_CLASSES_ROOT/mpcfile/shell';
+ my $hash = $Registry->{$shell};
if (!defined $hash) {
$Registry->{$shell} = {};
$hash = $Registry->{$shell};
}
- my($key) = 'MPC' . uc($type) . '/';
+ my $key = 'MPC' . uc($type) . '/';
$hash->{$key} = {'/' => "MPC -> $desc"};
$key .= 'command/';
@@ -109,8 +105,8 @@ sub set_mpc_command {
sub delete_key {
- my($key) = shift;
- my($val) = $Registry->{$key};
+ my $key = shift;
+ my $val = $Registry->{$key};
if (UNIVERSAL::isa($val, 'HASH')) {
foreach my $k (keys %$val) {
View Lorry Controller Status