ChangeLogTag: Fri Mar 10 18:59:34 UTC 2006 Chad Elliott <elliott_c@ociweb.com>

12 files changed, 111 insertions, 85 deletions

diff --git a/ChangeLog b/ChangeLog
index 31ef3ae0..e35d628e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,29 @@
+Fri Mar 10 18:59:34 UTC 2006  Chad Elliott  <elliott_c@ociweb.com>
+
+        * modules/BMakeWorkspaceCreator.pm:
+        * modules/Creator.pm:
+        * modules/DirectoryManager.pm:
+        * modules/Driver.pm:
+        * modules/FeatureParser.pm:
+        * modules/HTMLProjectCreator.pm:
+        * modules/MakeWorkspaceCreator.pm:
+        * modules/NMakeWorkspaceCreator.pm:
+        * modules/WorkspaceCreator.pm:
+
+          Implemented a new function, mpc_basename, that is more efficient
+          than the one provided by File::Basename.
+
+        * modules/ProjectCreator.pm:
+
+          Moved code outside of add_corresponding_component_files that was
+          executed twice.  The result could not possibly change, so it is
+          executed once and the result is passed into
+          add_corresponding_component_files.
+
+        * modules/TemplateParser.pm:
+
+          Optimized code to avoid using substr() in parse_line().
+
 Thu Mar  9 16:20:24 UTC 2006  Chad Elliott  <elliott_c@ociweb.com>
 
         * modules/CBXProjectCreator.pm:
diff --git a/modules/BMakeWorkspaceCreator.pm b/modules/BMakeWorkspaceCreator.pm
index 7d568140..056a8f82 100644
--- a/modules/BMakeWorkspaceCreator.pm
+++ b/modules/BMakeWorkspaceCreator.pm
@@ -11,7 +11,6 @@ package BMakeWorkspaceCreator;
 # ************************************************************
 
 use strict;
-use File::Basename;
 
 use BMakeProjectCreator;
 use WorkspaceCreator;
@@ -123,8 +122,8 @@ sub write_project_targets {
     }
 
     print $fh ($chdir ? "\t\@cd $dir$crlf" : ''),
-              "\t\$(MAKE) -\$(MAKEFLAGS) -f ", basename($project),
-              " $target$crlf",
+              "\t\$(MAKE) -\$(MAKEFLAGS) -f ",
+              $self->mpc_basename($project), " $target$crlf",
               ($chdir ? "\t\@cd $back$crlf" : '');
   }
 }
diff --git a/modules/Creator.pm b/modules/Creator.pm
index 8417f510..4ee49ce9 100644
--- a/modules/Creator.pm
+++ b/modules/Creator.pm
@@ -12,7 +12,6 @@ package Creator;
 
 use strict;
 use FileHandle;
-use File::Basename;
 
 use Parser;
 
