FM / perl5

/usr/share/perl5

Name	Size	Mode	Actions
Attribute/	-	0755	rm
B/	-	0755	rm
Class/	-	0755	rm
Compress/	-	0755	rm
Config/	-	0755	rm
CPAN/	-	0755	rm
DBM_Filter/	-	0755	rm
Devel/	-	0755	rm
encoding/	-	0755	rm
ExtUtils/	-	0755	rm
File/	-	0755	rm
Getopt/	-	0755	rm
I18N/	-	0755	rm
IO/	-	0755	rm
IPC/	-	0755	rm
Locale/	-	0755	rm
Math/	-	0755	rm
Memoize/	-	0755	rm
Module/	-	0755	rm
Net/	-	0755	rm
overload/	-	0755	rm
Pod/	-	0755	rm
pod/	-	0755	rm
Search/	-	0755	rm
Term/	-	0755	rm
Text/	-	0755	rm
Thread/	-	0755	rm
Tie/	-	0755	rm
Time/	-	0755	rm
Unicode/	-	0755	rm
unicore/	-	0755	rm
URI/	-	0755	rm
User/	-	0755	rm
vendor_perl/	-	0755	rm
warnings/	-	0755	rm
AnyDBM_File.pm	2618	0644	edit dl rm
AutoLoader.pm	15797	0644	edit dl rm
AutoSplit.pm	19637	0644	edit dl rm
autouse.pm	4238	0644	edit dl rm
base.pm	10980	0644	edit dl rm
Benchmark.pm	31025	0644	edit dl rm
blib.pm	2086	0644	edit dl rm
bytes.pm	3754	0644	edit dl rm
bytes_heavy.pl	758	0644	edit dl rm
charnames.pm	20867	0644	edit dl rm
CORE.pod	3188	0644	edit dl rm
DB.pm	18922	0644	edit dl rm
DBM_Filter.pm	14385	0644	edit dl rm
deprecate.pm	3079	0644	edit dl rm
diagnostics.pm	19038	0644	edit dl rm
DirHandle.pm	1556	0644	edit dl rm
Dumpvalue.pm	17556	0644	edit dl rm
dumpvar.pl	15555	0644	edit dl rm
English.pm	4761	0644	edit dl rm
feature.pm	17085	0644	edit dl rm
fields.pm	9489	0644	edit dl rm
FileCache.pm	5572	0644	edit dl rm
FileHandle.pm	6784	0644	edit dl rm
filetest.pm	4003	0644	edit dl rm
FindBin.pm	4561	0644	edit dl rm
if.pm	3340	0644	edit dl rm
integer.pm	3254	0644	edit dl rm
Internals.pod	2576	0644	edit dl rm
less.pm	3204	0644	edit dl rm
locale.pm	4855	0644	edit dl rm
Memoize.pm	36192	0644	edit dl rm
meta_notation.pm	2117	0644	edit dl rm
NEXT.pm	18846	0644	edit dl rm
open.pm	8021	0644	edit dl rm
overload.pm	53314	0644	edit dl rm
overloading.pm	1808	0644	edit dl rm
perl5db.pl	316420	0644	edit dl rm
PerlIO.pm	10459	0644	edit dl rm
Safe.pm	25082	0644	edit dl rm
SelectSaver.pm	1076	0644	edit dl rm
SelfLoader.pm	17692	0644	edit dl rm
sigtrap.pm	7606	0644	edit dl rm
sort.pm	6081	0644	edit dl rm
strict.pm	4738	0644	edit dl rm
subs.pm	848	0644	edit dl rm
Symbol.pm	4799	0644	edit dl rm
Test.pm	30057	0644	edit dl rm
Thread.pm	8287	0644	edit dl rm
UNIVERSAL.pm	6594	0644	edit dl rm
URI.pm	34790	0644	edit dl rm
utf8.pm	9116	0644	edit dl rm
utf8_heavy.pl	31615	0644	edit dl rm
vars.pm	2414	0644	edit dl rm
vmsish.pm	4313	0644	edit dl rm
warnings.pm	44756	0644	edit dl rm
XSLoader.pm	11267	0644	edit dl rm
_charnames.pm	33166	0644	edit dl rm

Edit: /usr/share/perl5/sigtrap.pm (7606B)

package sigtrap;

=head1 NAME

sigtrap - Perl pragma to enable simple signal handling

=cut

use Carp;

