summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/diagnostics.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/diagnostics.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/diagnostics.pm50
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;