@@ -398,7 +397,7 @@ sub parse_scope {
 
 sub base_directory {
   my($self) = shift;
-  return basename($self->getcwd());
+  return $self->mpc_basename($self->getcwd());
 }
 
 
diff --git a/modules/DirectoryManager.pm b/modules/DirectoryManager.pm
index d2058a3c..ea5be354 100644
--- a/modules/DirectoryManager.pm
+++ b/modules/DirectoryManager.pm
@@ -90,6 +90,15 @@ sub getstartdir {
   return $start;
 }
 
+
+sub mpc_basename {
+  #my($self) = $_[0];
+  my($file) = $_[1];
+  $file =~ s!.*/!!;
+  return $file;
+}
+
+
 sub mpc_dirname {
   my($self) = shift;
   my($dir)  = shift;
diff --git a/modules/Driver.pm b/modules/Driver.pm
index 01574be7..7be78d4d 100644
--- a/modules/Driver.pm
+++ b/modules/Driver.pm
@@ -11,7 +11,6 @@ package Driver;
 # ************************************************************
 
 use strict;
-use File::Basename;
 
 use Options;
 use Parser;
@@ -274,7 +273,7 @@ sub run {
   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.
-    my($base) = ($cfile eq '' ? '' : basename($cfile));
+    my($base) = ($cfile eq '' ? '' : $self->mpc_basename($cfile));
 
     if (-d $cfile) {
       $base = '';
diff --git a/modules/FeatureParser.pm b/modules/FeatureParser.pm
index 6d3424d3..83100ff8 100644
--- a/modules/FeatureParser.pm
+++ b/modules/FeatureParser.pm
@@ -11,7 +11,6 @@ package FeatureParser;
 # ************************************************************
 
 use strict;
-use File::Basename;
 
 use Parser;
 
@@ -39,7 +38,7 @@ sub new {
         ## We only want to warn the user about problems
         ## with the feature file.
         my($lnumber) = $self->get_line_number();
-        $self->warning(basename($f) . ": line $lnumber: $warn");
+        $self->warning($self->mpc_basename($f) . ": line $lnumber: $warn");
       }
     }
   }
diff --git a/modules/HTMLProjectCreator.pm b/modules/HTMLProjectCreator.pm
index 44d6b61f..b2feb37a 100644
--- a/modules/HTMLProjectCreator.pm
+++ b/modules/HTMLProjectCreator.pm
@@ -11,7 +11,6 @@ package HTMLProjectCreator;
 # ************************************************************
 
 use strict;
-use File::Basename;
 
 use ProjectCreator;
 use XMLProjectBase;
@@ -80,7 +79,7 @@ sub fill_value {
     for(my $i = 0; $i <= $#nodes; ++$i) {
       my($file) = $nodes[$i]->[1];
       my($dir)  = $self->mpc_dirname($file);
-      my($base) = basename($file);
+      my($base) = $self->mpc_basename($file);
 
       ## Relative paths do not work at all in a web browser
       if ($dir eq '.') {
diff --git a/modules/MakeWorkspaceCreator.pm b/modules/MakeWorkspaceCreator.pm
index 8823513c..9d2cf49b 100644
--- a/modules/MakeWorkspaceCreator.pm
+++ b/modules/MakeWorkspaceCreator.pm
@@ -11,7 +11,6 @@ package MakeWorkspaceCreator;
 # ************************************************************
 
 use strict;
-use File::Basename;
 
 use MakeProjectCreator;
 use WorkspaceCreator;
@@ -85,7 +84,7 @@ sub write_comps {
     print $fh "\t\@",
               ($dname ne '.' ? "cd $dname; " : ''),
               "\$(MAKE) -f ",
-              ($dname eq '.' ? $project : basename($project)),
+              ($dname eq '.' ? $project : $self->mpc_basename($project)),
               " \$(\@)$crlf";
   }
 
@@ -104,7 +103,7 @@ sub write_comps {
               "\t\@",
               ($dname ne '.' ? "cd $dname; " : ''),
               "\$(MAKE) -f ",
-              ($dname eq '.' ? $project : basename($project)),
+              ($dname eq '.' ? $project : $self->mpc_basename($project)),
               ' generated all', $crlf;
   }
 
diff --git a/modules/NMakeWorkspaceCreator.pm b/modules/NMakeWorkspaceCreator.pm
index 8f765db9..f894ed37 100644
--- a/modules/NMakeWorkspaceCreator.pm
+++ b/modules/NMakeWorkspaceCreator.pm
@@ -11,7 +11,6 @@ package NMakeWorkspaceCreator;
 # ************************************************************
 
 use strict;
-use File::Basename;
 
 use NMakeProjectCreator;
 use WorkspaceCreator;
@@ -120,7 +119,8 @@ sub write_project_targets {
     }
 
     print $fh ($chdir ? "\tcd $dir$crlf" : ''),
-              "\t\$(MAKE) /f ", basename($project), " $target$crlf",
+              "\t\$(MAKE) /f ", $self->mpc_basename($project),
+              " $target$crlf",
               ($chdir ? "\tcd $back$crlf" : '');
   }
 }
diff --git a/modules/ProjectCreator.pm b/modules/ProjectCreator.pm
index e130c9c6..3642c256 100644
--- a/modules/ProjectCreator.pm
+++ b/modules/ProjectCreator.pm
@@ -14,7 +14,6 @@ use strict;
 use FileHandle;
 use File::Path;
 use File::Compare;
-use File::Basename;
 
 use Creator;
 use TemplateInputReader;
@@ -488,7 +487,8 @@ sub begin_project {
             ## project), then the current base project is redundant.
             if (!defined $self->{'reading_parent'}->[0]) {
               $file =~ s/\.[^\.]+$//;
-              $self->information('Inheriting from \'' . basename($file) .
+              $self->information('Inheriting from \'' .
+                                 $self->mpc_basename($file) .
                                  '\' in ' . $self->{'current_input'} .
                                  ' is redundant at line ' .
                                  $self->get_line_number() . '.');
@@ -2241,7 +2241,7 @@ sub search_for_entry {
           (/\s+$main\s*\(/ || /^\s*$main\s*\(/)) {
         ## If we've found a main, set the exename to the basename
         ## of the cpp file with the extension removed
-        $name = basename($file);
+        $name = $self->mpc_basename($file);
         $name =~ s/\.[^\.]+$//;
         last;
       }
@@ -2823,7 +2823,7 @@ sub prepend_gendir {
         if (defined $dir) {
           ## Convert the file to unix style for basename
           $created =~ s/\\/\//g;
-          return "$dir/" . basename($created);
+          return "$dir/" . $self->mpc_basename($created);
         }
       }
     }
@@ -2874,7 +2874,7 @@ sub list_generated_file {
     ## See if we need to add the file.  We only need to bother
     ## if the length of $gen is less than or equal to the length of
     ## $file because they couldn't possibly match if they weren't.
-    if (length(basename($gen)) <= $blen) {
+    if (length($self->mpc_basename($gen)) <= $blen) {
       foreach my $re ($self->generated_filenames($gen, $gentype,
                                                  $tag, $input)) {
         if ($re =~ /$file(.*)?$/) {
@@ -2896,33 +2896,16 @@ sub list_generated_file {
 
 
 sub add_corresponding_component_files {
-  my($self)   = shift;
-  my($ftags)  = shift;
-  my($tag)    = shift;
-  my($names)  = undef;
-  my($grname) = $grouped_key . $tag;
-
-  ## Collect up all of the files that have already been listed
-  ## with the extension removed.
-  my(%filecomp) = ();
-  foreach my $filetag (@$ftags) {
-    $names = $self->{$filetag};
-    foreach my $name (keys %$names) {
-      foreach my $comp (keys %{$$names{$name}}) {
-        foreach my $sfile (@{$$names{$name}->{$comp}}) {
-          my($mod) = $sfile;
-          $mod =~ s/\.[^\.]+$//;
-          $filecomp{$mod} = $comp;
-        }
-      }
-    }
-  }
+  my($self)     = shift;
+  my($filecomp) = shift;
+  my($tag)      = shift;
+  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) = ();
-  $names = $self->{$tag};
+  my($names)   = $self->{$tag};
   foreach my $name (keys %$names) {
     ## Check to see if files exist in the default group
     if (defined $$names{$name}->{$defgroup} &&
@@ -2944,7 +2927,7 @@ sub add_corresponding_component_files {
   ## Check each file against a possible new file addition
   my($adddefaultgroup) = 0;
   my($oktoadddefault)  = 0;
-  foreach my $sfile (keys %filecomp) {
+  foreach my $sfile (keys %$filecomp) {
     my($found) = 0;
     foreach my $ext (@exts) {
       if (exists $scfiles{"$sfile$ext"}) {
@@ -2956,7 +2939,7 @@ sub add_corresponding_component_files {
     if (!$found) {
       ## Get the array of files for the selected component name
       my($array) = [];
-      my($comp)  = $filecomp{$sfile};
+      my($comp)  = $$filecomp{$sfile};
       foreach my $name (keys %$names) {
         if (defined $$names{$name}->{$comp}) {
           $array = $$names{$name}->{$comp};
@@ -3119,11 +3102,26 @@ sub generate_defaults {
   ## we need to remove those that have need to be removed
   $self->remove_excluded('source_files');
 
+  ## Collect up all of the source file that have already been listed
+  ## with the extension removed.
+  my(%sourcecomp) = ();
+  foreach my $sourcetag (keys %sourceComponents) {
+    my($names) = $self->{$sourcetag};
+    foreach my $name (keys %$names) {
+      foreach my $comp (keys %{$$names{$name}}) {
+        foreach my $sfile (@{$$names{$name}->{$comp}}) {
+          my($mod) = $sfile;
+          $mod =~ s/\.[^\.]+$//;
+          $sourcecomp{$mod} = $comp;
+        }
+      }
+    }
+  }
+
   ## Add %specialComponents files based on the
   ## source_components (i.e. .h and .i or .inl based on .cpp)
-  my(@scomp) = keys %sourceComponents;
   foreach my $tag (keys %specialComponents) {
-    $self->add_corresponding_component_files(\@scomp, $tag);
+    $self->add_corresponding_component_files(\%sourcecomp, $tag);
   }
 
   ## Now, if the %specialComponents are still empty
@@ -3261,7 +3259,7 @@ sub check_custom_output {
       else {
         my($base) = $built;
         $base =~ s/\\/\//g if ($self->{'convert_slashes'});
-        my($re) = $self->escape_regex_special(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.
@@ -3480,7 +3478,7 @@ sub convert_command_parameters {
 
   if (defined $input) {
     $valid{'input'}          = $input;
-    $valid{'input_basename'} = basename($input);
+    $valid{'input_basename'} = $self->mpc_basename($input);
     $valid{'input_noext'}    = $input;
     $valid{'input_noext'}    =~ s/(\.[^\.]+)$//;
     $valid{'input_ext'}      = $1;
@@ -3495,7 +3493,8 @@ sub convert_command_parameters {
 
       $valid{'output_ext'}       = $1;
       $valid{'output_noext'}    .= (!$first ? ' ' : '') . $noext;
-      $valid{'output_basename'} .= (!$first ? ' ' : '') . basename($out);
+      $valid{'output_basename'} .= (!$first ? ' ' : '') .
+                                   $self->mpc_basename($out);
       $first = 0;
     }
   }
diff --git a/modules/TemplateParser.pm b/modules/TemplateParser.pm
index 6a246c36..6f449276 100644
--- a/modules/TemplateParser.pm
+++ b/modules/TemplateParser.pm
@@ -1447,17 +1447,15 @@ sub process_name {
   my($status)      = 1;
   my($errorString) = undef;
 
-  if ($line eq '') {
-  }
-  elsif ($line =~ /^\w+(\(([^\)]+|\".*\"|[!]?(\w+\s*,\s*)?\w+\(.+\))\)|\->\w+([\w\-\>]+)?)?%>/) {
+  if ($line =~ /^\w+(\(([^\)]+|\".*\"|[!]?(\w+\s*,\s*)?\w+\(.+\))\)|\->\w+([\w\-\>]+)?)?%>/) {
     ## Split the line into a name and value
     my($name, $val) = ();
     if ($line =~ /([^%\(]+)(\(([^%]+)\))?%>/) {
       $name = lc($1);
       $val  = $3;
+      $length += length($name);
     }
 
-    $length += length($name);
     if (defined $val) {
       ## Check for the parenthesis
       if (($val =~ tr/(//) != ($val =~ tr/)//)) {
@@ -1607,9 +1605,9 @@ sub collect_data {
 
 
 sub parse_line {
-  my($self)        = shift;
-  my($ih)          = shift;
-  my($line)        = shift;
+  my($self)        = $_[0];
+  #my($ih)          = $_[1];
+  my($line)        = $_[2];
   my($status)      = 1;
   my($errorString) = undef;
   my($startempty)  = ($line eq '');
@@ -1617,11 +1615,10 @@ sub parse_line {
   ## If processing a foreach or the line only
   ## contains a keyword, then we do
   ## not need to add a newline to the end.
-  if (!$self->{'eval'} && $self->{'foreach'}->{'processing'} == 0) {
-    if ($line !~ /^[ ]*<%(\w+)(\(((\w+\s*,\s*)?\w+\(.+\)|[^\)]+)\))?%>$/ ||
-        !defined $keywords{$1}) {
-      $line .= $self->{'crlf'};
-    }
+  if (!$self->{'eval'} && $self->{'foreach'}->{'processing'} == 0 &&
+      ($line !~ /^[ ]*<%(\w+)(\(((\w+\s*,\s*)?\w+\(.+\)|[^\)]+)\))?%>$/ ||
+       !defined $keywords{$1})) {
+    $line .= $self->{'crlf'};
   }
 
   if (!$self->{'eval'} && $self->{'foreach'}->{'count'} < 0) {
@@ -1630,7 +1627,7 @@ sub parse_line {
 
   my($start) = index($line, '<%');
   if ($start >= 0) {
-    my($append_name) = 0;
+    my($append_name) = undef;
     if ($start > 0) {
       if (!$self->{'if_skip'}) {
         $self->append_current(substr($line, 0, $start));
@@ -1640,15 +1637,16 @@ sub parse_line {
     foreach my $item (split('<%', $line)) {
       my($name)   = 1;
       my($length) = length($item);
+      my($endi)   = index($item, '%>');
       for(my $i = 0; $i < $length; ++$i) {
-        my($part) = substr($item, $i, 2);
-        if ($part eq '%>') {
+        if ($i == $endi) {
           ++$i;
-          $name = 0;
+          $endi = index($item, '%>', $i);
+          $name = undef;
           if ($append_name) {
-            $append_name = 0;
+            $append_name = undef;
             if (!$self->{'if_skip'}) {
-              $self->append_current($part);
+              $self->append_current('%>');
             }
           }
           if ($length != $i + 1) {
@@ -1688,7 +1686,7 @@ sub parse_line {
             $i += ($nlen - 1);
           }
           else  {
-            $name = 0;
+            $name = undef;
             if (!$self->{'if_skip'}) {
               $self->append_current('<%' . substr($item, $i, 1));
               $append_name = 1;
diff --git a/modules/WorkspaceCreator.pm b/modules/WorkspaceCreator.pm
index cb3bea3d..71a86943 100644
--- a/modules/WorkspaceCreator.pm
+++ b/modules/WorkspaceCreator.pm
@@ -14,7 +14,6 @@ use strict;
 use FileHandle;
 use File::Path;
 use File::Compare;
-use File::Basename;
 
 use Creator;
 use Options;
@@ -309,7 +308,7 @@ sub aggregated_workspace {
         if (defined $values[0]) {
           if ($values[0] eq $self->{'grammar_type'}) {
             if (defined $values[2]) {
-              my($name) = basename($file);
+              my($name) = $self->mpc_basename($file);
               $name =~ s/\.[^\.]+$//;
               $status = 0;
               $error  = 'Aggregated workspace (' . $name .
@@ -661,7 +660,8 @@ sub remove_duplicate_projects {
   for(my $i = 0; $i < $count; ++$i) {
     my($file) = $$list[$i];
     foreach my $inner (@$list) {
-      if ($file ne $inner && $file eq $self->mpc_dirname($inner) && ! -d $inner) {
+      if ($file ne $inner &&
+          $file eq $self->mpc_dirname($inner) && ! -d $inner) {
         splice(@$list, $i, 1);
         --$count;
         --$i;
@@ -827,8 +827,8 @@ sub write_workspace {
         if (defined $names{$name}) {
           ++$duplicates;
           $self->error("Duplicate case-insensitive project '$name'. " .
-                       "Look in " . $self->mpc_dirname($project) . " and " .
-                       $self->mpc_dirname($names{$name}) .
+                       "Look in " . $self->mpc_dirname($project) .
+                       " and " . $self->mpc_dirname($names{$name}) .
                        " for project name conflicts.");
         }
         else {
@@ -1144,7 +1144,7 @@ sub generate_project_files {
           $status = 1;
         }
         else {
-          $status = $creator->generate(basename($file));
+          $status = $creator->generate($self->mpc_basename($file));
 
           ## If any one project file fails, then stop
           ## processing altogether.
@@ -1459,13 +1459,13 @@ sub sort_within_group {
 
     $deps = $self->get_validated_ordering($$list[$i]);
     if (defined $$deps[0]) {
-      my($baseproj) = basename($$list[$i]);
+      my($baseproj) = $self->mpc_basename($$list[$i]);
       my($moved) = 0;
       foreach my $dep (@$deps) {
         if ($baseproj ne $dep) {
           ## See if the dependency is listed after this project
           for(my $j = $i + 1; $j <= $end; ++$j) {
-            if (basename($$list[$j]) eq $dep) {
+            if ($self->mpc_basename($$list[$j]) eq $dep) {
               $movepjs = [$i, $j];
               ## If so, move it in front of the current project.
               ## The original code, which had splices, didn't always
@@ -1517,7 +1517,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) = basename($$list[$k]);
+                  my($ldep) = $self->mpc_basename($$list[$k]);
                   if (!exists $$gdeps{$ldep}) {
                     $$gdeps{$ldep} = 1;
                     $self->build_dependency_chain($$list[$k],
@@ -1553,7 +1553,7 @@ sub sort_by_groups {
   ## workspace.
   my(%dupcheck) = ();
   foreach my $proj (@$list) {
-    my($base) = basename($proj);
+    my($base) = $self->mpc_basename($proj);
     if (defined $dupcheck{$base}) {
       return;
     }
@@ -1570,12 +1570,12 @@ sub sort_by_groups {
         $self->build_dependency_chain($$list[$i], $llen, $list, $gi,
                                       $#groups + 1, \@groups,
                                       \%dupcheck, \%gdeps);
-        if (exists $gdeps{basename($$list[$i])}) {
+        if (exists $gdeps{$self->mpc_basename($$list[$i])}) {
           ## There was a cirular dependency, get all of the directories
           ## involved.
           my(%dirs) = ();
           foreach my $gdep (keys %gdeps) {
-            $dirs{dirname($dupcheck{$gdep})} = 1;
+            $dirs{$self->mpc_dirname($dupcheck{$gdep})} = 1;
           }
 
           ## If the current directory was involved, translate that into
@@ -1617,7 +1617,7 @@ sub sort_by_groups {
     ## Search the rest of the groups for any of the group dependencies
     for(my $gj = $gi + 1; $gj <= $#groups; ++$gj) {
       for(my $i = $groups[$gj]->[0]; $i <= $groups[$gj]->[1]; ++$i) {
-        if (exists $gdeps{basename($$list[$i])}) {
+        if (exists $gdeps{$self->mpc_basename($$list[$i])}) {
           ## Move this group ($gj) in front of the current group ($gi)
           my(@save) = ();
           for(my $j = $groups[$gi]->[1] + 1; $j <= $groups[$gj]->[1]; ++$j) {
@@ -1735,7 +1735,7 @@ sub number_target_deps {
         ## that this one depends on.  When the project is
         ## found, we put the target number in the numbers array.
         for(my $j = 0; $j < $i; ++$j) {
-          if (exists $dhash{basename($list[$j])}) {
+          if (exists $dhash{$self->mpc_basename($list[$j])}) {
             push(@numbers, $j);
           }
         }
@@ -2018,10 +2018,10 @@ sub get_validated_ordering {
           my($dep)   = $$deps[$i];
           my($found) = 0;
           ## Avoid circular dependencies
-          if ($dep ne $name && $dep ne basename($project)) {
+          if ($dep ne $name && $dep ne $self->mpc_basename($project)) {
             foreach my $p (@{$self->{'projects'}}) {
               if ($dep eq $self->{'project_info'}->{$p}->[0] ||
-                  $dep eq basename($p)) {
+                  $dep eq $self->mpc_basename($p)) {
                 $found = 1;
                 last;
               }