diff options
author | Karl Berry <karl@freefriends.org> | 2012-05-21 00:15:27 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2012-05-21 00:15:27 +0000 |
commit | a4c42bfb2337d37da89d789cb8cc226367994e32 (patch) | |
tree | c3eabdef5d565a4e515d2be0d9d4d0540bde0250 /Master/tlpkg/tlperl/lib/diagnostics.pm | |
parent | 8274475057f024d35332ac47c2e2f23ea156e6ed (diff) |
perl 5.14.2 from siep
git-svn-id: svn://tug.org/texlive/trunk@26525 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/diagnostics.pm')
-rw-r--r-- | Master/tlpkg/tlperl/lib/diagnostics.pm | 50 |
1 files changed, 40 insertions, 10 deletions
diff --git a/Master/tlpkg/tlperl/lib/diagnostics.pm b/Master/tlpkg/tlperl/lib/diagnostics.pm index 721b466fd05..b3464488d7a 100644 --- a/Master/tlpkg/tlperl/lib/diagnostics.pm +++ b/Master/tlpkg/tlperl/lib/diagnostics.pm @@ -185,7 +185,7 @@ use 5.009001; use Carp; $Carp::Internal{__PACKAGE__.""}++; -our $VERSION = '1.19'; +our $VERSION = '1.22'; our $DEBUG; our $VERBOSE; our $PRETTY; @@ -211,12 +211,6 @@ my @trypod = ( unshift @trypod, "./pod/perldiag.pod" if -e "pod/perldiag.pod"; (my $PODFILE) = ((grep { -e } @trypod), $trypod[$#trypod])[0]; -if ($^O eq 'MacOS') { - # just updir one from each lib dir, we'll find it ... - ($PODFILE) = grep { -e } map { "$_:pod:perldiag.pod" } @INC; -} - - $DEBUG ||= 0; my $WHOAMI = ref bless []; # nobody's business, prolly not even mine @@ -325,19 +319,42 @@ my %msg; print STDERR "FINISHING COMPILATION for $_\n" if $DEBUG; local $/ = ''; my $header; + my @headers; my $for_item; + my $seen_body; while (<POD_DIAG>) { + sub _split_pod_link { + $_[0] =~ '(?:([^|]*)\|)?([^/]*)(?:/("?)(.*)\3)?'; + ($1,$2,$4); + } + unescape(); if ($PRETTY) { sub noop { return $_[0] } # spensive for a noop sub bold { my $str =$_[0]; $str =~ s/(.)/$1\b$1/g; return $str; } sub italic { my $str = $_[0]; $str =~ s/(.)/_\b$1/g; return $str; } s/C<<< (.*?) >>>|C<< (.*?) >>|[BC]<(.*?)>/bold($+)/ges; - s/[LIF]<(.*?)>/italic($1)/ges; + s/[IF]<(.*?)>/italic($1)/ges; + s/L<(.*?)>/ + my($text,$page,$sect) = _split_pod_link($1); + defined $text + ? $text + : defined $sect + ? italic($sect) . ' in ' . italic($page) + : italic($page) + /ges; } else { s/C<<< (.*?) >>>|C<< (.*?) >>|[BC]<(.*?)>/$+/gs; - s/[LIF]<(.*?)>/$1/gs; + s/[IF]<(.*?)>/$1/gs; + s/L<(.*?)>/ + my($text,$page,$sect) = _split_pod_link($1); + defined $text + ? $text + : defined $sect + ? qq '"$sect" in $page' + : $page + /ges; } unless (/^=/) { if (defined $header) { @@ -350,10 +367,22 @@ my %msg; } s/^/ /gm; $msg{$header} .= $_; + for my $h(@headers) { $msg{$h} .= $_ } + ++$seen_body; undef $for_item; } next; } + + # If we have not come across the body of the description yet, then + # the previous header needs to share the same description. + if ($seen_body) { + @headers = (); + } + else { + push @headers, $header if defined $header; + } + unless ( s/=item (.*?)\s*\z//) { if ( s/=head1\sDESCRIPTION//) { @@ -413,6 +442,7 @@ my %msg; if $msg{$header}; $msg{$header} = ''; + $seen_body = 0; } @@ -560,7 +590,7 @@ sub splainthis { s/, <.*?> (?:line|chunk).*$//; # Discard 1st " at <file> line <no>" and all text beyond - # but be aware of messsages containing " at this-or-that" + # but be aware of messages containing " at this-or-that" my $real = 0; my @secs = split( / at / ); return unless @secs; |