Rework TeXLive::TLPOBJ::from_fh to make it faster and shorter.

- move the code for continued lines to avoid double-testing
  (34% speed improvement for this change alone)
- rm support for continued execute, postaction and depend
- use one split rather than many matches to get the command and argument
- merge the code for similar lines
- flatten the big if-elsif-else structure by moving the 'name first' test
- rm useless next statements (they were even slowing things down)
- order the big switch by number of occurences
- factor out $lastcmd update (not faster, but nicer code IMO)
- access $self members directly rather than using methods
- call parse_line directly rather than quotewords
- misc other tune-ups, inc. preferring split over regexes

Overall measured speed improvement: 43%
Sub length: 200 -> 130 lines


git-svn-id: svn://tug.org/texlive/trunk@22535 c570f23f-e606-0410-a88d-b1316a301751

1 files changed, 91 insertions, 164 deletions

diff --git a/Master/tlpkg/TeXLive/TLPOBJ.pm b/Master/tlpkg/TeXLive/TLPOBJ.pm
index 9713c87b90a..34d7938fe0a 100644
--- a/Master/tlpkg/TeXLive/TLPOBJ.pm
+++ b/Master/tlpkg/TeXLive/TLPOBJ.pm
@@ -91,8 +91,8 @@ sub from_fh {
     # we call tllog only when something will be logged, to speed things up.
     # this is the inner loop bounding the time to read tlpdb.
     dddebug("reading line: >>>$line<<<\n") if ($::opt_verbosity >= 3);
-    $line =~ /^\s*#/ && next;          # skip comment lines
-    if ($line =~ /^\s*$/o) {
+    $line =~ /^#/ && next;          # skip comment lines
+    if ($line =~ /^\s*$/) {
       if (!$started) { next; }
       if (defined($multi)) {
         # we may read from a tldb file
@@ -102,178 +102,105 @@ sub from_fh {
         die("No empty line allowed within tlpobj files!");
       }
     }
-    if ($line =~ /^ /o) {
-      if ( ($lastcmd eq "runfiles") ||
-           ($lastcmd eq "binfiles") ||
-           ($lastcmd eq "docfiles") ||
-           ($lastcmd eq "srcfiles") ||
-           ($lastcmd eq "executes") ||
-           ($lastcmd eq "postaction") ||
-           ($lastcmd eq "depend") ) {
-        $line =~ s/^ /${lastcmd}continued /;
-      } else {
-        die("Continuation of $lastcmd not allowed, please fix tlpobj: line = $line!\n");
-      }
-    }
-    
-    if ($line =~ /^name\s*([-.\w]+)/o) {
-      $name = "$1";
-      $lastcmd = "name";
-      $self->name("$name");
-      $started && die("Cannot have two name directives: $line!");
-      $started = 1;
-    } else {
-      $started || die("First directive needs to be 'name', not $line");
-      if ($line =~ /^(src|run)filescontinued\s+(.*)\s*/o) {
-        push @{$self->{$1."files"}}, "$2";
-        next;
-      } elsif ($line =~ /^docfilescontinued\s+(.*)\s*/o) {
-        # docfiles can have tags, but the quotewords function is so
+
+    my ($cmd, $arg) = split(/\s+/, $line, 2);
+    # first command must be name
+    $started || $cmd eq 'name'
+      or die("First directive needs to be 'name', not $line");
+
+    # now the big switch, ordered by decreasing number of occurences
+    if ($cmd eq '') {
+      if ($lastcmd eq "runfiles" || $lastcmd eq "srcfiles") {
+        push @{$self->{$lastcmd}}, $arg;
+      } elsif ($lastcmd eq "docfiles") {
+        my ($f, $rest) = split(' ', $arg, 2);
+        push @{$self->{'docfiles'}}, $f;
+        # docfiles can have tags, but the parse_line function is so
         # time intense that we try to call it only when necessary
-        my ($f, $rest) = split(' ', "$1", 2);
-        my @words;
         if (defined $rest) {
-          @words = &TeXLive::TLUtils::quotewords('\s+', 0, "$rest");
-        }
-        push @{$self->{'docfiles'}}, $f;
-        while (@words) {
-          $_ = shift @words;
-          if (/^details=(.*)$/) {
-            $self->{'docfiledata'}{$f}{'details'} = "$1";
-          } elsif (/^language=(.*)$/) {
-            $self->{'docfiledata'}{$f}{'language'} = "$1";
-          } else {
-            die "Unknown docfile tag: $line";
+          my @words = &TeXLive::TLUtils::parse_line('\s+', 0, $rest);
+          for (@words) {
+            my ($k, $v) = split('=', $_, 2);
+            if ($k eq 'details' || $k eq 'language') {
+              $self->{'docfiledata'}{$f}{$k} = $v;
+            } else {
+              die "Unknown docfile tag: $line";
+            }
           }
         }
-        next;
-      } elsif ($line =~ /^binfilescontinued\s+(.*)$/o) {
-        push @{$self->{'binfiles'}{$arch}}, "$1";
-        next;
-      } elsif ($line =~ /^binfiles\s+/o) {
-        my @words = split ' ',$line;
-        # first entry is "binfiles", shift it away
-        shift @words;
-        while (@words) {
-          $_ = shift @words;
-          if (/^arch=(.*)$/) {
-            $arch=$1;
-          } elsif (/^size=(.*)$/) {
-            $size=$1;
-          } else {
-            die "Unknown tag: $line";
-          }
-        }
-        if (defined($size)) {
-          $self->{'binsize'}{$arch} = $size;
-        }
-        $lastcmd = "binfiles";
-        next;
-      } elsif ($line eq "longdesc") {
-        if (defined($self->{'longdesc'})) {
-          $self->{'longdesc'} .= " ";
+      } elsif ($lastcmd eq "binfiles") {
+        push @{$self->{'binfiles'}{$arch}}, $arg;
+      } else {
+        die("Continuation of $lastcmd not allowed, please fix tlpobj: line = $line!\n");
+      }
+    } elsif ($cmd eq "longdesc") {
+      my $desc = defined $arg ? $arg : '';
+      if (defined($self->{'longdesc'})) {
+        $self->{'longdesc'} .= " $desc";
+      } else {
+        $self->{'longdesc'} = $desc;
+      }
+    } elsif ($cmd =~ /^catalogue-(.+)$/o) {
+      $self->{'cataloguedata'}{$1} = $arg if defined $arg;
+    } elsif ($cmd =~ /^(doc|src|run)files$/o) {
+      my $type = $1;
+      for (split ' ', $arg) {
+        my ($k, $v) = split('=', $_, 2);
+        if ($k eq 'size') {
+        $self->{"${type}size"} = $v;
         } else {
-          $self->{'longdesc'} = "";
+          die "Unknown tag: $line";
         }
-        $lastcmd = "longdesc";
-        next;
-      } elsif ($line =~ /^longdesc\s+(.*)$/o) {
-        if (defined($self->{'longdesc'})) {
-          $self->{'longdesc'} .= " $1";
+      }
+    } elsif ($cmd eq 'containersize' || $cmd eq 'srccontainersize'
+        || $cmd eq 'doccontainersize') {
+      $arg =~ /^[0-9]+$/ or die "Illegal size value: $line!";
+      $self->{$cmd} = $arg;
+    } elsif ($cmd eq 'containermd5' || $cmd eq 'srccontainermd5'
+        || $cmd eq 'doccontainermd5') {
+      $arg =~ /^[a-f0-9]+$/ or die "Illegal md5 value: $line!";
+      $self->{$cmd} = $arg;
+    } elsif ($cmd eq 'name') {
+      $arg =~ /^([-.\w]+)$/ or die("Invalid name: $line!");
+      $self->{'name'} = $arg;
+      $started && die("Cannot have two name directives: $line!");
+      $started = 1;
+    } elsif ($cmd eq 'category') {
+      $self->{'category'} = $arg;
+      if ($self->{'category'} !~ /^$CategoriesRegexp/o) {
+        tlwarn("Unknown category " . $self->{'category'} . " for package "
+          . $self->name . " found.\nPlease update texlive.infra.\n");
+      }
+    } elsif ($cmd eq 'revision') {
+      $self->{'revision'} = $arg;
+    } elsif ($cmd eq 'shortdesc') {
+      $self->{'shortdesc'} .= defined $arg ? $arg : ' ';
+    } elsif ($cmd eq 'execute' || $cmd eq 'postaction'
+        || $cmd eq 'depend') {
+      push @{$self->{$cmd . 's'}}, $arg if defined $arg;
+    } elsif ($cmd eq 'binfiles') {
+      for (split ' ', $arg) {
+        my ($k, $v) = split('=', $_, 2);
+        if ($k eq 'arch') {
+          $arch = $v;
+        } elsif ($k eq 'size') {
+          $size = $v;
         } else {
-          $self->{'longdesc'} = "$1";
-        }
-        $lastcmd = "longdesc";
-        next;
-      } elsif ($line =~ /^category\s+(.*)$/o) {
-        $self->{'category'} = "$1";
-        $lastcmd = "category";
-        if ($self->{'category'} !~ /^$CategoriesRegexp/o) {
-          tlwarn("Unknown category " . $self->{'category'} . " for package "
-            . $self->name . " found.\nPlease update texlive.infra.\n");
-        }
-        next;
-      } elsif ($line =~ /^relocated\s+([01])$/o) {
-        $self->relocated("$1");
-        $lastcmd = "relocated";
-        next;
-      } elsif ($line =~ /^revision\s+(.*)$/o) {
-        $self->{'revision'} = "$1";
-        $lastcmd = "revision";
-        next;
-      } elsif ($line =~ /^containersize\s+([0-9]+)$/o) {
-        $self->containersize("$1");
-        $lastcmd = "containersize";
-        next;
-      } elsif ($line =~ /^srccontainersize\s+([0-9]+)$/o) {
-        $self->srccontainersize("$1");
-        $lastcmd = "srccontainersize";
-        next;
-      } elsif ($line =~ /^doccontainersize\s+([0-9]+)$/o) {
-        $self->doccontainersize("$1");
-        $lastcmd = "doccontainersize";
-        next;
-      } elsif ($line =~ /^containermd5\s+([a-f0-9]+)$/o) {
-        $self->containermd5("$1");
-        $lastcmd = "containermd5";
-        next;
-      } elsif ($line =~ /^srccontainermd5\s+([a-f0-9]+)$/o) {
-        $self->srccontainermd5("$1");
-        $lastcmd = "srccontainermd5";
-        next;
-      } elsif ($line =~ /^doccontainermd5\s+([a-f0-9]+)$/o) {
-        $self->doccontainermd5("$1");
-        $lastcmd = "doccontainermd5";
-        next;
-      } elsif ($line =~ /^catalogue\s+(.*)$/o) {
-        $self->catalogue("$1");
-        $lastcmd = "catalogue";
-        next;
-      } elsif ($line =~ /^(doc|src|run)files\s+/o) {
-        my $type = $1;
-        my @words = split ' ',$line;
-        # first entry is "XXXfiles", shift it away
-        $lastcmd = shift @words;
-        while (@words) {
-          $_ = shift @words;
-          if (/^size=(.*)$/) {
-            $size=$1;
-          } else {
-            die "Unknown tag: $line";
-          }
-        }
-        if (defined($size)) {
-          $self->{"${type}size"} = $size;
+          die "Unknown tag: $line";
         }
-        next;
-      } elsif ($line =~ /^execute(continued)?\s*(.*)$/o) {
-        push @{$self->{'executes'}}, "$2" unless "$2" eq "";
-        $lastcmd = "execute";
-        next;
-      } elsif ($line =~ /^postaction(continued)?\s*(.*)$/o) {
-        push @{$self->{'postactions'}}, "$2" unless "$2" eq "";
-        $lastcmd = "postaction";
-        next;
-      } elsif ($line =~ /^depend(continued)?\s*(.*)$/o) {
-        push @{$self->{'depends'}}, "$2" unless "$2" eq "";
-        $lastcmd = "depend";
-        next;
-      } elsif ($line =~ /^catalogue-([^\s]+)\s+(.*)$/o) {
-        $self->{'cataloguedata'}{$1} = "$2";
-      } elsif ($line =~ /^catalogue-([^\s]+)\s*/o) {
-        1; # ignore e.g. catalogue-ctan without parameter
-      } elsif ($line eq "shortdesc") {
-        $self->{'shortdesc'} .= " ";
-        $lastcmd = "shortdesc";
-        next;
-      } elsif ($line =~ /^shortdesc\s+(.*)$/o) { # shortdesc <real text>
-        $self->{'shortdesc'} .= "$1";
-        $lastcmd = "shortdesc";
-        next;
-      } else {
-        die("Unknown directive ...$line... , please fix it!");
       }
+      if (defined($size)) {
+        $self->{'binsize'}{$arch} = $size;
+      }
+    } elsif ($cmd eq 'relocated') {
+      ($arg eq '0' || $arg eq '1') or die "Illegal value: $line!";
+      $self->{'relocated'} = $arg;
+    } elsif ($cmd eq 'catalogue') {
+      $self->{'catalogue'} = $arg;
+    } else {
+      die("Unknown directive ...$line... , please fix it!");
     }
+    $lastcmd = $cmd unless $cmd eq '';
   }
   return $started;
 }