FM / bin

/usr/bin

Name	Size	Mode	Actions
aclocal	36376	0755	edit dl rm
aclocal-1.16	36376	0755	edit dl rm
addr2line	28408	0755	edit dl rm
agentxtrap	27960	0755	edit dl rm
animate	15456	0755	edit dl rm
ar	57328	0755	edit dl rm
arch	32224	0755	edit dl rm
arpaname	15472	0755	edit dl rm
as	727360	0755	edit dl rm
aspell	154744	0755	edit dl rm
at	6009	0755	edit dl rm
atq	6011	0755	edit dl rm
atrm	6013	0755	edit dl rm
autoconf	14771	0755	edit dl rm
autoheader	8534	0755	edit dl rm
autom4te	32181	0755	edit dl rm
automake	257981	0755	edit dl rm
automake-1.16	257981	0755	edit dl rm
autoreconf	21066	0755	edit dl rm
autoscan	17124	0755	edit dl rm
autoupdate	33872	0755	edit dl rm
awk	714928	0755	edit dl rm
b2sum	52832	0755	edit dl rm
base32	36344	0755	edit dl rm
base64	36344	0755	edit dl rm
basename	32240	0755	edit dl rm
basenc	48976	0755	edit dl rm
bash	1389024	0755	edit dl rm
bashbug-64	7079	0755	edit dl rm
batch	140	0755	edit dl rm
bison	506632	0755	edit dl rm
bunzip2	40392	0755	edit dl rm
bzcat	40392	0755	edit dl rm
bzcmp	2144	0755	edit dl rm
bzdiff	2144	0755	edit dl rm
bzgrep	2058	0755	edit dl rm
bzip2	40392	0755	edit dl rm
bzip2recover	15592	0755	edit dl rm
bzless	1263	0755	edit dl rm
bzmore	1263	0755	edit dl rm
c++	1097224	0755	edit dl rm
c++filt	27840	0755	edit dl rm
c89	228	0755	edit dl rm
c99	219	0755	edit dl rm
cagefs_enter.proxied	6029	0755	edit dl rm
cal	53064	0755	edit dl rm
captoinfo	89896	0755	edit dl rm
cat	36312	0755	edit dl rm
catchsegv	3289	0755	edit dl rm
cc	1093128	0755	edit dl rm
chcon	61488	0755	edit dl rm
chgrp	57320	0755	edit dl rm
chmod	57304	0755	edit dl rm
chown	61432	0755	edit dl rm
chrt	27960	0755	edit dl rm
cksum	32136	0755	edit dl rm
cldetect	11222	0755	edit dl rm
clear	15512	0755	edit dl rm
cloudlinux-awp-user	1818	0755	edit dl rm
clwpos-user	1818	0755	edit dl rm
cmp	41096	0755	edit dl rm
col	23792	0755	edit dl rm
colcrt	15552	0755	edit dl rm
colrm	15528	0755	edit dl rm
column	36184	0755	edit dl rm
comm	36408	0755	edit dl rm
compare	15456	0755	edit dl rm
composite	15456	0755	edit dl rm
conjure	15464	0755	edit dl rm
convert	15464	0755	edit dl rm
cp	144400	0755	edit dl rm
cpan	8571	0755	edit dl rm
cpp	1097224	0755	edit dl rm
crontab	5826	0755	edit dl rm
crontab.cagefs	41440	0755	edit dl rm
csplit	111272	0755	edit dl rm
curl	254456	0755	edit dl rm
cut	44656	0755	edit dl rm
cyrusbdb2current	1651824	0755	edit dl rm
date	106336	0755	edit dl rm
dbiprof	6206	0755	edit dl rm
dd	69576	0755	edit dl rm
delv	45544	0755	edit dl rm
df	82464	0755	edit dl rm
diff	199368	0755	edit dl rm
diff3	53560	0755	edit dl rm
dig	139872	0755	edit dl rm
dir	140752	0755	edit dl rm
dircolors	40568	0755	edit dl rm
dirname	27952	0755	edit dl rm
display	15456	0755	edit dl rm
dnstap-read	23744	0755	edit dl rm
du	152848	0755	edit dl rm
echo	27944	0755	edit dl rm
ed	53768	0755	edit dl rm
egrep	32	0755	edit dl rm
enc2xs	41663	0755	edit dl rm
enchant	24296	0755	edit dl rm
enchant-lsmod	16184	0755	edit dl rm
env	45088	0755	edit dl rm
eps2eps	643	0755	edit dl rm
eqn	194064	0755	edit dl rm
ex	1452256	0755	edit dl rm
expand	40488	0755	edit dl rm
expr	111040	0755	edit dl rm
factor	73592	0755	edit dl rm
false	27936	0755	edit dl rm
fc-cache	139	0755	edit dl rm
fc-cache-64	23728	0755	edit dl rm
fc-cat	19616	0755	edit dl rm
fc-conflist	15496	0755	edit dl rm
fc-list	15496	0755	edit dl rm
fc-match	15496	0755	edit dl rm
fc-pattern	15504	0755	edit dl rm
fc-query	15496	0755	edit dl rm
fc-scan	15504	0755	edit dl rm
fc-validate	15504	0755	edit dl rm
fgrep	32	0755	edit dl rm
file	28288	0755	edit dl rm
find	291792	0755	edit dl rm
flex	422544	0755	edit dl rm
flex++	422544	0755	edit dl rm
flock	23928	0755	edit dl rm
fmt	40528	0755	edit dl rm
fold	40456	0755	edit dl rm
free	23920	0755	edit dl rm
freetype-config	4423	0755	edit dl rm
funzip	32000	0755	edit dl rm
g++	1097224	0755	edit dl rm
gawk	714928	0755	edit dl rm
gcc	1093128	0755	edit dl rm
gcc-ar	28336	0755	edit dl rm
gcc-nm	28312	0755	edit dl rm
gcc-ranlib	28336	0755	edit dl rm
gcov	488576	0755	edit dl rm
gcov-dump	298768	0755	edit dl rm
gcov-tool	328160	0755	edit dl rm
gencat	28104	0755	edit dl rm
geoiplookup	16248	0755	edit dl rm
geoiplookup6	16200	0755	edit dl rm
geqn	194064	0755	edit dl rm
GET	16200	0755	edit dl rm
getconf	36080	0755	edit dl rm
getent	36720	0755	edit dl rm
getopt	23824	0755	edit dl rm
ghostscript	15488	0755	edit dl rm
git	4397352	0755	edit dl rm
git-receive-pack	4397352	0755	edit dl rm
git-shell	826960	0755	edit dl rm
git-upload-archive	4397352	0755	edit dl rm
git-upload-pack	4397352	0755	edit dl rm
gm	16048	0755	edit dl rm
gmake	255792	0755	edit dl rm
gneqn	916	0755	edit dl rm
gnroff	3285	0755	edit dl rm
gpg	1123624	0755	edit dl rm
gpg-agent	350488	0755	edit dl rm
gpg-error	36968	0755	edit dl rm
gpgsplit	28160	0755	edit dl rm
gpgv	302520	0755	edit dl rm
gpic	206560	0755	edit dl rm
gprof	103920	0755	edit dl rm
grep	158200	0755	edit dl rm
groff	99088	0755	edit dl rm
grops	171272	0755	edit dl rm
grotty	125128	0755	edit dl rm
groups	36328	0755	edit dl rm
gs	15488	0755	edit dl rm
gsnd	281	0755	edit dl rm
gsoelim	-	0	edit dl rm
gtar	534824	0755	edit dl rm
gtbl	134000	0755	edit dl rm
gtroff	749640	0755	edit dl rm
gunzip	2350	0755	edit dl rm
gzexe	6484	0755	edit dl rm
gzip	91088	0755	edit dl rm
h2ph	29382	0755	edit dl rm
h2xs	60931	0755	edit dl rm
head	40560	0755	edit dl rm
hexdump	52640	0755	edit dl rm
host	111176	0755	edit dl rm
hostid	32224	0755	edit dl rm
hostname	24408	0755	edit dl rm
hunspell	105136	0755	edit dl rm
iconv	65624	0755	edit dl rm
icu-config	205	0755	edit dl rm
icu-config-64	22189	0755	edit dl rm
icuinfo	15864	0755	edit dl rm
id	40472	0755	edit dl rm
identify	15464	0755	edit dl rm
idn	36664	0755	edit dl rm
ifnames	4128	0755	edit dl rm
import	15456	0755	edit dl rm
infocmp	65208	0755	edit dl rm
infotocap	89896	0755	edit dl rm
install	152656	0755	edit dl rm
instmodsh	4194	0755	edit dl rm
ionice	15576	0755	edit dl rm
ipcrm	19688	0755	edit dl rm
ipcs	40280	0755	edit dl rm
isosize	15512	0755	edit dl rm
ispell	992	0755	edit dl rm
join	52928	0755	edit dl rm
kill	32032	0755	edit dl rm
ld	1791600	0755	edit dl rm
ld.bfd	1791600	0755	edit dl rm
ldd	5446	0755	edit dl rm
less	202440	0755	edit dl rm
lessecho	15536	0755	edit dl rm
lesskey	25200	0755	edit dl rm
lesspipe.sh	3580	0755	edit dl rm
lex	422544	0755	edit dl rm
libnetcfg	15775	0755	edit dl rm
libtool	367802	0755	edit dl rm
libtoolize	129200	0755	edit dl rm
link	32232	0755	edit dl rm
ln	57288	0755	edit dl rm
locale	60496	0755	edit dl rm
localedef	321584	0755	edit dl rm
logger	36840	0755	edit dl rm
login	44504	0755	edit dl rm
logname	32224	0755	edit dl rm
look	19632	0755	edit dl rm
ls	140744	0755	edit dl rm
lto-dump	27882568	0755	edit dl rm
m4	246168	0755	edit dl rm
Mail	-	0	edit dl rm
mail	-	0	edit dl rm
mailx	-	0	edit dl rm
make	255792	0755	edit dl rm
make-dummy-cert	614	0755	edit dl rm
mariadb	5246200	0755	edit dl rm
mariadb-access	111961	0755	edit dl rm
mariadb-admin	5013392	0755	edit dl rm
mariadb-binlog	5303232	0755	edit dl rm
mariadb-check	5010424	0755	edit dl rm
mariadb-conv	4731024	0755	edit dl rm
mariadb-convert-table-format	4220	0755	edit dl rm
mariadb-dump	5107000	0755	edit dl rm
mariadb-dumpslow	8242	0755	edit dl rm
mariadb-embedded	24373096	0755	edit dl rm
mariadb-find-rows	3290	0755	edit dl rm
mariadb-hotcopy	35359	0755	edit dl rm
mariadb-import	5005256	0755	edit dl rm
mariadb-plugin	4705784	0755	edit dl rm
mariadb-secure-installation	13803	0755	edit dl rm
mariadb-setpermission	17977	0755	edit dl rm
mariadb-show	5003656	0755	edit dl rm
mariadb-slap	5023200	0755	edit dl rm
mariadb-tzinfo-to-sql	4709208	0755	edit dl rm
mariadb-waitpid	4696504	0755	edit dl rm
mcookie	27960	0755	edit dl rm
md5sum	40392	0755	edit dl rm
mesg	15504	0755	edit dl rm
mkdir	69760	0755	edit dl rm
mkfifo	40592	0755	edit dl rm
mknod	44728	0755	edit dl rm
mktemp	40568	0755	edit dl rm
mogrify	15464	0755	edit dl rm
montage	15464	0755	edit dl rm
more	44464	0755	edit dl rm
msql2mysql	1450	0755	edit dl rm
mv	144328	0755	edit dl rm
mysql	5246200	0755	edit dl rm
mysqlaccess	111961	0755	edit dl rm
mysqladmin	5013392	0755	edit dl rm
mysqlbinlog	5303232	0755	edit dl rm
mysqlcheck	5010424	0755	edit dl rm
mysqldump	5107000	0755	edit dl rm
mysqlimport	5005256	0755	edit dl rm
mysqlshow	5003656	0755	edit dl rm
mysql_config	4608	0755	edit dl rm
mysql_find_rows	3290	0755	edit dl rm
mysql_waitpid	4696504	0755	edit dl rm
mytop	73757	0755	edit dl rm
my_print_defaults	4697008	0755	edit dl rm
namei	23784	0755	edit dl rm
nano	354504	0755	edit dl rm
neqn	916	0755	edit dl rm
net-snmp-create-v3-user	3371	0755	edit dl rm
nice	36336	0755	edit dl rm
nl	102920	0755	edit dl rm
nm	45792	0755	edit dl rm
nohup	36248	0755	edit dl rm
nproc	36352	0755	edit dl rm
nroff	3285	0755	edit dl rm
nslookup	115224	0755	edit dl rm
nsupdate	73528	0755	edit dl rm
numfmt	56968	0755	edit dl rm
objcopy	189816	0755	edit dl rm
objdump	423000	0755	edit dl rm
od	65408	0755	edit dl rm
openssl	1122472	0755	edit dl rm
pango-list	19568	0755	edit dl rm
pango-segmentation	19584	0755	edit dl rm
pango-view	61616	0755	edit dl rm
passwd	6017	0755	edit dl rm
paste	36240	0755	edit dl rm
patch	199696	0755	edit dl rm
pathchk	36328	0755	edit dl rm
pdf2dsc	701	0755	edit dl rm
pdf2ps	913	0755	edit dl rm
perl	15488	0755	edit dl rm
perl5.32.1	15488	0755	edit dl rm
perlbug	44863	0755	edit dl rm
perldoc	118	0755	edit dl rm
perlivp	10813	0755	edit dl rm
perlml	14840	0755	edit dl rm
perlthanks	44863	0755	edit dl rm
pgrep	32176	0755	edit dl rm
php	937	0755	edit dl rm
pic	206560	0755	edit dl rm
piconv	8271	0755	edit dl rm
ping	91472	0755	edit dl rm
pinky	36264	0755	edit dl rm
pkg-config	335	0755	edit dl rm
pkill	32176	0755	edit dl rm
pl2pm	4533	0755	edit dl rm
pmap	36240	0755	edit dl rm
pod2html	4134	0755	edit dl rm
pod2man	15034	0755	edit dl rm
pod2text	10803	0755	edit dl rm
pod2usage	4107	0755	edit dl rm
podchecker	3658	0755	edit dl rm
post-grohtml	204552	0755	edit dl rm
pr	73832	0755	edit dl rm
pre-grohtml	95152	0755	edit dl rm
precat	5660	0755	edit dl rm
preunzip	5660	0755	edit dl rm
prezip	5660	0755	edit dl rm
prezip-bin	16064	0755	edit dl rm
printenv	32040	0755	edit dl rm
printf	52816	0755	edit dl rm
prove	13562	0755	edit dl rm
ps	144536	0755	edit dl rm
ps2ascii	635	0755	edit dl rm
ps2epsi	1268	0755	edit dl rm
ps2pdf	276	0755	edit dl rm
ps2pdf12	219	0755	edit dl rm
ps2pdf13	219	0755	edit dl rm
ps2pdf14	219	0755	edit dl rm
ps2pdfwr	1082	0755	edit dl rm
ps2ps	651	0755	edit dl rm
ps2ps2	673	0755	edit dl rm
ptx	131912	0755	edit dl rm
pwd	36376	0755	edit dl rm
pwdx	15648	0755	edit dl rm
pydoc	78	0755	edit dl rm
pydoc3	78	0755	edit dl rm
pydoc3.9	78	0755	edit dl rm
ranlib	57336	0755	edit dl rm
readelf	683296	0755	edit dl rm
readlink	40456	0755	edit dl rm
realpath	40536	0755	edit dl rm
recode	32696	0755	edit dl rm
red	92	0755	edit dl rm
rename	23784	0755	edit dl rm
renew-dummy-cert	729	0755	edit dl rm
renice	15528	0755	edit dl rm
replace	4679032	0755	edit dl rm
reset	27992	0755	edit dl rm
rev	15520	0755	edit dl rm
rm	61432	0755	edit dl rm
rmdir	44464	0755	edit dl rm
rnano	354504	0755	edit dl rm
run-with-aspell	89	0755	edit dl rm
runcon	36312	0755	edit dl rm
rvi	1452256	0755	edit dl rm
rview	1452256	0755	edit dl rm
scalar	876968	0755	edit dl rm
scl	40496	0755	edit dl rm
scl_enabled	262	0755	edit dl rm
scl_source	1929	0755	edit dl rm
scp	136104	0755	edit dl rm
script	52816	0755	edit dl rm
sdiff	45264	0755	edit dl rm
sed	115544	0755	edit dl rm
selectorctl	8276	0755	edit dl rm
seq	48736	0755	edit dl rm
setsid	15512	0755	edit dl rm
setterm	36176	0755	edit dl rm
sftp	160840	0755	edit dl rm
sh	1389024	0755	edit dl rm
sha1sum	40392	0755	edit dl rm
sha224sum	40392	0755	edit dl rm
sha256sum	40392	0755	edit dl rm
sha384sum	40392	0755	edit dl rm
sha512sum	40392	0755	edit dl rm
shred	52920	0755	edit dl rm
shuf	48952	0755	edit dl rm
size	32368	0755	edit dl rm
skill	32152	0755	edit dl rm
slabtop	23984	0755	edit dl rm
sleep	32224	0755	edit dl rm
snice	32152	0755	edit dl rm
snmpconf	26051	0755	edit dl rm
soelim	-	0	edit dl rm
sort	115608	0755	edit dl rm
spell	125	0755	edit dl rm
splain	19411	0755	edit dl rm
split	53360	0755	edit dl rm
sprof	36296	0755	edit dl rm
sqlite3	1610224	0755	edit dl rm
ssh	917880	0755	edit dl rm
ssh-add	313056	0755	edit dl rm
ssh-agent	325320	0755	edit dl rm
ssh-copy-id	14174	0755	edit dl rm
ssh-keygen	486832	0755	edit dl rm
ssh-keyscan	346352	0755	edit dl rm
stat	81768	0755	edit dl rm
stdbuf	44600	0755	edit dl rm
strace	2176664	0755	edit dl rm
stream	15456	0755	edit dl rm
strings	32504	0755	edit dl rm
strip	189808	0755	edit dl rm
stty	77456	0755	edit dl rm
sum	36232	0755	edit dl rm
sync	36200	0755	edit dl rm
tabs	19624	0755	edit dl rm
tac	102808	0755	edit dl rm
tail	69536	0755	edit dl rm
tar	534824	0755	edit dl rm
taskset	23784	0755	edit dl rm
tbl	134000	0755	edit dl rm
tclsh	16064	0755	edit dl rm
tclsh8.6	16064	0755	edit dl rm
tee	36344	0755	edit dl rm
test	44664	0755	edit dl rm
tic	89896	0755	edit dl rm
timeout	36848	0755	edit dl rm
tload	19800	0755	edit dl rm
tmpwatch	36896	0755	edit dl rm
toe	23784	0755	edit dl rm
top	135448	0755	edit dl rm
touch	94048	0755	edit dl rm
tput	27904	0755	edit dl rm
tr	44728	0755	edit dl rm
troff	749640	0755	edit dl rm
true	27936	0755	edit dl rm
truncate	36328	0755	edit dl rm
tset	27992	0755	edit dl rm
tsort	48744	0755	edit dl rm
tty	32224	0755	edit dl rm
tzselect	15352	0755	edit dl rm
uapi	6013	0755	edit dl rm
ul	23816	0755	edit dl rm
uname	32232	0755	edit dl rm
unexpand	40480	0755	edit dl rm
uniq	44680	0755	edit dl rm
unlink	32224	0755	edit dl rm
unzip	200688	0755	edit dl rm
unzipsfx	89808	0755	edit dl rm
uptime	15656	0755	edit dl rm
users	32256	0755	edit dl rm
utmpdump	23768	0755	edit dl rm
vdir	140752	0755	edit dl rm
vi	1452256	0755	edit dl rm
view	146	0755	edit dl rm
vmstat	40360	0755	edit dl rm
watch	28536	0755	edit dl rm
wc	44576	0755	edit dl rm
wget	533720	0755	edit dl rm
whereis	32608	0755	edit dl rm
which	28560	0755	edit dl rm
who	52832	0755	edit dl rm
whoami	32224	0755	edit dl rm
word-list-compress	16080	0755	edit dl rm
x86_64-redhat-linux-c++	1097224	0755	edit dl rm
x86_64-redhat-linux-g++	1097224	0755	edit dl rm
x86_64-redhat-linux-gcc	1093128	0755	edit dl rm
x86_64-redhat-linux-gcc-11	1093128	0755	edit dl rm
xargs	65632	0755	edit dl rm
xmlcatalog	23712	0755	edit dl rm
xmllint	82488	0755	edit dl rm
xmlwf	40576	0755	edit dl rm
xsltproc	31984	0755	edit dl rm
xsubpp	5080	0755	edit dl rm
yes	32064	0755	edit dl rm
zcat	1988	0755	edit dl rm
zcmp	1682	0755	edit dl rm
zdiff	6451	0755	edit dl rm
zegrep	33	0755	edit dl rm
zfgrep	33	0755	edit dl rm
zforce	2085	0755	edit dl rm
zgrep	8116	0755	edit dl rm
zip	226400	0755	edit dl rm
zipcloak	77512	0755	edit dl rm
zipgrep	2957	0755	edit dl rm
zipinfo	200688	0755	edit dl rm
zipnote	69232	0755	edit dl rm
zipsplit	65104	0755	edit dl rm
zless	2210	0755	edit dl rm
zmore	1846	0755	edit dl rm
znew	4581	0755	edit dl rm
zsoelim	-	0	edit dl rm
[	52872	0755	edit dl rm

Edit: /usr/bin/splain (19411B)

#!/usr/bin/perl
    eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
	if $running_under_some_shell;

BEGIN { pop @INC if $INC[-1] eq '.' }

=head1 NAME

diagnostics, splain - produce verbose warning diagnostics

=head1 SYNOPSIS

Using the C<diagnostics> pragma:

use diagnostics;
    use diagnostics -verbose;

enable  diagnostics;
    disable diagnostics;

Using the C<splain> standalone filter program:

perl program 2>diag.out
    splain [-v] [-p] diag.out

Using diagnostics to get stack traces from a misbehaving script:

perl -Mdiagnostics=-traceonly my_script.pl

=head1 DESCRIPTION

=head2 The C<diagnostics> Pragma

This module extends the terse diagnostics normally emitted by both the
perl compiler and the perl interpreter (from running perl with a -w 
switch or C<use warnings>), augmenting them with the more
explicative and endearing descriptions found in L<perldiag>.  Like the
other pragmata, it affects the compilation phase of your program rather
than merely the execution phase.

To use in your program as a pragma, merely invoke

use diagnostics;

at the start (or near the start) of your program.  (Note 
that this I<does> enable perl's B<-w> flag.)  Your whole
compilation will then be subject(ed :-) to the enhanced diagnostics.
These still go out B<STDERR>.

Due to the interaction between runtime and compiletime issues,
and because it's probably not a very good idea anyway,
you may not use C<no diagnostics> to turn them off at compiletime.
However, you may control their behaviour at runtime using the 
disable() and enable() methods to turn them off and on respectively.

The B<-verbose> flag first prints out the L<perldiag> introduction before
any other diagnostics.  The $diagnostics::PRETTY variable can generate nicer
escape sequences for pagers.

Warnings dispatched from perl itself (or more accurately, those that match
descriptions found in L<perldiag>) are only displayed once (no duplicate
descriptions).  User code generated warnings a la warn() are unaffected,
allowing duplicate user messages to be displayed.

This module also adds a stack trace to the error message when perl dies.
This is useful for pinpointing what
caused the death.  The B<-traceonly> (or
just B<-t>) flag turns off the explanations of warning messages leaving just
the stack traces.  So if your script is dieing, run it again with

perl -Mdiagnostics=-traceonly my_bad_script

to see the call stack at the time of death.  By supplying the B<-warntrace>
(or just B<-w>) flag, any warnings emitted will also come with a stack
trace.

=head2 The I<splain> Program

While apparently a whole nuther program, I<splain> is actually nothing
more than a link to the (executable) F<diagnostics.pm> module, as well as
a link to the F<diagnostics.pod> documentation.  The B<-v> flag is like
the C<use diagnostics -verbose> directive.
The B<-p> flag is like the
$diagnostics::PRETTY variable.  Since you're post-processing with 
I<splain>, there's no sense in being able to enable() or disable() processing.

Output from I<splain> is directed to B<STDOUT>, unlike the pragma.

=head1 EXAMPLES

The following file is certain to trigger a few errors at both
runtime and compiletime:

use diagnostics;
    print NOWHERE "nothing\n";
    print STDERR "\n\tThis message should be unadorned.\n";
    warn "\tThis is a user warning";
    print "\nDIAGNOSTIC TESTER: Please enter a <CR> here: ";
    my $a, $b = scalar <STDIN>;
    print "\n";
    print $x/$y;

If you prefer to run your program first and look at its problem
afterwards, do this:

perl -w test.pl 2>test.out
    ./splain < test.out

Note that this is not in general possible in shells of more dubious heritage, 
as the theoretical

(perl -w test.pl >/dev/tty) >& test.out
    ./splain < test.out

Because you just moved the existing B<stdout> to somewhere else.

If you don't want to modify your source code, but still have on-the-fly
warnings, do this:

exec 3>&1; perl -w test.pl 2>&1 1>&3 3>&- | splain 1>&2 3>&-

Nifty, eh?

If you want to control warnings on the fly, do something like this.
Make sure you do the C<use> first, or you won't be able to get
at the enable() or disable() methods.

use diagnostics; # checks entire compilation phase 
	print "\ntime for 1st bogus diags: SQUAWKINGS\n";
	print BOGUS1 'nada';
	print "done with 1st bogus\n";

disable diagnostics; # only turns off runtime warnings
	print "\ntime for 2nd bogus: (squelched)\n";
	print BOGUS2 'nada';
	print "done with 2nd bogus\n";

enable diagnostics; # turns back on runtime warnings
	print "\ntime for 3rd bogus: SQUAWKINGS\n";
	print BOGUS3 'nada';
	print "done with 3rd bogus\n";

disable diagnostics;
	print "\ntime for 4th bogus: (squelched)\n";
	print BOGUS4 'nada';
	print "done with 4th bogus\n";

=head1 INTERNALS

Diagnostic messages derive from the F<perldiag.pod> file when available at
runtime.  Otherwise, they may be embedded in the file itself when the
splain package is built.   See the F<Makefile> for details.

If an extant $SIG{__WARN__} handler is discovered, it will continue
to be honored, but only after the diagnostics::splainthis() function 
(the module's $SIG{__WARN__} interceptor) has had its way with your
warnings.

There is a $diagnostics::DEBUG variable you may set if you're desperately
curious what sorts of things are being intercepted.

BEGIN { $diagnostics::DEBUG = 1 }

=head1 BUGS

Not being able to say "no diagnostics" is annoying, but may not be
insurmountable.

The C<-pretty> directive is called too late to affect matters.
You have to do this instead, and I<before> you load the module.

BEGIN { $diagnostics::PRETTY = 1 }

I could start up faster by delaying compilation until it should be
needed, but this gets a "panic: top_level" when using the pragma form
in Perl 5.001e.

While it's true that this documentation is somewhat subserious, if you use
a program named I<splain>, you should expect a bit of whimsy.

=head1 AUTHOR

Tom Christiansen <F<tchrist@mox.perl.com>>, 25 June 1995.

=cut

use strict;
use 5.009001;
use Carp;
$Carp::Internal{__PACKAGE__.""}++;

our $VERSION = '1.37';
our $DEBUG;
our $VERBOSE;
our $PRETTY;
our $TRACEONLY = 0;
our $WARNTRACE = 0;

use Config;
use Text::Tabs 'expand';
my $privlib = $Config{privlibexp};
if ($^O eq 'VMS') {
    require VMS::Filespec;
    $privlib = VMS::Filespec::unixify($privlib);
}
my @trypod = (
	   "$privlib/pod/perldiag.pod",
	   "$privlib/pods/perldiag.pod",
	  );
# handy for development testing of new warnings etc
unshift @trypod, "./pod/perldiag.pod" if -e "pod/perldiag.pod";
(my $PODFILE) = ((grep { -e } @trypod), $trypod[$#trypod])[0];

$DEBUG ||= 0;

local $| = 1;
local $_;
local $.;

my $standalone;
my(%HTML_2_Troff, %HTML_2_Latin_1, %HTML_2_ASCII_7);

CONFIG: {
    our $opt_p = our $opt_d = our $opt_v = our $opt_f = '';

unless (caller) {
	$standalone++;
	require Getopt::Std;
	Getopt::Std::getopts('pdvf:')
	    or die "Usage: $0 [-v] [-p] [-f splainpod]";
	$PODFILE = $opt_f if $opt_f;
	$DEBUG = 2 if $opt_d;
	$VERBOSE = $opt_v;
	$PRETTY = $opt_p;
    }

if (open(POD_DIAG, '<', $PODFILE)) {
	warn "Happy happy podfile from real $PODFILE\n" if $DEBUG;
	last CONFIG;
    }

if (caller) {
	INCPATH: {
	    for my $file ( (map { "$_/".__PACKAGE__.".pm" } @INC), $0) {
		warn "Checking $file\n" if $DEBUG;
		if (open(POD_DIAG, '<', $file)) {
		    while (<POD_DIAG>) {
			next unless
			    /^__END__\s*# wish diag dbase were more accessible/;
			print STDERR "podfile is $file\n" if $DEBUG;
			last INCPATH;
		    }
		}
	    } 
	}
    } else { 
	print STDERR "podfile is <DATA>\n" if $DEBUG;
	*POD_DIAG = *main::DATA;
    }
}
if (eof(POD_DIAG)) { 
    die "couldn't find diagnostic data in $PODFILE @INC $0";
}

%HTML_2_Troff = (
    'amp'	=>	'&',	#   ampersand
    'lt'	=>	'<',	#   left chevron, less-than
    'gt'	=>	'>',	#   right chevron, greater-than
    'quot'	=>	'"',	#   double quote
    'sol'	=>	'/',	#   forward slash / solidus
    'verbar'    =>	'|',	#   vertical bar

"Aacute"	=>	"A\\*'",	#   capital A, acute accent
    # etc

);

%HTML_2_Latin_1 = (
    'amp'	=>	'&',	#   ampersand
    'lt'	=>	'<',	#   left chevron, less-than
    'gt'	=>	'>',	#   right chevron, greater-than
    'quot'	=>	'"',	#   double quote
    'sol'	=>	'/',	#   Forward slash / solidus
    'verbar'    =>	'|',	#   vertical bar

"Aacute"	=>	"\xC1"	#   capital A, acute accent

# etc
);

%HTML_2_ASCII_7 = (
    'amp'	=>	'&',	#   ampersand
    'lt'	=>	'<',	#   left chevron, less-than
    'gt'	=>	'>',	#   right chevron, greater-than
    'quot'	=>	'"',	#   double quote
    'sol'	=>	'/',	#   Forward slash / solidus
    'verbar'    =>	'|',	#   vertical bar

"Aacute"	=>	"A"	#   capital A, acute accent
    # etc
);

our %HTML_Escapes;
*HTML_Escapes = do {
    if ($standalone) {
	$PRETTY ? \%HTML_2_Latin_1 : \%HTML_2_ASCII_7; 
    } else {
	\%HTML_2_Latin_1; 
    }
};

*THITHER = $standalone ? *STDOUT : *STDERR;

my %transfmt = (); 
my $transmo = <<EOFUNC;
sub transmo {
    #local \$^W = 0;  # recursive warnings we do NOT need!
EOFUNC

my %msg;
my $over_level = 0;     # We look only at =item lines at the first =over level
{
    print STDERR "FINISHING COMPILATION for $_\n" if $DEBUG;
    local $/ = '';
    local $_;
    my $header;
    my @headers;
    my $for_item;
    my $seen_body;
    while (<POD_DIAG>) {

sub _split_pod_link {
	    $_[0] =~ m'(?:([^|]*)\|)?([^/]*)(?:/("?)(.*)\3)?'s;
	    ($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/[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;
	     s/S<(.*?)>/
               $1
             /ges;
	} else {
	    s/C<<< (.*?) >>>|C<< (.*?) >>|[BC]<(.*?)>/$+/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;
	    s/S<(.*?)>/
               $1
             /ges;
	} 
	unless (/^=/) {
	    if (defined $header) { 
		if ( $header eq 'DESCRIPTION' && 
		    (   /Optional warnings are enabled/ 
		     || /Some of these messages are generic./
		    ) )
		{
		    next;
		}
		$_ = expand $_;
		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;
	}

if ( ! s/=item (.*?)\s*\z//s || $over_level != 1) {

if ( s/=head1\sDESCRIPTION//) {
		$msg{$header = 'DESCRIPTION'} = '';
		undef $for_item;
	    }
	    elsif( s/^=for\s+diagnostics\s*\n(.*?)\s*\z// ) {
		$for_item = $1;
	    }
	    elsif( /^=over\b/ ) {
                $over_level++;
            }
	    elsif( /^=back\b/ ) { # Stop processing body here
                $over_level--;
                if ($over_level == 0) {
                    undef $header;
                    undef $for_item;
                    $seen_body = 0;
                    next;
                }
	    }
	    next;
	}

if( $for_item ) { $header = $for_item; undef $for_item } 
	else {
	    $header = $1;

$header =~ s/\n/ /gs; # Allow multi-line headers
	}

# strip formatting directives from =item line
	$header =~ s/[A-Z]<(.*?)>/$1/g;

# Since we strip "(\.\s*)\n" when we search a warning, strip it here as well
	$header =~ s/(\.\s*)?$//;

my @toks = split( /(%l?[dxX]|%[ucp]|%(?:\.\d+)?[fs])/, $header );
	if (@toks > 1) {
            my $conlen = 0;
            for my $i (0..$#toks){
                if( $i % 2 ){
                    if(      $toks[$i] eq '%c' ){
                        $toks[$i] = '.';
                    } elsif( $toks[$i] =~ /^%(?:d|u)$/ ){
                        $toks[$i] = '\d+';
                    } elsif( $toks[$i] =~ '^%(?:s|.*f)$' ){
                        $toks[$i] = $i == $#toks ? '.*' : '.*?';
                    } elsif( $toks[$i] =~ '%.(\d+)s' ){
                        $toks[$i] = ".{$1}";
                    } elsif( $toks[$i] =~ '^%l*([pxX])$' ){
                        $toks[$i] = $1 eq 'X' ? '[\dA-F]+' : '[\da-f]+';
                    }
                } elsif( length( $toks[$i] ) ){
                    $toks[$i] = quotemeta $toks[$i];
                    $conlen += length( $toks[$i] );
                }
            }  
            my $lhs = join( '', @toks );
            $lhs =~ s/(\\\s)+/\\s+/g; # Replace lit space with multi-space match
	    $transfmt{$header}{pat} =
              "    s^\\s*$lhs\\s*\Q$header\Es\n\t&& return 1;\n";
            $transfmt{$header}{len} = $conlen;
	} else {
            my $lhs = "\Q$header\E";
            $lhs =~ s/(\\\s)+/\\s+/g; # Replace lit space with multi-space match
            $transfmt{$header}{pat} =
	      "    s^\\s*$lhs\\s*\Q$header\E\n\t && return 1;\n";
            $transfmt{$header}{len} = length( $header );
	}

print STDERR __PACKAGE__.": Duplicate entry: \"$header\"\n"
	    if $msg{$header};

$msg{$header} = '';
	$seen_body = 0;
    }

close POD_DIAG unless *main::DATA eq *POD_DIAG;

die "No diagnostics?" unless %msg;

# Apply patterns in order of decreasing sum of lengths of fixed parts
    # Seems the best way of hitting the right one.
    for my $hdr ( sort { $transfmt{$b}{len} <=> $transfmt{$a}{len} }
                  keys %transfmt ){
        $transmo .= $transfmt{$hdr}{pat};
    }
    $transmo .= "    return 0;\n}\n";
    print STDERR $transmo if $DEBUG;
    eval $transmo;
    die $@ if $@;
}

if ($standalone) {
    if (!@ARGV and -t STDIN) { print STDERR "$0: Reading from STDIN\n" } 
    while (defined (my $error = <>)) {
	splainthis($error) || print THITHER $error;
    } 
    exit;
}

my $olddie;
my $oldwarn;

sub import {
    shift;
    $^W = 1; # yup, clobbered the global variable; 
	     # tough, if you want diags, you want diags.
    return if defined $SIG{__WARN__} && ($SIG{__WARN__} eq \&warn_trap);

for (@_) {

/^-d(ebug)?$/ 	   	&& do {
				    $DEBUG++;
				    next;
				   };

/^-v(erbose)?$/ 	&& do {
				    $VERBOSE++;
				    next;
				   };

/^-p(retty)?$/ 		&& do {
				    print STDERR "$0: I'm afraid it's too late for prettiness.\n";
				    $PRETTY++;
				    next;
			       };
	# matches trace and traceonly for legacy doc mixup reasons
	/^-t(race(only)?)?$/	&& do {
				    $TRACEONLY++;
				    next;
			       };
	/^-w(arntrace)?$/ 	&& do {
				    $WARNTRACE++;
				    next;
			       };

warn "Unknown flag: $_";
    }

$oldwarn = $SIG{__WARN__};
    $olddie = $SIG{__DIE__};
    $SIG{__WARN__} = \&warn_trap;
    $SIG{__DIE__} = \&death_trap;
}

sub enable { &import }

sub disable {
    shift;
    return unless $SIG{__WARN__} eq \&warn_trap;
    $SIG{__WARN__} = $oldwarn || '';
    $SIG{__DIE__} = $olddie || '';
}

sub warn_trap {
    my $warning = $_[0];
    if (caller eq __PACKAGE__ or !splainthis($warning)) {
	if ($WARNTRACE) {
	    print STDERR Carp::longmess($warning);
	} else {
	    print STDERR $warning;
	}
    } 
    goto &$oldwarn if defined $oldwarn and $oldwarn and $oldwarn ne \&warn_trap;
};

sub death_trap {
    my $exception = $_[0];

# See if we are coming from anywhere within an eval. If so we don't
    # want to explain the exception because it's going to get caught.
    my $in_eval = 0;
    my $i = 0;
    while (my $caller = (caller($i++))[3]) {
      if ($caller eq '(eval)') {
	$in_eval = 1;
	last;
      }
    }

splainthis($exception) unless $in_eval;
    if (caller eq __PACKAGE__) {
	print STDERR "INTERNAL EXCEPTION: $exception";
    } 
    &$olddie if defined $olddie and $olddie and $olddie ne \&death_trap;

return if $in_eval;

# We don't want to unset these if we're coming from an eval because
    # then we've turned off diagnostics.

# Switch off our die/warn handlers so we don't wind up in our own
    # traps.
    $SIG{__DIE__} = $SIG{__WARN__} = '';

$exception =~ s/\n(?=.)/\n\t/gas;

die Carp::longmess("__diagnostics__")
	  =~ s/^__diagnostics__.*?line \d+\.?\n/
		  "Uncaught exception from user code:\n\t$exception"
	      /re;
	# up we go; where we stop, nobody knows, but i think we die now
	# but i'm deeply afraid of the &$olddie guy reraising and us getting
	# into an indirect recursion loop
};

my %exact_duplicate;
my %old_diag;
my $count;
my $wantspace;
sub splainthis {
  return 0 if $TRACEONLY;
  for (my $tmp = shift) {
    local $\;
    local $!;
    ### &finish_compilation unless %msg;
    s/(\.\s*)?\n+$//;
    my $orig = $_;
    # return unless defined;

# get rid of the where-are-we-in-input part
    s/, <.*?> (?:line|chunk).*$//;

# Discard 1st " at <file> line <no>" and all text beyond
    # but be aware of messages containing " at this-or-that"
    my $real = 0;
    my @secs = split( / at / );
    return unless @secs;
    $_ = $secs[0];
    for my $i ( 1..$#secs ){
        if( $secs[$i] =~ /.+? (?:line|chunk) \d+/ ){
            $real = 1;
            last;
        } else {
            $_ .= ' at ' . $secs[$i];
	}
    }

# remove parenthesis occurring at the end of some messages 
    s/^$(.*)$$/$1/;

if ($exact_duplicate{$orig}++) {
	return &transmo;
    } else {
	return 0 unless &transmo;
    }

my $short = shorten($orig);
    if ($old_diag{$_}) {
	autodescribe();
	print THITHER "$short (#$old_diag{$_})\n";
	$wantspace = 1;
    } elsif (!$msg{$_} && $orig =~ /\n./s) {
	# A multiline message, like "Attempt to reload /
	# Compilation failed"
	my $found;
	for (split /^/, $orig) {
	    splainthis($_) and $found = 1;
	}
	return $found;
    } else {
	autodescribe();
	$old_diag{$_} = ++$count;
	print THITHER "\n" if $wantspace;
	$wantspace = 0;
	print THITHER "$short (#$old_diag{$_})\n";
	if ($msg{$_}) {
	    print THITHER $msg{$_};
	} else {
	    if (0 and $standalone) { 
		print THITHER "    **** Error #$old_diag{$_} ",
			($real ? "is" : "appears to be"),
			" an unknown diagnostic message.\n\n";
	    }
	    return 0;
	} 
    }
    return 1;
  }
}

sub autodescribe {
    if ($VERBOSE and not $count) {
	print THITHER &{$PRETTY ? \&bold : \&noop}("DESCRIPTION OF DIAGNOSTICS"),
		"\n$msg{DESCRIPTION}\n";
    } 
}

sub unescape { 
    s {
            E<  
            ( [A-Za-z]+ )       
            >   
    } { 
         do {   
             exists $HTML_Escapes{$1}
                ? do { $HTML_Escapes{$1} }
                : do {
                    warn "Unknown escape: E<$1> in $_";
                    "E<$1>";
                } 
         } 
    }egx;
}

sub shorten {
    my $line = $_[0];
    if (length($line) > 79 and index($line, "\n") == -1) {
	my $space_place = rindex($line, ' ', 79);
	if ($space_place != -1) {
	    substr($line, $space_place, 1) = "\n\t";
	} 
    } 
    return $line;
}

1 unless $standalone;  # or it'll complain about itself
__END__ # wish diag dbase were more accessible

#!/usr/bin/perl eval 'exec /usr/bin/perl -S $0 ${1+"$@"}' if $running_under_some_shell; BEGIN { pop @INC if $INC[-1] eq '.' } =head1 NAME diagnostics, splain - produce verbose warning diagnostics =head1 SYNOPSIS Using the C pragma: use diagnostics; use diagnostics -verbose; enable diagnostics; disable diagnostics; Using the C standalone filter program: perl program 2>diag.out splain [-v] [-p] diag.out Using diagnostics to get stack traces from a misbehaving script: perl -Mdiagnostics=-traceonly my_script.pl =head1 DESCRIPTION =head2 The C Pragma This module extends the terse diagnostics normally emitted by both the perl compiler and the perl interpreter (from running perl with a -w switch or C), augmenting them with the more explicative and endearing descriptions found in L. Like the other pragmata, it affects the compilation phase of your program rather than merely the execution phase. To use in your program as a pragma, merely invoke use diagnostics; at the start (or near the start) of your program. (Note that this I enable perl's B<-w> flag.) Your whole compilation will then be subject(ed :-) to the enhanced diagnostics. These still go out B. Due to the interaction between runtime and compiletime issues, and because it's probably not a very good idea anyway, you may not use C to turn them off at compiletime. However, you may control their behaviour at runtime using the disable() and enable() methods to turn them off and on respectively. The B<-verbose> flag first prints out the L introduction before any other diagnostics. The $diagnostics::PRETTY variable can generate nicer escape sequences for pagers. Warnings dispatched from perl itself (or more accurately, those that match descriptions found in L) are only displayed once (no duplicate descriptions). User code generated warnings a la warn() are unaffected, allowing duplicate user messages to be displayed. This module also adds a stack trace to the error message when perl dies. This is useful for pinpointing what caused the death. The B<-traceonly> (or just B<-t>) flag turns off the explanations of warning messages leaving just the stack traces. So if your script is dieing, run it again with perl -Mdiagnostics=-traceonly my_bad_script to see the call stack at the time of death. By supplying the B<-warntrace> (or just B<-w>) flag, any warnings emitted will also come with a stack trace. =head2 The I Program While apparently a whole nuther program, I is actually nothing more than a link to the (executable) F module, as well as a link to the F documentation. The B<-v> flag is like the C directive. The B<-p> flag is like the $diagnostics::PRETTY variable. Since you're post-processing with I, there's no sense in being able to enable() or disable() processing. Output from I is directed to B, unlike the pragma. =head1 EXAMPLES The following file is certain to trigger a few errors at both runtime and compiletime: use diagnostics; print NOWHERE "nothing\n"; print STDERR "\n\tThis message should be unadorned.\n"; warn "\tThis is a user warning"; print "\nDIAGNOSTIC TESTER: Please enter a here: "; my $a, $b = scalar ; print "\n"; print $x/$y; If you prefer to run your program first and look at its problem afterwards, do this: perl -w test.pl 2>test.out ./splain < test.out Note that this is not in general possible in shells of more dubious heritage, as the theoretical (perl -w test.pl >/dev/tty) >& test.out ./splain < test.out Because you just moved the existing B to somewhere else. If you don't want to modify your source code, but still have on-the-fly warnings, do this: exec 3>&1; perl -w test.pl 2>&1 1>&3 3>&- | splain 1>&2 3>&- Nifty, eh? If you want to control warnings on the fly, do something like this. Make sure you do the C first, or you won't be able to get at the enable() or disable() methods. use diagnostics; # checks entire compilation phase print "\ntime for 1st bogus diags: SQUAWKINGS\n"; print BOGUS1 'nada'; print "done with 1st bogus\n"; disable diagnostics; # only turns off runtime warnings print "\ntime for 2nd bogus: (squelched)\n"; print BOGUS2 'nada'; print "done with 2nd bogus\n"; enable diagnostics; # turns back on runtime warnings print "\ntime for 3rd bogus: SQUAWKINGS\n"; print BOGUS3 'nada'; print "done with 3rd bogus\n"; disable diagnostics; print "\ntime for 4th bogus: (squelched)\n"; print BOGUS4 'nada'; print "done with 4th bogus\n"; =head1 INTERNALS Diagnostic messages derive from the F file when available at runtime. Otherwise, they may be embedded in the file itself when the splain package is built. See the F for details. If an extant $SIG{__WARN__} handler is discovered, it will continue to be honored, but only after the diagnostics::splainthis() function (the module's $SIG{__WARN__} interceptor) has had its way with your warnings. There is a $diagnostics::DEBUG variable you may set if you're desperately curious what sorts of things are being intercepted. BEGIN { $diagnostics::DEBUG = 1 } =head1 BUGS Not being able to say "no diagnostics" is annoying, but may not be insurmountable. The C<-pretty> directive is called too late to affect matters. You have to do this instead, and I you load the module. BEGIN { $diagnostics::PRETTY = 1 } I could start up faster by delaying compilation until it should be needed, but this gets a "panic: top_level" when using the pragma form in Perl 5.001e. While it's true that this documentation is somewhat subserious, if you use a program named I, you should expect a bit of whimsy. =head1 AUTHOR Tom Christiansen >, 25 June 1995. =cut use strict; use 5.009001; use Carp; $Carp::Internal{__PACKAGE__.""}++; our $VERSION = '1.37'; our $DEBUG; our $VERBOSE; our $PRETTY; our $TRACEONLY = 0; our $WARNTRACE = 0; use Config; use Text::Tabs 'expand'; my $privlib = $Config{privlibexp}; if ($^O eq 'VMS') { require VMS::Filespec; $privlib = VMS::Filespec::unixify($privlib); } my @trypod = ( "$privlib/pod/perldiag.pod", "$privlib/pods/perldiag.pod", ); # handy for development testing of new warnings etc unshift @trypod, "./pod/perldiag.pod" if -e "pod/perldiag.pod"; (my $PODFILE) = ((grep { -e } @trypod), $trypod[$#trypod])[0]; $DEBUG ||= 0; local $| = 1; local $_; local $.; my $standalone; my(%HTML_2_Troff, %HTML_2_Latin_1, %HTML_2_ASCII_7); CONFIG: { our $opt_p = our $opt_d = our $opt_v = our $opt_f = ''; unless (caller) { $standalone++; require Getopt::Std; Getopt::Std::getopts('pdvf:') or die "Usage: $0 [-v] [-p] [-f splainpod]"; $PODFILE = $opt_f if $opt_f; $DEBUG = 2 if $opt_d; $VERBOSE = $opt_v; $PRETTY = $opt_p; } if (open(POD_DIAG, '<', $PODFILE)) { warn "Happy happy podfile from real $PODFILE\n" if $DEBUG; last CONFIG; } if (caller) { INCPATH: { for my $file ( (map { "$_/".__PACKAGE__.".pm" } @INC), $0) { warn "Checking $file\n" if $DEBUG; if (open(POD_DIAG, '<', $file)) { while () { next unless /^__END__\s*# wish diag dbase were more accessible/; print STDERR "podfile is $file\n" if $DEBUG; last INCPATH; } } } } } else { print STDERR "podfile is \n" if $DEBUG; *POD_DIAG = *main::DATA; } } if (eof(POD_DIAG)) { die "couldn't find diagnostic data in $PODFILE @INC $0"; } %HTML_2_Troff = ( 'amp' => '&', # ampersand 'lt' => '<', # left chevron, less-than 'gt' => '>', # right chevron, greater-than 'quot' => '"', # double quote 'sol' => '/', # forward slash / solidus 'verbar' => '|', # vertical bar "Aacute" => "A\\*'", # capital A, acute accent # etc ); %HTML_2_Latin_1 = ( 'amp' => '&', # ampersand 'lt' => '<', # left chevron, less-than 'gt' => '>', # right chevron, greater-than 'quot' => '"', # double quote 'sol' => '/', # Forward slash / solidus 'verbar' => '|', # vertical bar "Aacute" => "\xC1" # capital A, acute accent # etc ); %HTML_2_ASCII_7 = ( 'amp' => '&', # ampersand 'lt' => '<', # left chevron, less-than 'gt' => '>', # right chevron, greater-than 'quot' => '"', # double quote 'sol' => '/', # Forward slash / solidus 'verbar' => '|', # vertical bar "Aacute" => "A" # capital A, acute accent # etc ); our %HTML_Escapes; *HTML_Escapes = do { if ($standalone) { $PRETTY ? \%HTML_2_Latin_1 : \%HTML_2_ASCII_7; } else { \%HTML_2_Latin_1; } }; *THITHER = $standalone ? *STDOUT : *STDERR; my %transfmt = (); my $transmo = <) { sub _split_pod_link { $_[0] =~ m'(?:([^|]*)\|)?([^/]*)(?:/("?)(.*)\3)?'s; ($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/[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; s/S<(.*?)>/ $1 /ges; } else { s/C<<< (.*?) >>>|C<< (.*?) >>|[BC]<(.*?)>/$+/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; s/S<(.*?)>/ $1 /ges; } unless (/^=/) { if (defined $header) { if ( $header eq 'DESCRIPTION' && ( /Optional warnings are enabled/ || /Some of these messages are generic./ ) ) { next; } $_ = expand $_; 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; } if ( ! s/=item (.*?)\s*\z//s || $over_level != 1) { if ( s/=head1\sDESCRIPTION//) { $msg{$header = 'DESCRIPTION'} = ''; undef $for_item; } elsif( s/^=for\s+diagnostics\s*\n(.*?)\s*\z// ) { $for_item = $1; } elsif( /^=over\b/ ) { $over_level++; } elsif( /^=back\b/ ) { # Stop processing body here $over_level--; if ($over_level == 0) { undef $header; undef $for_item; $seen_body = 0; next; } } next; } if( $for_item ) { $header = $for_item; undef $for_item } else { $header = $1; $header =~ s/\n/ /gs; # Allow multi-line headers } # strip formatting directives from =item line $header =~ s/[A-Z]<(.*?)>/$1/g; # Since we strip "(\.\s*)\n" when we search a warning, strip it here as well $header =~ s/(\.\s*)?$//; my @toks = split( /(%l?[dxX]|%[ucp]|%(?:\.\d+)?[fs])/, $header ); if (@toks > 1) { my $conlen = 0; for my $i (0..$#toks){ if( $i % 2 ){ if( $toks[$i] eq '%c' ){ $toks[$i] = '.'; } elsif( $toks[$i] =~ /^%(?:d|u)$/ ){ $toks[$i] = '\d+'; } elsif( $toks[$i] =~ '^%(?:s|.*f)$' ){ $toks[$i] = $i == $#toks ? '.*' : '.*?'; } elsif( $toks[$i] =~ '%.(\d+)s' ){ $toks[$i] = ".{$1}"; } elsif( $toks[$i] =~ '^%l*([pxX])$' ){ $toks[$i] = $1 eq 'X' ? '[\dA-F]+' : '[\da-f]+'; } } elsif( length( $toks[$i] ) ){ $toks[$i] = quotemeta $toks[$i]; $conlen += length( $toks[$i] ); } } my $lhs = join( '', @toks ); $lhs =~ s/(\\\s)+/\\s+/g; # Replace lit space with multi-space match $transfmt{$header}{pat} = " s^\\s*$lhs\\s*\Q$header\Es\n\t&& return 1;\n"; $transfmt{$header}{len} = $conlen; } else { my $lhs = "\Q$header\E"; $lhs =~ s/(\\\s)+/\\s+/g; # Replace lit space with multi-space match $transfmt{$header}{pat} = " s^\\s*$lhs\\s*\Q$header\E\n\t && return 1;\n"; $transfmt{$header}{len} = length( $header ); } print STDERR __PACKAGE__.": Duplicate entry: \"$header\"\n" if $msg{$header}; $msg{$header} = ''; $seen_body = 0; } close POD_DIAG unless *main::DATA eq *POD_DIAG; die "No diagnostics?" unless %msg; # Apply patterns in order of decreasing sum of lengths of fixed parts # Seems the best way of hitting the right one. for my $hdr ( sort { $transfmt{$b}{len} <=> $transfmt{$a}{len} } keys %transfmt ){ $transmo .= $transfmt{$hdr}{pat}; } $transmo .= " return 0;\n}\n"; print STDERR $transmo if $DEBUG; eval $transmo; die $@ if $@; } if ($standalone) { if (!@ARGV and -t STDIN) { print STDERR "$0: Reading from STDIN\n" } while (defined (my $error = <>)) { splainthis($error) || print THITHER $error; } exit; } my $olddie; my $oldwarn; sub import { shift; $^W = 1; # yup, clobbered the global variable; # tough, if you want diags, you want diags. return if defined $SIG{__WARN__} && ($SIG{__WARN__} eq \&warn_trap); for (@_) { /^-d(ebug)?$/ && do { $DEBUG++; next; }; /^-v(erbose)?$/ && do { $VERBOSE++; next; }; /^-p(retty)?$/ && do { print STDERR "$0: I'm afraid it's too late for prettiness.\n"; $PRETTY++; next; }; # matches trace and traceonly for legacy doc mixup reasons /^-t(race(only)?)?$/ && do { $TRACEONLY++; next; }; /^-w(arntrace)?$/ && do { $WARNTRACE++; next; }; warn "Unknown flag: $_"; } $oldwarn = $SIG{__WARN__}; $olddie = $SIG{__DIE__}; $SIG{__WARN__} = \&warn_trap; $SIG{__DIE__} = \&death_trap; } sub enable { &import } sub disable { shift; return unless $SIG{__WARN__} eq \&warn_trap; $SIG{__WARN__} = $oldwarn || ''; $SIG{__DIE__} = $olddie || ''; } sub warn_trap { my $warning = $_[0]; if (caller eq __PACKAGE__ or !splainthis($warning)) { if ($WARNTRACE) { print STDERR Carp::longmess($warning); } else { print STDERR $warning; } } goto &$oldwarn if defined $oldwarn and $oldwarn and $oldwarn ne \&warn_trap; }; sub death_trap { my $exception = $_[0]; # See if we are coming from anywhere within an eval. If so we don't # want to explain the exception because it's going to get caught. my $in_eval = 0; my $i = 0; while (my $caller = (caller($i++))[3]) { if ($caller eq '(eval)') { $in_eval = 1; last; } } splainthis($exception) unless $in_eval; if (caller eq __PACKAGE__) { print STDERR "INTERNAL EXCEPTION: $exception"; } &$olddie if defined $olddie and $olddie and $olddie ne \&death_trap; return if $in_eval; # We don't want to unset these if we're coming from an eval because # then we've turned off diagnostics. # Switch off our die/warn handlers so we don't wind up in our own # traps. $SIG{__DIE__} = $SIG{__WARN__} = ''; $exception =~ s/\n(?=.)/\n\t/gas; die Carp::longmess("__diagnostics__") =~ s/^__diagnostics__.*?line \d+\.?\n/ "Uncaught exception from user code:\n\t$exception" /re; # up we go; where we stop, nobody knows, but i think we die now # but i'm deeply afraid of the &$olddie guy reraising and us getting # into an indirect recursion loop }; my %exact_duplicate; my %old_diag; my $count; my $wantspace; sub splainthis { return 0 if $TRACEONLY; for (my $tmp = shift) { local $\; local $!; ### &finish_compilation unless %msg; s/(\.\s*)?\n+$//; my $orig = $_; # return unless defined; # get rid of the where-are-we-in-input part s/, <.*?> (?:line|chunk).*$//; # Discard 1st " at line " and all text beyond # but be aware of messages containing " at this-or-that" my $real = 0; my @secs = split( / at / ); return unless @secs; $_ = $secs[0]; for my $i ( 1..$#secs ){ if( $secs[$i] =~ /.+? (?:line|chunk) \d+/ ){ $real = 1; last; } else { $_ .= ' at ' . $secs[$i]; } } # remove parenthesis occurring at the end of some messages s/^$(.*)$$/$1/; if ($exact_duplicate{$orig}++) { return &transmo; } else { return 0 unless &transmo; } my $short = shorten($orig); if ($old_diag{$_}) { autodescribe(); print THITHER "$short (#$old_diag{$_})\n"; $wantspace = 1; } elsif (!$msg{$_} && $orig =~ /\n./s) { # A multiline message, like "Attempt to reload / # Compilation failed" my $found; for (split /^/, $orig) { splainthis($_) and $found = 1; } return $found; } else { autodescribe(); $old_diag{$_} = ++$count; print THITHER "\n" if $wantspace; $wantspace = 0; print THITHER "$short (#$old_diag{$_})\n"; if ($msg{$_}) { print THITHER $msg{$_}; } else { if (0 and $standalone) { print THITHER " **** Error #$old_diag{$_} ", ($real ? "is" : "appears to be"), " an unknown diagnostic message.\n\n"; } return 0; } } return 1; } } sub autodescribe { if ($VERBOSE and not $count) { print THITHER &{$PRETTY ? \&bold : \&noop}("DESCRIPTION OF DIAGNOSTICS"), "\n$msg{DESCRIPTION}\n"; } } sub unescape { s { E< ( [A-Za-z]+ ) > } { do { exists $HTML_Escapes{$1} ? do { $HTML_Escapes{$1} } : do { warn "Unknown escape: E<$1> in $_"; "E<$1>"; } } }egx; } sub shorten { my $line = $_[0]; if (length($line) > 79 and index($line, "\n") == -1) { my $space_place = rindex($line, ' ', 79); if ($space_place != -1) { substr($line, $space_place, 1) = "\n\t"; } } return $line; } 1 unless $standalone; # or it'll complain about itself __END__ # wish diag dbase were more accessible