diff options
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; |