diff options
| -rw-r--r-- | Master/tlpkg/TeXLive/TLPOBJ.pm | 255 |
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; } |