summaryrefslogtreecommitdiff
path: root/Master/tlpkg/TeXLive/TLPOBJ.pm
diff options
context:
space:
mode:
authorManuel Pégourié-Gonnard <mpg@elzevir.fr>2011-05-19 09:58:08 +0000
committerManuel Pégourié-Gonnard <mpg@elzevir.fr>2011-05-19 09:58:08 +0000
commit1440d306a6563aa2acb7698d231adde9bbaff72d (patch)
tree5db4ebbf8a45e27e292443b29b61a8d9340878e4 /Master/tlpkg/TeXLive/TLPOBJ.pm
parent127e73fbc14b134815bfe245d4bca580b2daf520 (diff)
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
Diffstat (limited to 'Master/tlpkg/TeXLive/TLPOBJ.pm')
-rw-r--r--Master/tlpkg/TeXLive/TLPOBJ.pm255
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;
}