diff options
-rw-r--r-- | Master/tlpkg/TeXLive/TLPOBJ.pm | 12 | ||||
-rw-r--r-- | Master/tlpkg/TeXLive/TLUtils.pm | 61 |
2 files changed, 67 insertions, 6 deletions
diff --git a/Master/tlpkg/TeXLive/TLPOBJ.pm b/Master/tlpkg/TeXLive/TLPOBJ.pm index 45fb07d75d6..9a73d6bd8da 100644 --- a/Master/tlpkg/TeXLive/TLPOBJ.pm +++ b/Master/tlpkg/TeXLive/TLPOBJ.pm @@ -8,12 +8,11 @@ package TeXLive::TLPOBJ; use TeXLive::TLConfig qw($DefaultCategory $CategoriesRegexp $MetaCategoriesRegexp $InfraLocation); use TeXLive::TLUtils; -use File::Path; +#use File::Path; use Cwd; use TeXLive::TLTREE; -use FileHandle; -use Text::ParseWords; -use File::Basename; +#use FileHandle; # $fh->getline() in from_fh, can we rewritten +#use File::Basename; my $_tmp; my $_containerdir; @@ -64,7 +63,8 @@ sub from_fh { my $arch; my $size; - while (my $line = $fh->getline) { + #while (my $line = $fh->getline) { + while (my $line = <$fh>) { &TeXLive::TLUtils::debug("reading line: >>>$line<<<"); $line =~ /^\s*#/ && next; # skip comment lines if ($line =~ /^\s*$/) { @@ -141,7 +141,7 @@ sub from_fh { next; } elsif ($line =~ /^docfilescontinued\s+(.*)$/) { # docfiles can have tags - my @words = "ewords('\s+', 0, "$1"); + my @words = &TeXLive::TLUtils::quotewords('\s+', 0, "$1"); # the first entry is the file my $f = shift @words; push @{$self->{'docfiles'}}, $f; diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm index fda5610b8be..ef33018308e 100644 --- a/Master/tlpkg/TeXLive/TLUtils.pm +++ b/Master/tlpkg/TeXLive/TLUtils.pm @@ -92,6 +92,7 @@ BEGIN { &push_uniq &member &debug + "ewords ); } @@ -779,6 +780,66 @@ sub debug { print STDERR "tldbg: @_\n" if $::opt_debug; } +############################################# +# +# Taken from Text::ParseWords +# +sub quotewords { + my($delim, $keep, @lines) = @_; + my($line, @words, @allwords); + + foreach $line (@lines) { + @words = parse_line($delim, $keep, $line); + return() unless (@words || !length($line)); + push(@allwords, @words); + } + return(@allwords); +} + +sub parse_line { + my($delimiter, $keep, $line) = @_; + my($word, @pieces); + + no warnings 'uninitialized'; # we will be testing undef strings + + while (length($line)) { + $line =~ s/^(["']) # a $quote + ((?:\\.|(?!\1)[^\\])*) # and $quoted text + \1 # followed by the same quote + | # --OR-- + ^((?:\\.|[^\\"'])*?) # an $unquoted text + (\Z(?!\n)|(?-x:$delimiter)|(?!^)(?=["'])) + # plus EOL, delimiter, or quote + //xs or return; # extended layout + my($quote, $quoted, $unquoted, $delim) = ($1, $2, $3, $4); + return() unless( defined($quote) || length($unquoted) || length($delim)); + + if ($keep) { + $quoted = "$quote$quoted$quote"; + } else { + $unquoted =~ s/\\(.)/$1/sg; + if (defined $quote) { + $quoted =~ s/\\(.)/$1/sg if ($quote eq '"'); + $quoted =~ s/\\([\\'])/$1/g if ( $PERL_SINGLE_QUOTE && $quote eq "'"); + } + } + $word .= substr($line, 0, 0); # leave results tainted + $word .= defined $quote ? $quoted : $unquoted; + + if (length($delim)) { + push(@pieces, $word); + push(@pieces, $delim) if ($keep eq 'delimiters'); + undef $word; + } + if (!length($line)) { + push(@pieces, $word); + } + } + return(@pieces); +} + + +############################################ =pod =back |