$VERSION = 1.08;
$Verbose ||= 0;

sub import {
    my $pkg = shift;
    my $handler = \&handler_traceback;
    my $saw_sig = 0;
    my $untrapped = 0;
    local $_;

Arg_loop:
    while (@_) {
	$_ = shift;
	if (/^[A-Z][A-Z0-9]*$/) {
	    $saw_sig++;
	    unless ($untrapped and $SIG{$_} and $SIG{$_} ne 'DEFAULT') {
		print "Installing handler $handler for $_\n" if $Verbose;
		$SIG{$_} = $handler;
	    }
	}
	elsif ($_ eq 'normal-signals') {
	    unshift @_, grep(exists $SIG{$_}, qw(HUP INT PIPE TERM));
	}
	elsif ($_ eq 'error-signals') {
	    unshift @_, grep(exists $SIG{$_},
			     qw(ABRT BUS EMT FPE ILL QUIT SEGV SYS TRAP));
	}
	elsif ($_ eq 'old-interface-signals') {
	    unshift @_,
	    grep(exists $SIG{$_},
		 qw(ABRT BUS EMT FPE ILL PIPE QUIT SEGV SYS TERM TRAP));
	}
    	elsif ($_ eq 'stack-trace') {
	    $handler = \&handler_traceback;
	}
	elsif ($_ eq 'die') {
	    $handler = \&handler_die;
	}
	elsif ($_ eq 'handler') {
	    @_ or croak "No argument specified after 'handler'";
	    $handler = shift;
	    unless (ref $handler or $handler eq 'IGNORE'
			or $handler eq 'DEFAULT') {
    	    	require Symbol;
		$handler = Symbol::qualify($handler, (caller)[0]);
	    }
	}
	elsif ($_ eq 'untrapped') {
	    $untrapped = 1;
	}
	elsif ($_ eq 'any') {
	    $untrapped = 0;
	}
	elsif ($_ =~ /^\d/) {
	    $VERSION >= $_ or croak "sigtrap.pm version $_ required,"
		    	    	    	. " but this is only version $VERSION";
	}
	else {
	    croak "Unrecognized argument $_";
	}
    }
    unless ($saw_sig) {
	@_ = qw(old-interface-signals);
	goto Arg_loop;
    }
}

sub handler_die {
    croak "Caught a SIG$_[0]";
}

