/usr/share/perl5/Exception/Handler.pm is in libexception-handler-perl 1.004-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 | package Exception::Handler;
use strict;
use vars qw( $VERSION );
$VERSION = 1.00_4; # Thu Dec 21 18:04:23 CST 2006
# --------------------------------------------------------
# Constructor
# --------------------------------------------------------
sub new {
my($this) = bless({ }, shift(@_));
$this->{'errors'} = [@_];
return $this
}
# --------------------------------------------------------
# Exception::Handler::error()
# --------------------------------------------------------
sub error { @{ $_->{'errors'} } } # very bad; very easy
# --------------------------------------------------------
# Exception::Handler::fail()
# --------------------------------------------------------
sub fail {
my($this) = shift(@_);
my($throw_count) = $this->{'tflag'} || 0;
{
# I refuse to manually initialize a standard environment
# variable. This is an example where the warnings pragma
# is going too far. It's something we live with.
local($^W) = undef;
# if we're running in a CGI gateway iface, we need
# to output the necessary HTTP headers
if ( $ENV{'REQUEST_METHOD'} ) {
print(<<__crash__) and exit;
Content-Type: text/html; charset=ISO-8859-1
<pre>
PROCESS TERMINATED DUE TO ERRORS
@{[ $this->trace(@_) ]}
</pre>
__crash__
}
else {
print(<<__crash__) and exit;
PROCESS TERMINATED DUE TO ERRORS
@{[ $this->trace(@_) ]}
__crash__
}
}
exit
}
# --------------------------------------------------------
# Exception::Handler::trace()
# --------------------------------------------------------
sub trace {
my($this) = shift(@_);
my(@errors) = @_; $this->{'errors'} = [@errors];
my($errfile) = '';
my($caught) = '';
my(
$pak, $file, $line, $sub,
$hasargs, $wantarray, $evaltext, $req_OR_use,
@stack, $i, $ialias
);
$ialias = 0;
while (
(
$pak, $file, $line, $sub,
$hasargs, $wantarray, $evaltext, $req_OR_use
) = caller( $i++ )
)
{
$ialias = $i - 2; next unless ($ialias > 0);
if ( (split(/\:\:/, $sub))[0] ne __PACKAGE__ ) {
push @stack, <<__ERR__
$ialias. $sub
-called at line ($line) of $file
@{[ ($hasargs)
? '-was called with args'
: '-was called without args' ]}
@{[ ($evaltext)
? '-was called to evalate text'
: '-was not called to evaluate anything' ]}
__ERR__
}
else {
$caught = qq[\012] . uc(qq[exception was raised at])
. qq[ line ($line) of $file];
}
}
$i = 0;
if ( scalar(@errors) == 0 ) {
push ( @errors, qq[[Unspecified error. Frame no. $ialias...]] );
}
foreach (@errors) {
$_ = ( defined($_) ) ? $_ : '';
if (!length($_)) { $_ = qq[Something is wrong. Frame no. $ialias...]; }
else {
$_ =~ s/^(?:\r|\n)//o; $_ =~ s/(?:\r|\n)$//o;
$_ = qq[\012$_\012];
}
++$i;
}
join(qq[\012] x 2, @errors)
. ($caught ? $caught . qq[\012] : '')
. qq[\012] . join(qq[\012] x 2, @stack);
}
# --------------------------------------------------------
# Exception::Handler::DESTROY()
# --------------------------------------------------------
sub DESTROY { } sub AUTOLOAD { }
1;
=pod
=head1 NAME
Exception::Handler - Report exceptions with formatted text call-stack
=head1 VERSION
1.00_2
=head1 @EXPORT, @EXPORT_OK
None.
=head1 Methods
new()
fail()
trace()
error()
=head2 AUTOLOAD-ed methods
None.
=head1 PREREQUISITES
None.
=head1 AUTHOR
Tommy Butler <cpan@atrixnet.com>
=head1 COPYRIGHT
Copyright(c) 2001-2003, Tommy Butler. All rights reserved.
=head1 LICENSE
This library is free software, you may redistribute
and/or modify it under the same terms as Perl itself.
=cut
|