sub handler_traceback {
    package DB;		# To get subroutine args.
    $SIG{'ABRT'} = DEFAULT;
    kill 'ABRT', $$ if $panic++;
    syswrite(STDERR, 'Caught a SIG', 12);
    syswrite(STDERR, $_[0], length($_[0]));
    syswrite(STDERR, ' at ', 4);
    ($pack,$file,$line) = caller;
    syswrite(STDERR, $file, length($file));
    syswrite(STDERR, ' line ', 6);
    syswrite(STDERR, $line, length($line));
    syswrite(STDERR, "\n", 1);

# Now go for broke.
    for ($i = 1; ($p,$f,$l,$s,$h,$w,$e,$r) = caller($i); $i++) {
        @a = ();
	for (@{[@args]}) {
	    s/([\'\\])/\\$1/g;
	    s/([^\0]*)/'$1'/
	      unless /^(?: -?[\d.]+ | \*[\w:]* )$/x;
            require 'meta_notation.pm';
            $_ = _meta_notation($_) if /[[:^print:]]/a;
	    push(@a, $_);
	}
	$w = $w ? '@ = ' : '$ = ';
	$a = $h ? '(' . join(', ', @a) . ')' : '';
	$e =~ s/\n\s*\;\s*\Z// if $e;
	$e =~ s/[\\\']/\\$1/g if $e;
	if ($r) {
	    $s = "require '$e'";
	} elsif (defined $r) {
	    $s = "eval '$e'";
	} elsif ($s eq '(eval)') {
	    $s = "eval {...}";
	}
	$f = "file '$f'" unless $f eq '-e';
	$mess = "$w$s$a called from $f line $l\n";
	syswrite(STDERR, $mess, length($mess));
    }
    kill 'ABRT', $$;
}

__END__

=head1 SYNOPSIS

use sigtrap;
    use sigtrap qw(stack-trace old-interface-signals);	# equivalent
    use sigtrap qw(BUS SEGV PIPE ABRT);
    use sigtrap qw(die INT QUIT);
    use sigtrap qw(die normal-signals);
    use sigtrap qw(die untrapped normal-signals);
    use sigtrap qw(die untrapped normal-signals
		    stack-trace any error-signals);
    use sigtrap 'handler' => \&my_handler, 'normal-signals';
    use sigtrap qw(handler my_handler normal-signals
    	    	    stack-trace error-signals);

=head1 DESCRIPTION

The B<sigtrap> pragma is a simple interface to installing signal
handlers.  You can have it install one of two handlers supplied by
B<sigtrap> itself (one which provides a Perl stack trace and one which
simply C<die()>s), or alternately you can supply your own handler for it
to install.  It can be told only to install a handler for signals which
are either untrapped or ignored.  It has a couple of lists of signals to
trap, plus you can supply your own list of signals.

The arguments passed to the C<use> statement which invokes B<sigtrap>
are processed in order.  When a signal name or the name of one of
B<sigtrap>'s signal lists is encountered a handler is immediately
installed, when an option is encountered it affects subsequently
installed handlers.

=head1 OPTIONS

=head2 SIGNAL HANDLERS

These options affect which handler will be used for subsequently
installed signals.

=over 4

=item B<stack-trace>

The handler used for subsequently installed signals outputs a Perl stack
trace to STDERR and then tries to dump core.  This is the default signal
handler.

=item B<die>

The handler used for subsequently installed signals calls C<die>
(actually C<croak>) with a message indicating which signal was caught.

=item B<handler> I<your-handler>

I<your-handler> will be used as the handler for subsequently installed
signals.  I<your-handler> can be any value which is valid as an
assignment to an element of C<%SIG>. See L<perlvar> for examples of
handler functions.

=back

=head2 SIGNAL LISTS

B<sigtrap> has a few built-in lists of signals to trap.  They are:

=over 4

=item B<normal-signals>

These are the signals which a program might normally expect to encounter
and which by default cause it to terminate.  They are HUP, INT, PIPE and
TERM.

=item B<error-signals>

These signals usually indicate a serious problem with the Perl
interpreter or with your script.  They are ABRT, BUS, EMT, FPE, ILL,
QUIT, SEGV, SYS and TRAP.

=item B<old-interface-signals>

These are the signals which were trapped by default by the old
B<sigtrap> interface, they are ABRT, BUS, EMT, FPE, ILL, PIPE, QUIT,
SEGV, SYS, TERM, and TRAP.  If no signals or signals lists are passed to
B<sigtrap>, this list is used.

=back

For each of these three lists, the collection of signals set to be
trapped is checked before trapping; if your architecture does not
implement a particular signal, it will not be trapped but rather
silently ignored.

=head2 OTHER

=over 4

=item B<untrapped>

This token tells B<sigtrap> to install handlers only for subsequently
listed signals which aren't already trapped or ignored.

=item B<any>

This token tells B<sigtrap> to install handlers for all subsequently
listed signals.  This is the default behavior.

=item I<signal>

Any argument which looks like a signal name (that is,
C</^[A-Z][A-Z0-9]*$/>) indicates that B<sigtrap> should install a
handler for that name.

=item I<number>

Require that at least version I<number> of B<sigtrap> is being used.

=back

=head1 EXAMPLES

Provide a stack trace for the old-interface-signals:

use sigtrap;

Ditto:

use sigtrap qw(stack-trace old-interface-signals);

Provide a stack trace on the 4 listed signals only:

use sigtrap qw(BUS SEGV PIPE ABRT);

Die on INT or QUIT:

use sigtrap qw(die INT QUIT);

Die on HUP, INT, PIPE or TERM:

use sigtrap qw(die normal-signals);

Die on HUP, INT, PIPE or TERM, except don't change the behavior for
signals which are already trapped or ignored:

use sigtrap qw(die untrapped normal-signals);

Die on receipt one of an of the B<normal-signals> which is currently
B<untrapped>, provide a stack trace on receipt of B<any> of the
B<error-signals>:

use sigtrap qw(die untrapped normal-signals
		    stack-trace any error-signals);

Install my_handler() as the handler for the B<normal-signals>:

use sigtrap 'handler', \&my_handler, 'normal-signals';

Install my_handler() as the handler for the normal-signals, provide a
Perl stack trace on receipt of one of the error-signals:

use sigtrap qw(handler my_handler normal-signals
    	    	    stack-trace error-signals);

=cut

cmd: