From 6bdcd83826c0cf1d86450bc205c00864d8a0c403 Mon Sep 17 00:00:00 2001 From: Moritz Bunkus Date: Wed, 3 Apr 2019 14:17:13 +0200 Subject: [PATCH] Module: Exception::Lite durch Exception::Class ersetzt --- SL/Controller/Order.pm | 2 +- SL/DB/Helper/ActsAsList.pm | 4 +- SL/DB/Helper/Metadata.pm | 4 +- SL/DB/Object/Hooks.pm | 8 +- SL/Form.pm | 8 +- SL/InstallationCheck.pm | 2 +- SL/X.pm | 31 +- SL/X/Base.pm | 26 + modules/fallback/Exception/Lite.pm | 527 ------ modules/fallback/Exception/Lite.pod | 2314 --------------------------- 10 files changed, 65 insertions(+), 2861 deletions(-) create mode 100644 SL/X/Base.pm delete mode 100644 modules/fallback/Exception/Lite.pm delete mode 100644 modules/fallback/Exception/Lite.pod diff --git a/SL/Controller/Order.pm b/SL/Controller/Order.pm index 144fc87f8..5a42a195c 100644 --- a/SL/Controller/Order.pm +++ b/SL/Controller/Order.pm @@ -1724,7 +1724,7 @@ sub generate_pdf { }, ); 1; - } || push @errors, ref($EVAL_ERROR) eq 'SL::X::FormError' ? $EVAL_ERROR->getMessage : $EVAL_ERROR; + } || push @errors, ref($EVAL_ERROR) eq 'SL::X::FormError' ? $EVAL_ERROR->error : $EVAL_ERROR; }); return @errors; diff --git a/SL/DB/Helper/ActsAsList.pm b/SL/DB/Helper/ActsAsList.pm index abe11c063..7ca63a353 100644 --- a/SL/DB/Helper/ActsAsList.pm +++ b/SL/DB/Helper/ActsAsList.pm @@ -143,10 +143,10 @@ sub reorder_list { my $column = column_name($self); my $result = $self->db->with_transaction(sub { my $query = qq|UPDATE | . $self->meta->table . qq| SET ${column} = ? WHERE id = ?|; - my $sth = $self->db->dbh->prepare($query) || die $self->db->dbh->errstr; + my $sth = $self->db->dbh->prepare($query) || SL::X::DBUtilsError->throw(msg => 'reorder_list error', db_error => $self->db->dbh->errstr); foreach my $new_position (1 .. scalar(@ids)) { - $sth->execute($new_position, $ids[$new_position - 1]) || die SL::X::DBUtilsError->new(error => $sth->errstr); + $sth->execute($new_position, $ids[$new_position - 1]) || SL::X::DBUtilsError->throw(msg => 'reorder_list error', db_error => $sth->errstr); } $sth->finish; diff --git a/SL/DB/Helper/Metadata.pm b/SL/DB/Helper/Metadata.pm index 4eaa106f4..c65bb283d 100644 --- a/SL/DB/Helper/Metadata.pm +++ b/SL/DB/Helper/Metadata.pm @@ -38,8 +38,8 @@ sub handle_error { # these are used as Rose internal canaries, don't wrap them die $object->error if UNIVERSAL::isa($object->error, 'Rose::DB::Object::Exception'); - die SL::X::DBRoseError->new( - error => $object->error, + SL::X::DBRoseError->throw( + db_error => $object->error, class => ref($object), metaobject => $self, object => $object, diff --git a/SL/DB/Object/Hooks.pm b/SL/DB/Object/Hooks.pm index 371e4450e..6a5486936 100644 --- a/SL/DB/Object/Hooks.pm +++ b/SL/DB/Object/Hooks.pm @@ -44,10 +44,10 @@ sub run_hooks { foreach my $sub (@{ ( $hooks{$when} || { })->{ ref($object) } || [ ] }) { my $result = ref($sub) eq 'CODE' ? $sub->($object, @args) : $object->call_sub($sub, @args); - die SL::X::DBHookError->new(when => $when, - hook => (ref($sub) eq 'CODE' ? '' : $sub), - object => $object, - object_type => ref($object)) + SL::X::DBHookError->throw(when => $when, + hook => (ref($sub) eq 'CODE' ? '' : $sub), + object => $object, + object_type => ref($object)) if !$result; } } diff --git a/SL/Form.pm b/SL/Form.pm index 55ac63320..59d69c37c 100644 --- a/SL/Form.pm +++ b/SL/Form.pm @@ -249,7 +249,7 @@ sub hide_form { sub throw_on_error { my ($self, $code) = @_; - local $self->{__ERROR_HANDLER} = sub { die SL::X::FormError->new($_[0]) }; + local $self->{__ERROR_HANDLER} = sub { SL::X::FormError->throw(error => $_[0]) }; $code->(); } @@ -311,9 +311,9 @@ sub numtextrows { sub dberror { my ($self, $msg) = @_; - die SL::X::DBError->new( - msg => $msg, - error => $DBI::errstr, + SL::X::DBError->throw( + msg => $msg, + db_error => $DBI::errstr, ); } diff --git a/SL/InstallationCheck.pm b/SL/InstallationCheck.pm index e042d27cf..40f331dc9 100644 --- a/SL/InstallationCheck.pm +++ b/SL/InstallationCheck.pm @@ -30,7 +30,7 @@ BEGIN { { name => "DBI", version => '1.50', url => "http://search.cpan.org/~timb/", debian => 'libdbi-perl' }, { name => "DBD::Pg", version => '1.49', url => "http://search.cpan.org/~dbdpg/", debian => 'libdbd-pg-perl' }, { name => "Digest::SHA", url => "http://search.cpan.org/~mshelor/", debian => 'libdigest-sha-perl' }, - { name => "Exception::Lite", url => "http://search.cpan.org/~elisheva/", }, # fallback latest version 2011 + { name => "Exception::Class", url => "https://metacpan.org/pod/Exception::Class", debian => 'libexception-class-perl' }, { name => "Email::Address", version => '1.888', url => "http://search.cpan.org/~rjbs/", debian => 'libemail-address-perl' }, { name => "Email::MIME", url => "http://search.cpan.org/~rjbs/", debian => 'libemail-mime-perl' }, { name => "FCGI", version => '0.72', url => "http://search.cpan.org/~mstrout/", debian => 'libfcgi-perl' }, diff --git a/SL/X.pm b/SL/X.pm index 4ecfc7dfa..756793b90 100644 --- a/SL/X.pm +++ b/SL/X.pm @@ -1,13 +1,32 @@ package SL::X; use strict; +use warnings; -use Exception::Lite qw(declareExceptionClass); +use SL::X::Base; -declareExceptionClass('SL::X::FormError'); -declareExceptionClass('SL::X::DBError', [ '%s %s', qw(error msg) ]); -declareExceptionClass('SL::X::DBHookError', 'SL::X::DBError', [ '%s hook \'%s\' for object type \'%s\' failed', qw(when hook object_type object) ]); -declareExceptionClass('SL::X::DBRoseError', 'SL::X::DBError', [ '\'%s\' in object of type \'%s\' occured', qw(error class) ]); -declareExceptionClass('SL::X::DBUtilsError', 'SL::X::DBError', [ '%s: %s', qw(msg error) ]); +use Exception::Class ( + 'SL::X::FormError' => { + isa => 'SL::X::Base', + }, + 'SL::X::DBError' => { + isa => 'SL::X::Base', + fields => [ qw(msg db_error) ], + defaults => { error_template => [ '%s: %s', qw(msg db_error) ] }, + }, + 'SL::X::DBHookError' => { + isa => 'SL::X::DBError', + fields => [ qw(when hook object object_type) ], + defaults => { error_template => [ '%s hook \'%s\' for object type \'%s\' failed', qw(when hook object_type object) ] }, + }, + 'SL::X::DBRoseError' => { + isa => 'SL::X::DBError', + fields => [ qw(class metaobject object) ], + defaults => { error_template => [ '\'%s\' in object of type \'%s\' occured', qw(db_error class) ] }, + }, + 'SL::X::DBUtilsError' => { + isa => 'SL::X::DBError', + }, +); 1; diff --git a/SL/X/Base.pm b/SL/X/Base.pm new file mode 100644 index 000000000..3e6d25123 --- /dev/null +++ b/SL/X/Base.pm @@ -0,0 +1,26 @@ +package SL::X::Base; + +use strict; +use warnings; + +use parent qw(Exception::Class::Base); + +sub _defaults { return () } + +sub message { goto &error } + +sub error { + my ($self, @params) = @_; + + return $self->{message} if ($self->{message} // '') ne ''; + + return $self->SUPER::error(@params) if !$self->can('_defaults'); + + my %defaults = $self->_defaults; + return $self->SUPER::error(@params) if !$defaults{error_template}; + + my ($format, @fields) = @{ $defaults{error_template} }; + return sprintf $format, map { $self->$_ } @fields; +} + +1; diff --git a/modules/fallback/Exception/Lite.pm b/modules/fallback/Exception/Lite.pm deleted file mode 100644 index 5f467e6c3..000000000 --- a/modules/fallback/Exception/Lite.pm +++ /dev/null @@ -1,527 +0,0 @@ -# Copyright (c) 2010 Elizabeth Grace Frank-Backman. -# All rights reserved. -# Liscenced under the "Artistic Liscence" -# (see http://dev.perl.org/licenses/artistic.html) - -use 5.8.8; -use strict; -use warnings; -use overload; - -package Exception::Lite; -our @ISA = qw(Exporter); -our @EXPORT_OK=qw(declareExceptionClass isException isChainable - onDie onWarn); -our %EXPORT_TAGS - =( common => [qw(declareExceptionClass isException isChainable)] - , all => [@EXPORT_OK] - ); -my $CLASS='Exception::Lite'; - -#------------------------------------------------------------------ - -our $STRINGIFY=3; -our $FILTER=1; -our $UNDEF=''; -our $TAB=3; -our $LINE_LENGTH=120; - -# provide command line control over amount and layout of debugging -# information, e.g. perl -mException::Lite=STRINGIFY=4 - -sub import { - Exception::Lite->export_to_level(1, grep { - if (/^(\w+)=(.*)$/) { - my $k = $1; - my $v = $2; - if ($k eq 'STRINGIFY') { $STRINGIFY=$v; - } elsif ($k eq 'FILTER') { $FILTER=$v; - } elsif ($k eq 'LINE_LENGTH') { $LINE_LENGTH=$v; - } elsif ($k eq 'TAB') { $TAB=$v; - } - 0; - } else { - 1; - } - } @_); -} - -#------------------------------------------------------------------ -# Note to source code divers: DO NOT USE THIS. This is intended for -# internal use but must be declared with "our" because we need to -# localize it. This is an implementation detail and cannot be relied -# on for future releases. - -our $STACK_OFFSET=0; - -#------------------------------------------------------------------ - -use Scalar::Util (); -use constant EVAL => '(eval)'; - -#================================================================== -# EXPORTABLE FUNCTIONS -#================================================================== - -sub declareExceptionClass { - my ($sClass, $sSuperClass, $xFormatRule, $bCustomizeSubclass) = @_; - my $sPath = $sClass; $sPath =~ s/::/\//g; $sPath .= '.pm'; - if ($INC{$sPath}) { - # we want to start with the caller's frame, not ours - local $STACK_OFFSET = $STACK_OFFSET + 1; - die 'Exception::Lite::Any'->new("declareExceptionClass failed: " - . "$sClass is already defined!"); - return undef; - } - - my $sRef=ref($sSuperClass); - if ($sRef) { - $bCustomizeSubclass = $xFormatRule; - $xFormatRule = $sSuperClass; - $sSuperClass=undef; - } else { - $sRef = ref($xFormatRule); - if (!$sRef && defined($xFormatRule)) { - $bCustomizeSubclass = $xFormatRule; - $xFormatRule = undef; - } - } - - # set up things dependent on whether or not the class has a - # format string or expects a message for each instance - - my ($sLeadingParams, $sAddOrOmit, $sRethrowMsg, $sMakeMsg); - my $sReplaceMsg=''; - - if ($sRef) { - $sLeadingParams='my $e; $e=shift if ref($_[0]);'; - $sAddOrOmit='added an unnecessary message or format'; - $sRethrowMsg=''; - - #generate format rule - $xFormatRule=$xFormatRule->($sClass) if ($sRef eq 'CODE'); - - my $sFormat= 'q{' . $xFormatRule->[0] . '}'; - if (scalar($xFormatRule) == 1) { - $sMakeMsg='my $msg='.$sFormat; - } else { - my $sSprintf = 'Exception::Lite::_sprintf(' . $sFormat - . ', map {defined($_)?$_:\''. $UNDEF .'\'} @$h{qw(' - . join(' ', @$xFormatRule[1..$#$xFormatRule]) . ')});'; - $sMakeMsg='my $msg='.$sSprintf; - $sReplaceMsg='$_[0]->[0]='.$sSprintf; - } - - } else { - $sLeadingParams = 'my $e=shift; my $msg;'. - 'if(ref($e)) { $msg=shift; $msg=$e->[0] if !defined($msg);}'. - 'else { $msg=$e;$e=undef; }'; - $sAddOrOmit='omitted a required message'; - $sRethrowMsg='my $msg=shift; $_[0]->[0]=$msg if defined($msg);'; - $sMakeMsg=''; - } - - # put this in an eval so that it doesn't cause parse errors at - # compile time in no-threads versions of Perl - - my $sTid = eval q{defined(&threads::tid)?'threads->tid':'undef'}; - - my $sDeclare = "package $sClass;". - 'sub new { my $cl=shift;'. $sLeadingParams . - 'my $st=Exception::Lite::_cacheStackTrace($e);'. - 'my $h= Exception::Lite::_shiftProperties($cl' . - ',$st,"'.$sAddOrOmit.'",@_);' . $sMakeMsg . - 'my $self=bless([$msg,$h,$st,$$,'.$sTid.',$e,[]],$cl);'; - - # the remainder depends on the type of subclassing - - if ($bCustomizeSubclass) { - $sDeclare .= '$self->[7]={}; $self->_new(); return $self; }' - . 'sub _p_getSubclassData { $_[0]->[7]; }'; - } else { - $sDeclare .= 'return $self;}'. - 'sub replaceProperties {'. - 'my $h={%{$_[0]->[1]},%{$_[1]}}; $_[0]->[1]=$h;'.$sReplaceMsg. - '}'. - 'sub rethrow {' . - 'my $self=shift;' . $sRethrowMsg . - 'Exception::Lite::_rethrow($self,"'.$sAddOrOmit.'",@_)' . - '}'; - - unless (isExceptionClass($sSuperClass)) { - $sDeclare .= - 'sub _getInterface { \'Exception::Lite\' }' . - 'sub getMessage { $_[0]->[0] };' . - 'sub getProperty { $_[0]->[1]->{$_[1]} }' . - 'sub isProperty { exists($_[0]->[1]->{$_[1]})?1:0 }' . - 'sub getStackTrace { $_[0]->[2] }' . - 'sub getFrameCount { scalar(@{$_[0]->[2]}); }' . - 'sub getFile { $_[0]->[2]->[ $_[1]?$_[1]:0 ]->[0] };' . - 'sub getLine { $_[0]->[2]->[ $_[1]?$_[1]:0 ]->[1] };' . - 'sub getSubroutine { $_[0]->[2]->[ $_[1]?$_[1]:0 ]->[2] };' . - 'sub getArgs { $_[0]->[2]->[ $_[1]?$_[1]:0 ]->[3] };' . - 'sub getPackage {$_[0]->[2]->[-1]->[2] =~ /(\w+)>$/;$1}'. - 'sub getPid { $_[0]->[3] }' . - 'sub getTid { $_[0]->[4] }' . - 'sub getChained { $_[0]->[5] }' . - 'sub getPropagation { $_[0]->[6]; }' . - 'use overload '. - 'q{""} => \&Exception::Lite::_dumpMessage ' . - ', q{0+} => \&Exception::Lite::_refaddr, fallback=>1;' . - 'sub PROPAGATE { push @{$_[0]->[6]},[$_[1],$_[2]]; $_[0]}'; - } - } - $sDeclare .= 'return 1;'; - - local $SIG{__WARN__} = sub { - my ($p,$f,$l) = caller(2); - my $s=$_[0]; $s =~ s/at \(eval \d+\)\s+line\s+\d+\.//m; - print STDERR "$s in declareExceptionClass($sClass,...) " - ."in file $f, line $l\n"; - }; - - eval $sDeclare or do { - my ($p,$f,$l) = caller(1); - print STDERR "Can't create class $sClass at file $f, line $l\n"; - if ($sClass =~ /\w:\w/) { - print STDERR "Bad class name: " - ."At least one ':' is not doubled\n"; - } elsif ($sClass !~ /^\w+(?:::\w+)*$/) { - print STDERR "Bad class name: $sClass\n"; - } else { - $sDeclare=~s/(sub |use )/\n$1/g; print STDERR "$sDeclare\n"; - } - }; - - # this needs to be separate from the eval, otherwise it never - # ends up in @INC or @ISA, at least in Perl 5.8.8 - $INC{$sPath} = __FILE__; - eval "\@${sClass}::ISA=qw($sSuperClass);" if $sSuperClass; - - return $sClass; -} - -#------------------------------------------------------------------ - -sub isChainable { return ref($_[0])?1:0; } - -#------------------------------------------------------------------ - -sub isException { - my ($e, $sClass) = @_; - my $sRef=ref($e); - return !defined($sClass) - ? ($sRef ? isExceptionClass($sRef) : 0) - : $sClass eq '' - ? ($sRef eq '' ? 1 : 0) - : ($sRef eq '') - ? 0 - : $sRef->isa($sClass) - ?1:0; -} - -#------------------------------------------------------------------ - -sub isExceptionClass { - return defined($_[0]) && $_[0]->can('_getInterface') - && ($_[0]->_getInterface() eq __PACKAGE__) ? 1 : 0; -} - -#------------------------------------------------------------------ - -sub onDie { - my $iStringify = $_[0]; - $SIG{__DIE__} = sub { - $Exception::Lite::STRINGIFY=$iStringify; - warn 'Exception::Lite::Any'->new('Unexpected death:'.$_[0]) - unless $^S || isException($_[0]); - }; -} - -#------------------------------------------------------------------ - -sub onWarn { - my $iStringify = $_[0]; - $SIG{__WARN__} = sub { - $Exception::Lite::STRINGIFY=$iStringify; - print STDERR 'Exception::Lite::Any'->new("Warning: $_[0]"); - }; -} - -#================================================================== -# PRIVATE SUBROUTINES -#================================================================== - -#------------------------------------------------------------------ - -sub _cacheCall { - my $iFrame = $_[0]; - - my @aCaller; - my $aArgs; - - # caller populates @DB::args if called within DB package - eval { - # this 2 line wierdness is needed to prevent Module::Build from finding - # this and adding it to the provides list. - package - DB; - - #get rid of eval and call to _cacheCall - @aCaller = caller($iFrame+2); - - # mark leading undefined elements as maybe shifted away - my $iDefined; - if ($#aCaller < 0) { - @DB::args=@ARGV; - } - $aArgs = [ map { - defined($_) - ? do {$iDefined=1; - "'$_'" . (overload::Method($_,'""') - ? ' ('.overload::StrVal($_).')':'')} - : 'undef' . (defined($iDefined) - ? '':' (maybe shifted away?)') - } @DB::args]; - }; - - return $#aCaller < 0 ? \$aArgs : [ @aCaller[0..3], $aArgs ]; -} - -#------------------------------------------------------------------ - -sub _cacheStackTrace { - my $e=$_[0]; my $st=[]; - - # set up initial frame - my $iFrame= $STACK_OFFSET + 1; # call to new - my $aCall = _cacheCall($iFrame++); - my ($sPackage, $iFile, $iLine, $sSub, $sArgs) = @$aCall; - my $iLineFrame=$iFrame; - - $aCall = _cacheCall($iFrame++); #context of call to new - while (ref($aCall) ne 'REF') { - $sSub = $aCall->[3]; # subroutine containing file,line - $sArgs = $aCall->[4]; # args used to call $sSub - - #print STDERR "debug-2: package=$sPackage file=$iFile line=$iLine" - # ." sub=$sSub, args=@$sArgs\n"; - - # in evals we want the line number within the eval, but the - # name of the sub in which the eval was located. To get this - # we wait to push on the stack until we get an actual sub name - # and we avoid overwriting the location information, hence 'ne' - - if (!$FILTER || ($sSub ne EVAL)) { - my $aFrame=[ $iFile, $iLine, $sSub, $sArgs ]; - ($sPackage, $iFile, $iLine) = @$aCall; - $iLineFrame=$iFrame; - - my $sRef=ref($FILTER); - if ($sRef eq 'CODE') { - my $x = $FILTER->(@$aFrame, $iFrame, $iLineFrame); - if (ref($x) eq 'ARRAY') { - $aFrame=$x; - } elsif (!$x) { - $aFrame=undef; - } - } elsif (($sRef eq 'ARRAY') && ! _isIgnored($sSub, $FILTER)) { - $aFrame=undef; - } elsif (($sRef eq 'Regexp') && !_isIgnored($sSub, [$FILTER])) { - $aFrame=undef; - } - push(@$st, $aFrame) if $aFrame; - } - - $aCall = _cacheCall($iFrame++); - } - - push @$st, [ $iFile, $iLine, "", $$aCall ]; - if ($e) { my $n=$#{$e->[2]}-$#$st;$e->[2]=[@{$e->[2]}[0..$n]]}; - return $st; -} - -#----------------------------- - -sub _isIgnored { - my ($sSub, $aIgnore) = @_; - foreach my $re (@$aIgnore) { return 1 if $sSub =~ $re; } - return 0; -} - -#------------------------------------------------------------------ - -sub _dumpMessage { - my ($e, $iDepth) = @_; - - my $sMsg = $e->getMessage(); - return $sMsg unless $STRINGIFY; - if (ref($STRINGIFY) eq 'CODE') { - return $STRINGIFY->($sMsg); - } - - $iDepth = 0 unless defined($iDepth); - my $sIndent = ' ' x ($TAB*$iDepth); - $sMsg = "\n${sIndent}Exception! $sMsg"; - return $sMsg if $STRINGIFY == 0; - - my ($sThrow, $sReach); - my $sTab = ' ' x $TAB; - - $sIndent.= $sTab; - if ($STRINGIFY > 2) { - my $aPropagation = $e->getPropagation(); - for (my $i=$#$aPropagation; $i >= 0; $i--) { - my ($f,$l) = @{$aPropagation->[$i]}; - $sMsg .= "\n${sIndent}rethrown at file $f, line $l"; - } - $sMsg .= "\n"; - $sThrow='thrown '; - $sReach='reached '; - } else { - $sThrow=''; - $sReach=''; - } - - my $st=$e->getStackTrace(); - my $iTop = scalar @$st; - - for (my $iFrame=0; $iFrame<$iTop; $iFrame++) { - my ($f,$l,$s,$aArgs) = @{$st->[$iFrame]}; - - if ($iFrame) { - #2nd and following stack frame - my $sVia="${sIndent}${sReach}via file $f, line $l"; - my $sLine="$sVia in $s"; - $sMsg .= (length($sLine)>$LINE_LENGTH - ? "\n$sVia\n$sIndent${sTab}in $s" : "\n$sLine"); - } else { - # first stack frame - my $tid=$e->getTid(); - my $sAt="${sIndent}${sThrow}at file $f, line $l"; - my $sLine="$sAt in $s"; - $sMsg .= (length($sLine)>$LINE_LENGTH - ? "\n$sAt\n$sIndent${sTab}in $s" : "\n$sLine") - . ", pid=" . $e->getPid() . (defined($tid)?", tid=$tid":''); - - return "$sMsg\n" if $STRINGIFY == 1; - } - - if ($STRINGIFY > 3) { - my $bTop = ($iFrame+1) == $iTop; - my $sVar= ($bTop && !$iDepth) ? '@ARGV' : '@_'; - my $bMaybeEatenByGetOpt = $bTop && !scalar(@$aArgs) - && exists($INC{'Getopt/Long.pm'}); - - my $sVarIndent = "\n${sIndent}" . (' ' x $TAB); - my $sArgPrefix = "${sVarIndent}".(' ' x length($sVar)).' '; - if ($bMaybeEatenByGetOpt) { - $sMsg .= $sArgPrefix . $sVar - . '() # maybe eaten by Getopt::Long?'; - } else { - my $sArgs = join($sArgPrefix.',', @$aArgs); - $sMsg .= "${sVarIndent}$sVar=($sArgs"; - $sMsg .= $sArgs ? "$sArgPrefix)" : ')'; - } - } - } - $sMsg.="\n"; - return $sMsg if $STRINGIFY == 2; - - my $eChained = $e->getChained(); - if (defined($eChained)) { - my $sTrigger = isException($eChained) - ? _dumpMessage($eChained, $iDepth+1) - : "\n${sIndent}$eChained\n"; - $sMsg .= "\n${sIndent}Triggered by...$sTrigger"; - } - return $sMsg; -} - -#------------------------------------------------------------------ - -# refaddr has a prototype($) so we can't use it directly as an -# overload operator: it complains about being passed 3 parameters -# instead of 1. -sub _refaddr { Scalar::Util::refaddr($_[0]) }; - -#------------------------------------------------------------------ - -sub _rethrow { - my $self = shift; my $sAddOrOmit = shift; - my ($p,$f,$l)=caller(1); - $self->PROPAGATE($f,$l); - - if (@_%2) { - warn sprintf('bad parameter list to %s->rethrow(...)' - .'at file %d, line %d: odd number of elements in property-value ' - .'list, property value has no property name and will be ' - ."discarded (common causes: you have %s string)\n" - ,$f, $l, $sAddOrOmit); - shift @_; - } - $self->replaceProperties({@_}) if (@_); - return $self; -} - -#------------------------------------------------------------------ -# Traps warnings and reworks them so that they tell the user how -# to fix the problem rather than obscurely complain about an -# invisible sprintf with uninitialized values that seem to come from -# no where (and make Exception::Lite look like it is broken) - -sub _sprintf { - my $sMsg; - my $sWarn; - - { - local $SIG{__WARN__} = sub { $sWarn=$_[0] if !defined($sWarn) }; - - # sprintf has prototype ($@) - my $sFormat = shift; - $sMsg = sprintf($sFormat, @_); - } - - if (defined($sWarn)) { - my $sReason=''; - my ($f, $l, $s) = (caller(1))[1,2,3]; - $s =~ s/::(\w+)\z/->$1/; - $sWarn =~ s/sprintf/$s/; - $sWarn =~ s/\s+at\s+[\w\/\.]+\s+line\s+\d+\.\s+\z//; - if ($sWarn - =~ m{^Use of uninitialized value in|^Missing argument}) { - my $p=$s; $p =~ s/->\w+\z//; - $sReason ="\n Most likely cause: " - . "Either you are missing property-value pairs needed to" - . "build the message or your exception class's format" - . "definition mistakenly has too many placeholders " - . "(e.g. %s,%d,etc)\n"; - } - warn "$sWarn called at file $f, line $l$sReason\n"; - } - return $sMsg; -} - -#------------------------------------------------------------------ - -sub _shiftProperties { - my $cl= shift; my $st=shift; my $sAddOrOmit = shift; - if (@_%2) { - $"='|'; - warn sprintf('bad parameter list to %s->new(...) at ' - .'file %s, line %d: odd number of elements in property-value ' - .'list, property value has no property name and will be ' - .'discarded (common causes: you have %s string -or- you are ' - ."using a string as a chained exception)\n" - ,$cl,$st->[0]->[0],$st->[0]->[1], $sAddOrOmit); - shift @_; - } - return {@_}; -} - -#================================================================== -# MODULE INITIALIZATION -#================================================================== - -declareExceptionClass(__PACKAGE__ .'::Any'); -1; diff --git a/modules/fallback/Exception/Lite.pod b/modules/fallback/Exception/Lite.pod deleted file mode 100644 index cea165f46..000000000 --- a/modules/fallback/Exception/Lite.pod +++ /dev/null @@ -1,2314 +0,0 @@ -=head1 NAME - -Exception::Lite - light weight exception handling class with smart -stack tracing, chaining, and localization support. - -=head1 SYNOPSIS - - # -------------------------------------------------------- - # making this module available to your code - # -------------------------------------------------------- - - #Note: there are NO automatic exports - - use Exception::Lite qw(declareExceptionClass - isException - isChainable - onDie - onWarn); - - # imports only: declareExceptionClass isException isChainable - use Exception::Lite qw(:common); - - # imports all exportable methods listed above - use Exception::Lite qw(:all); - - - # -------------------------------------------------------- - # declare an exception class - # -------------------------------------------------------- - - # no format rule - declareExceptionClass($sClass); - declareExceptionClass($sClass, $sSuperClass); - - # with format rule - declareExceptionClass($sClass, $aFormatRule); - declareExceptionClass($sClass, $sSuperClass, $aFormatRule); - - # with customized subclass - declareExceptionClass($sClass, $sSuperClass, 1); - declareExceptionClass($sClass, $aFormatRule, 1); - declareExceptionClass($sClass, $sSuperClass, $aFormatRule, 1); - - # -------------------------------------------------------- - # throw an exception - # -------------------------------------------------------- - - die $sClass->new($sMsg, $prop1 => $val1, ...); #no format rule - die $sClass->new($prop1 => $val1, ...); #has format rule - - #-or- - - $e = $sClass->new($sMsg, $prop1 => $val1, ...); #no format rule - $e = $sClass->new($prop1 => $val1, ...); #has format rule - - die $e; - - # -------------------------------------------------------- - # catch and test an exception - # -------------------------------------------------------- - - # Note: for an explanation of why we don't use if ($@)... here, - # see Catching and Rethrowing exceptions below - - eval { - .... some code that may die here ... - return 1; - } or do { - my $e=$@; - - if (isException($e, 'Class1')) { - ... do something ... - } elsif (isExcption($e, 'Class2')) { - ... do something else ... - } - }; - - isException($e); # does $e have the above exception methods? - isException($e,$sClass) # does $e belong to $sClass or a subclass? - - # -------------------------------------------------------- - # getting information about an exception object - # -------------------------------------------------------- - - $e->getMessage(); - $e->getProperty($sName); - $e->isProperty($sName); - $e->replaceProperties($hOverride); - - $e->getPid(); - $e->getPackage(); - $e->getTid(); - - $e->getStackTrace(); - $e->getFrameCount(); - $e->getFile($i); - $e->getLine($i); - $e->getSubroutine($i); - $e->getArgs($i); - - $e->getPropagation(); - $e->getChained(); - - - # -------------------------------------------------------- - # rethrowing exceptions - # -------------------------------------------------------- - - # using original properties and message - - $@=$e; die; # pure Perl way (reset $@ in case wiped out) - - die $e->rethrow(); # same thing, but a little less cryptic - - - # overriding original message/properties - - die $e->rethrow(path=>$altpath, user=>$nameReplacingId); - - - # -------------------------------------------------------- - # creation of chained exceptions (one triggered by another) - # (new exception with "memory" of what caused it and stack - # trace from point of cause to point of capture) - # -------------------------------------------------------- - - isChainable($e); # can $e be used as a chained exception? - - die $sClass->new($e, $sMsg, $prop1 => $val1, ...);#no format rule - die $sClass->new($e, $prop1 => $val1, ...); #has format rule - - # -------------------------------------------------------- - # print out full message from an exception - # -------------------------------------------------------- - - print $e # print works - warn $e # warn works - print "$e\n"; # double quotes work - my $sMsg=$e."\n"; print $sMsg; # . operator works - - - # -------------------------------------------------------- - # global control variables (maybe set on the command line) - # -------------------------------------------------------- - - $Exception::Lite::STRINGIFY #set rule for stringifying messages - - = 1; # message and file/line where it occured - = 2; # 1 + what called what (simplified stack trace) - = 3; # 2 + plus any chained exceptions and where message - # was caught, if propagated and rethrown - = 4; # 3 + arguments given to each call in stack trace - = coderef # custom formatting routine - - $Exception::Lite::TAB # set indentation for stringified - # messages, particularly indentation for - # call parameters and chained exceptions - - $Exception::Lite::FILTER - = 0 # see stack exactly as Perl does - = 1 # remove frames added by eval blocks - = coderef # custom filter - see getStackTrace for details - - # -------------------------------------------------------- - # controlling the stack trace from the command line - # -------------------------------------------------------- - - perl -mException::Lite=STRINGIFY=1,FILTER=0,TAB=4 - perl -m'Exception::Lite qw(STRINGIFY=1 FILTER=0 TAB=4)' - - # -------------------------------------------------------- - # built in exception classes - # -------------------------------------------------------- - - # generic wrapper for converting exception strings and other - # non-Exception::Lite exceptions into exception objects - - Exception::Class::Any->new($sMessageText); - -To assist in debugging and testing, this package also includes -two methods that set handlers for die and warn. These methods -should I be used temporarily during active debugging. They -should not be used in production software, least they interfere -with the way other programmers using your module wish to do their -debugging and testing. - - # -------------------------------------------------------- - # force all exceptions/warnings to use Exception::Lite to - # print out messages and stack traces - # -------------------------------------------------------- - - # $stringify is the value for EXCEPTION::Lite::STRINGIFY - # that you want to use locally to print out messages. It - # will have no effect outside of the die handler - - Exception::Lite::onDie($stringify); - Exception::Lite::onWarn($stringify); - -=head1 DESCRIPTION - -The C class provides an easy and very light weight -way to generate context aware exceptions. It was developed because -the exception modules on CPAN as of December,2010 were heavy on -features I didn't care for and did not have the features I most -needed to test and debug code efficiently. - -=head2 Features - -This module provides a light weight but powerful exception class -that - -=over - -=item * - -provides an uncluttered stack trace that clearly shows what -called what and what exception triggered what other exception. -It significantly improves on the readability of the stack trace -dumps provided by C and other exception modules on -CPAN (as of 12/2010). For further discussion and a sample, see -L. - -=item * - -gives the user full control over the amount of debugging -information displayed when exceptions are thrown. - -=item * - -permits global changes to the amount of debugging information -displayed via the command line. - -=item * - -closely integrates exception classes, messages, and properties -so that they never get out of sync with one another. This in -turn eliminates redundant coding and helps reduce the cost of -writing,validating and maintaining a set of exceptions. - -=item * - -is easy to retrofit with native language support, even if this -need appears late in the development process.This makes it -suitable for use with agile development strategies. - -=item * - -act like strings in string context but are in fact objects with -a class hierarchy and properties.They can be thrown and rethrown -with standard Perl syntax. Like any object, they can be uniquely -identified in numeric context where they equal their reference -address (the value returned by C. - -=item * - -does not interfere with signal handlers or the normal Perl syntax -and the assumptions of Perl operators. - -=item * - -can be easily extended and subclassed - -=back - -=head2 Lightweight how? - -Despite these features C maintains its "lite" -status by - -=over - -=item * - -using only core modules - -=item * - -generating tiny exception classes (30-45LOC per class). - -=item * - -eliminating excess baggage by customizing generated classes to - reflect the actual needs of exception message generation. For - instance an exception wrapped around a fixed string message would - omit code for message/property integration and would be little - more than a string tied to a stack trace and property hash. - -=item * - -storing only the minimum amount of stack trace data needed to - generate exception messages and avoiding holding onto references - from dead stack frames. (Note: some CPAN modules hold onto - actual variables from each frame, possibly interfering with - garbage collection). - -=item * - -doing all its work, including class generation and utilities in - a single file that is less than half the size of the next smallest - similarly featured all-core exception class on CPAN (support for - both properties and a class heirarchy). C - contains about 400 lines when developer comments are excluded). The - next smallest all core module is L - which clocks in at just over 1000 lines after pod and developer - comments are excluded). - -=item * - -avoiding a heavy-weight base class. Code shared by - C classes are stored in function calls that total - 230 or so lines of code relying on nothing but core modules. This - is significantly less code than is needed by the two CPAN packages - with comparable features. The all core - L class contains 700+ lines of - code. The base class of L has - 200 lines of its own but drags in two rather large non-core - modules as dependencies: L - L. - -=back - -C has more features (chaining, message/property -integration) but less code due to the following factors: - -=over - -=item * - -working with Perl syntax rather than trying to replace it. - -=item * - -using a light approach to OOP - exception classes have just enough -and no more OO features than are needed to be categorized by a -class, participate in a class heirarchy and to have properties. - -=item * - -respecting separation of concerns. C focuses -on the core responsibility of an exception and leaves the bulk of -syntax creation (e.g. Try/Catch) to specialist modules like -L. Other modules try to double as -comprehensive providers of exception related syntactic sugar. - -=item * - -not trying to be the only kind of exception that an application -uses. - -=back - -=head1 USAGE - -=head2 Defining Exception Classes - -C provides two different ways to define messages. -The first way, without a format rule, lets you compose a freeform -message for each exception. The second way, with a format rule, -lets you closely integrate messages and properties and facilitates -localization of messages for any packages using your software. - -=head3 Defining freeform messages - -If you want to compose a free form message for each and every -exception, the class declaration is very simple: - - declareExceptionClass($sClass); - declareExceptionClass($sClass, $sSuperClass); - - # with customized subclass - declareExceptionClass($sClass, $sSuperClass, 1); - -C<$sClass> is the name of the exception class. - -C<$sSuperClass> is the name of the superclass, if there is one. -The superclass can be any class created by C. It -can also be any role class, i.e. a class that has methods but no -object data of its own. - -The downside of this simple exception class is that there is -absolutely no integration of your messages and any properties that -you assign to the exception. If you would like to see your property -values included in the message string,consider using a formatted -message instead. - -=head3 Defining formatted messages - -If you wish to include property values in your messages, you need -to declare a formatted message class. To do this, you define a -format rule and pass it to the constructor: - - $aFormatRule = ['Cannot copy %s to %s', qw(from to) ]; - - declareExceptionClass($sClass, $aFormatRule); - declareExceptionClass($sClass, $sSuperClass, $aFormatRule); - - # with customized subclass - declareExceptionClass($sClass, $aFormatRule, 1); - declareExceptionClass($sClass, $sSuperClass, $aFormatRule, 1); - -Format rules are nothing more than a sprintf message string -followed by a list of properties in the same order as the -placeholders in the message string. Later on when an exception -is generated, the values of the properties will replace the -property names. Some more examples of format rules: - - - $aFormatRule = ['Illegal argument <%s>: %s', qw(arg reason)]; - declareExceptionClass('BadArg', $aFormatRule); - - $aFormatRule = ['Cannot open file <%s>> %s', qw(file reason)]; - declareExceptionClass('OpenFailed', $aFormatRule); - - $sFormatRule = ['Too few %s, must be at least %s', qw(item min)]; - declareExceptionClass('TooFewWidgets', $aFormatRule); - - -Later on when you throw an exception you can forget about the message -and set the properties, the class will do the rest of the work: - - die BadArg->new(arg=>$sPassword, reason=>'Too few characters'); - - - open(my $fh, '>', $sFile) - or die OpenFailed->new(file=>$sFile, reason=>$!); - -And still later when you catch the exception, you have two kinds -of information for the price of one: - - # if you catch BadArg - - $e->getProperty('arg') # mine - $e->getProperty('reason') # too few characters - $e->getMessage() # Illegal argument : too few characters - - - # if you catch OpenFailed - - $e->getProperty('file') # foo.txt - $e->getProperty('reason') # path not found - $e->getMessage() # Cannot open : path not found - - -=head2 Creating and throwing exceptions - -When it comes times to create an exception, you create and -throw it like this (C<$sClass> is a placeholder for the name of -your exception class); - - - die $sClass->new($sMsg, prop1 => $val1, ...); #no format rule - die $sClass->new(prop1 => $val1, ...); #has format rule - - #-or- - - $e = $sClass->new($sMsg, prop1 => $val1, ...); #no format rule - $e = $sClass->new(prop1 => $val1, ...); #has format rule - - die $e; - - -For example: - - # Freeform exceptions (caller composes message, has message - # parameter ($sMsg) before the list of properties) - - close $fh or die UnexpectedException - ->new("Couldn't close file handle (huh?): $!"); - - die PropertySettingError("Couldn't set property" - , prop=>foo, value=>bar); - - # Formatted exceptions (no $sMsg parameter) - - if (length($sPassword) < 8) { - die BadArg->new(arg=>$sPassword, reason=>'Too few characters'); - } - - open(my $fh, '>', $sFile) - or die OpenFailed->new(file=>$sFile, reason=>$!); - -In the above examples the order of the properties does not matter. -C is using the property names, not the order of -the properties to find the right value to plug into the message -format string. - -=head2 Catching and testing exceptions - -In Perl there are two basic ways to work with exceptions: - -* native Perl syntax - -* Java like syntax (requires non-core modules) - -=head3 Catching exceptions the Java way - -Java uses the following idiom to catch exceptions: - - try { - .... some code here ... - } catch (SomeExceptionClass e) { - ... error handling code here ... - } catch (SomeOtherExceptionClass e) { - ... error handling code here ... - } finally { - ... cleanup code here ... - } - -There are several CPAN modules that provide some sort of syntactic -sugar so that you can emulate java syntax. The one recommended -for C users is L. -L is an elegant class that concerns itself -only with making it possible to use java-like syntax. It can be -used with any sort of exception. - -Some of the other CPAN modules that provide java syntax also -require that you use their exception classes because the java like -syntax is part of the class definition rather than a pure -manipulation of Perl syntax. - - -=head3 Catching exceptions the Perl way - -The most reliable and fastest way to catch an exception is to use -C< eval/do >: - - eval { - ... - return 1; - } or do { - # save $@ before using it - it can easily be clobbered - my $e=$@; - - ... do something with the exception ... - - warn $e; #use $e as a string - warn $e->getMessage(); # use $e as an object - } - - -The C block ends with C to insure that successful -completion of the eval block never results in an undefined value. -In certain cases C is a valid return value for a statement, -We don't want to enter the C block for any reason other than -a thrown exception. - -C< eval/do > is both faster and more reliable than the C< eval/if> -which is commonly promoted in Perl programming tutorials: - - # eval ... if - - eval {...}; - if ($@) {....} - -It is faster because the C block is executed if and only -if the eval fails. By contrast the C must be evaluated both -in cases of succes and failure. - -C< eval/do > is more reliable because the C block is guaranteed -to be triggered by any die, even one that accidentally throws undef -or '' as the "exception". If an exception is thrown within the C -block, it will always evaluate to C therefore triggering the -C block. - -On the other hand we can't guarentee that C<$@> will be defined -even if an exception is thrown. If C<$@> is C<0>, C, or an -empty string, the C block will never be entered. This happens -more often then many programmers realize. When eval exits the -C< eval > block, it calls destructors of any C variables. If -any of those has an C< eval > statement, then the value of C<$@> is -wiped clean or reset to the exception generated by the destructor. - -Within the C block, it is a good idea to save C<$@> immediately -into a variable before doing any additional work. Any subroutine -you call might also clobber it. Even built-in commands that don't -normally set C<$@> can because Perl lets a programmer override -built-ins with user defined routines and those user define routines -might set C<$@> even if the built-in does not. - -=head3 Testing exceptions - -Often when we catch an exception we want to ignore some, rethrow -others, and in still other cases, fix the problem. Thus we need a -way to tell what kind of exception we've caught. C -provides the C method for this purpose. It can be -passed any exception, including scalar exceptions: - - # true if this exception was generated by Exception::Line - isException($e); - - - # true if this exception belongs to $sClass. It may be a member - # of the class or a subclass. C<$sClass> may be any class, not - # just an Exception::Lite generated class. You can even use this - # method to test for string (scalar) exceptions: - - isException($e,$sClass); - - isException($e,'Excption::Class'); - isException($e, 'BadArg'); - isException($e, ''); - -And here is an example in action. It converts an exception to a -warning and determines how to do it by checing the class. - - - eval { - ... - return 1; - } or do { - my $e=$@; - if (Exception::Lite::isException($e)) { - - # get message w/o stack trace, "$e" would produce trace - warn $e->getMessage(); - - } elsif (Exception::Lite::isException('Exception::Class') { - - # get message w/o stack trace, "$e" would produce trace - warn $e->message(); - - } elsif (Exception::Lite::isException($e,'')) { - - warn $e; - } - } - -=head2 Rethrowing exceptions - -Perl doesn't have a C statement. To reliably rethrow an -exception, you must set C<$@> to the original exception (in case it -has been clobbered during the error handling process) and then call -C without any arguments. - - eval { - ... - return 1; - } or do { - my $e=$@; - - # do some stuff - - # rethrow $e - $@=$e; die; - } - -The above code will cause the exception's C method to -record the file and line number where the exception is rethrown. -See C, C, and C in the class -reference below for more information. - -As this Perl syntax is not exactly screaming "I'm a rethrow", -C provides an alternative and hopefully more -intuitive way of propagating an exception. There is no magic here, -it just does what perl would do had you used the normal syntax, -i.e. call the exception's C method. - - eval { - ... - return 1; - } or do { - my $e=$@; - - # rethrow $e - die $e->rethrow(); - } - -=head2 Chaining Messages - -As an exception moves up the stack, its meaning may change. For -example, suppose a subroutine throws the message "File not open". -The immediate caller might be able to use that to try and open -a different file. On the other hand, if the message gets thrown -up the stack, the fact that a file failed to open might not -have any meaning at all. That higher level code only cares that -the data it needed wasn't available. When it notifies the user, -it isn't going to say "File not found", but "Can't run market -report: missing data feed.". - -When the meaning of the exception changes, it is normal to throw -a new exception with a class and message that captures the new -meaning. However, if this is all we do, we lose the original -source of the problem. - -Enter chaining. Chaining is the process of making one exception -"know" what other exception caused it. You can create a new -exception without losing track of the original source of the -problem. - -To chain exceptions is simple: just create a new exception and -pass the caught exception as the first parameter to C. So -long as the exception is a non-scalar, it will be interpreted -as a chained exception and not a property name or message text -(the normal first parameter of C). - -Chaining is efficient, especially if the chained exception is -another C exception. It does not replicate -the stack trace. Rather the original stack trace is shorted to -include only the those fromes frome the time it was created to -the time it was chained. - -Any non-scalar exception can be chained. To test whether or not -a caught exception is chainable, you can use the method -C. This method is really nothing more than -a check to see if the exception is a non-scalar, but it helps -to make your code more self documenting if you use that method -rather than C. - -If an exception isn't chainable, and you still want to chain -it, you can wrap the exception in an exception class. You -can use the built-in C or any class of -your own choosing. - - #----------------------------------------------------- - # define some classes - #----------------------------------------------------- - - # no format rule - declareExceptionClass('HouseholdDisaster'); - - # format rule - declareExceptionClass('ProjectDelay' - , ['The project was delayed % days', qw(days)]); - - #----------------------------------------------------- - # chain some exceptins - #----------------------------------------------------- - - eval { - .... some code here ... - return 1; - } or do { - my $e=$@; - if (Exception::Lite::isChainable($e)) { - if (Exception::Lite::isException($e, 'FooErr') { - die 'SomeNoFormatException'->new($e, "Caught a foo"); - } else { - die 'SomeFormattedException'->new($e, when => 'today'); - } - } elsif ($e =~ /fire/) { - die 'Exception::Lite::Any'->new($e); - die 'SomeFormattedException'->new($e, when => 'today'); - } else { - # rethrow it since we can't chain it - $@=$e; die; - } - } - -=head2 Reading Stack Traces - -At its fullest level of detail, a stack trace looks something -like this: - - Exception! Mayhem! and then ... - - thrown at file Exception/Lite.t, line 307 - in main::weKnowBetterThanYou, pid=24986, tid=1 - @_=('ARRAY(0x83a8a90)' - ,'rot, rot, rot' - ,'Wikerson brothers' - ,'triculous tripe' - ,'There will be no more talking to hoos who are not!' - ,'black bottom birdie' - ,'from the three billionth flower' - ,'Mrs Tucanella returns with uncles and cousins' - ,'sound off! sound off! come make yourself known!' - ,'Apartment 12J' - ,'Jo Jo the young lad' - ,'the whole world was saved by the smallest of all' - ) - reached via file Exception/Lite.t, line 281 - in main::notAWhatButAWho - @_=() - reached via file Exception/Lite.t, line 334 in main::__ANON__ - @_=() - reached via file Exception/Lite.t, line 335 in - @ARGV=() - - Triggered by... - Exception! Horton hears a hoo! - rethrown at file Exception/Lite.t, line 315 - - thrown at file Exception/Lite.t, line 316 - in main::horton, pid=24986, tid=1 - @_=('15th of May' - ,'Jungle of Nool' - ,'a small speck of dust on a small clover' - ,'a person's a person no matter how small' - ) - reached via file Exception/Lite.t, line 310 in main::hoo - @_=('Dr Hoovey' - ,'hoo-hoo scope' - ,'Mrs Tucanella' - ,'Uncle Nate' - ) - reached via file Exception/Lite.t, line 303 - in main::weKnowBetterThanYou - @_=('ARRAY(0x83a8a90)' - ,'rot, rot, rot' - ,'Wikerson brothers' - ,'triculous tripe' - ,'There will be no more talking to hoos who are not!' - ,'black bottom birdie' - ,'from the three billionth flower' - ,'Mrs Tucanella returns with uncles and cousins' - ,'sound off! sound off! come make yourself known!' - ,'Apartment 12J' - ,'Jo Jo the young lad' - ,'the whole world was saved by the smallest of all' - ) - - -=over - -=item * - -lines begining with "thrown" indicate a line where a new exception -was thrown. If an exception was chained, there might be multiple -such lines. - -=item * - -lines beginning with "reached via" indicate the path travelled -I to the point where the exception was thrown. This is the -code that was excuted before the exception was triggered. - -=item * - -lines beginning with "rethrown at" indicate the path travelled -I the stack by the exception I it was geenerated. Each -line indicates a place where the exception was caught and rethrown. - -=item * - -lines introduced with "Triggered by" are exceptions that were -chained together. The original exception is the last of the -triggered exceptions. The original line is the "thrown" line -for the original exception. - -=item * - -C<@_> and below a line indicates what is left of the -parameters passed to a method, function or entry point routine. -In ideal circumstances they are the parameters passed to the -subroutine mentioned in the line immediately above C<@_>. In -reality, they can be overwritten or shifted away between the -point when the subroutine started and the line was reached. - -Note: if you use L to process C<@ARGV>, C<@ARGV> -will be empty reduced to an empty array. If this bothers you, you -can localize <@ARGV> before calling C, like this: - - my %hARGV; - { - local @ARGV = @ARGV; - GetOptions(\%hARGV,...); - } - -=item * - -pid is the process id where the code was running - -=item * - -tid is the thread id where the code was running - -=back - -=head1 SPECIAL TOPICS - -=head2 Localization of error messages - -Rather than treat the error message and properties as entirely -separate entities, it gives you the option to define a format string -that will take your property values and insert them automatically -into your message. Thus when you generate an exception, you can -specify only the properties and have your message automatically -generated without any need to repeat the property values in messy -C's that clutter up your program. - -One can localize from the very beginning when one declares the -class or later on after the fact if you are dealing with legacy -software or developing on an agile module and only implementing -what you need now. - -To localize from the get-go: - - # myLookupSub returns the arguments to declareException - # e.g. ('CopyError', [ 'On ne peut pas copier de %s a %s' - , qw(from to)]) - - declareExceptionClass( myLookupSub('CopyError', $ENV{LANG}) ); - - - # .... later on, exception generation code doesn't need to - # know or care about the language. it just sets the properties - - - # error message depends on locale: - # en_US: 'Cannot copy A.txt to B.txt' - # fr_FR: 'On ne peut pas copier de A.txt a B.txt' - # de_DE: 'Kann nicht kopieren von A.txt nach B.txt' - - die 'CopyError'->new(from => 'A.txt', to => 'B.txt'); - - -Another alternative if you wish to localize from the get-go is -to pass a code reference instead of a format rule array. In this -case, C will automatically pass the class name -to the subroutine and retrieve the value returned. - - - # anothherLookupSub has parameters ($sClass) and returns - # a format array, for example: - # - # %LOCALE_FORMAT_HASH = ( - # CopyError => { - # en_US => ['Cannot copy %s to %s', qw(from to)] - # ,fr_FR => ['On ne peut pas copier de %s a %s', qw(from to)] - # ,de_DE => ['Kann nicht kopieren von %s nach %s'' - # , qw(from to)] - # - # AddError => ... - # ); - # - # sub anotherLookupSub { - # my ($sClass) = @_; - # my $sLocale = $ENV{LANG} - # return $LOCALE_FORMAT_HASH{$sClass}{$sLocale}; - # } - # - - declareExceptionClass('CopyError', &anotherLookupSub); - declareExceptionClass('AddError', &anotherLookupSub); - - - # error message depends on locale: - # en_US: 'Cannot copy A.txt to B.txt' - # fr_FR: 'On ne peut pas copier de A.txt a B.txt' - # de_DE: 'Kann nicht kopieren von A.txt nach B.txt' - - die CopyError->new(from => 'A.txt', to => 'B.txt'); - die AddError->new(path => 'C.txt'); - - -If you need to put in localization after the fact, perhaps for a -new user interface you are developing, the design pattern might -look like this: - - # in the code module you are retrofitting would be an exception - # that lived in a single language world. - - declareExceptionClass('CopyError' - ['Cannot copy %s to %s', [qw(from to)]); - - - # in your user interface application. - - if (isException($e, 'CopyError') && isLocale('fr_FR')) { - my $sFrom = $e->getProperty('from'); - my $sTo = $e->getProperty('to'); - warn sprintf('On ne peut pas copier de %s a %s', $sFrom,$sTo); - } - -=head2 Controlling verbosity and stack tracing - -You don't need to print out the fully verbose stack trace and in -fact, by default you won't. The default setting, prints out -only what called what. To make it easier to see what called what, -it leaves out all of the dumps of C<@_> and C<@ARGV>. - -If you want more or less verbosity or even an entirely different -trace, C is at your sevice. It provides a variety -of options for controlling the output of the exception: - -* Adjusting the level of debugging information when an exception is - thrown by setting C<$Exception::Lite::STRINGIFY> - in the program or C<-mException::Lite=STRINGIFY=level> on the - command line. This can be set to either a verbosity level or to - an exception stringification routine of your own choosing. - -* Control which stack frames are displayed by setting - C<$Exception::Lite::FILTER>. By default, only calls within named - and anonymous subroutines are displayed in the stack trace. Perl - sometimes creates frames for blocks of code within a subroutine. - These are omitted by default. If you want to see them, you can - turn filterin off. Alternatively you can set up an entirely - custon stack filtering rule by assigning a code reference to - C<$Exception::Lite::FILTER>. - -* By default, exceptions store and print a subset of the data - available for each stack frame. If you would like to display - richer per-frame information, you can do that too. See below - for details. - -=head3 Verbosity level - -The built-in rules for displaying exceptions as strings offer five -levels of detail. - -* 0: Just the error message - -* 1: the error message and the file/line number where it occured - along with pid and tid. - -* 2: the error message and the calling sequence from the point where - the exception was generated to the package or script entry point - The calling sequence shows only file, line number and the name - of the subroutine where the exception was generated. It is not - cluttered with parameters, making it easy to scan. - -* 3: similar to 2, except that propagation and chained exceptions - are also displayed. - -* 4: same as 3, except that the state of C<@_> or C<@ARGV> at the - time the exception was thrown is also displayed. usually this - is the parameters that were passed in, but it may include several - leading C if C was used to process the parameter - list. - -Here are some samples illustrating different level of debugging -information and what happens when the filter is turned off - - #--------------------------------------------------- - #Sample exception STRINGIFY=0 running on thread 5 - #--------------------------------------------------- - - Exception! Mayhem! and then ... - - #--------------------------------------------------- - #Sample exception STRINGIFY=1 running on thread 5 - #--------------------------------------------------- - - Exception! Mayhem! and then ... - at file Exception/Lite.t, line 307 in main::weKnowBetterThanYou, pid=24986, tid=5 - - #--------------------------------------------------- - #Sample exception STRINGIFY=2 running on thread 4 - #--------------------------------------------------- - - Exception! Mayhem! and then ... - at file Exception/Lite.t, line 307 in main::weKnowBetterThanYou, pid=24986, tid=4 - via file Exception/Lite.t, line 281 in main::notAWhatButAWho - via file Exception/Lite.t, line 373 in main::__ANON__ - via file Exception/Lite.t, line 374 in - - #--------------------------------------------------- - #Sample exception STRINGIFY=3 running on thread 3 - #--------------------------------------------------- - - Exception! Mayhem! and then ... - - thrown at file Exception/Lite.t, line 307 in main::weKnowBetterThanYou, pid=24986, tid=3 - reached via file Exception/Lite.t, line 281 in main::notAWhatButAWho - reached via file Exception/Lite.t, line 362 in main::__ANON__ - reached via file Exception/Lite.t, line 363 in - - Triggered by... - Exception! Horton hears a hoo! - rethrown at file Exception/Lite.t, line 315 - - thrown at file Exception/Lite.t, line 316 in main::horton, pid=24986, tid=3 - reached via file Exception/Lite.t, line 310 in main::hoo - reached via file Exception/Lite.t, line 303 in main::weKnowBetterThanYou - - #--------------------------------------------------- - #Sample exception STRINGIFY=3 running on thread 2 - #FILTER=OFF (see hidden eval frames) - #--------------------------------------------------- - - Exception! Mayhem! and then ... - - thrown at file Exception/Lite.t, line 307 in main::weKnowBetterThanYou, pid=24986, tid=2 - reached via file Exception/Lite.t, line 281 in main::notAWhatButAWho - reached via file Exception/Lite.t, line 348 in (eval) - reached via file Exception/Lite.t, line 348 in main::__ANON__ - reached via file Exception/Lite.t, line 350 in (eval) - reached via file Exception/Lite.t, line 350 in - - Triggered by... - Exception! Horton hears a hoo! - rethrown at file Exception/Lite.t, line 315 - - thrown at file Exception/Lite.t, line 316 in main::horton, pid=24986, tid=2 - reached via file Exception/Lite.t, line 310 in (eval) - reached via file Exception/Lite.t, line 315 in main::hoo - reached via file Exception/Lite.t, line 303 in (eval) - reached via file Exception/Lite.t, line 305 in main::weKnowBetterThanYou - - #--------------------------------------------------- - #Sample exception STRINGIFY=4 running on thread 1 - #FILTER=ON - #--------------------------------------------------- - - Exception! Mayhem! and then ... - - thrown at file Exception/Lite.t, line 307 in main::weKnowBetterThanYou, pid=24986, tid=1 - @_=('ARRAY(0x83a8a90)' - ,'rot, rot, rot' - ,'Wikerson brothers' - ,'triculous tripe' - ,'There will be no more talking to hoos who are not!' - ,'black bottom birdie' - ,'from the three billionth flower' - ,'Mrs Tucanella returns with Wikerson uncles and cousins' - ,'sound off! sound off! come make yourself known!' - ,'Apartment 12J' - ,'Jo Jo the young lad' - ,'the whole world was saved by the tiny Yopp! of the smallest of all' - ) - reached via file Exception/Lite.t, line 281 in main::notAWhatButAWho - @_=() - reached via file Exception/Lite.t, line 334 in main::__ANON__ - @_=() - reached via file Exception/Lite.t, line 335 in - @ARGV=() - - Triggered by... - Exception! Horton hears a hoo! - rethrown at file Exception/Lite.t, line 315 - - thrown at file Exception/Lite.t, line 316 in main::horton, pid=24986, tid=1 - @_=('15th of May' - ,'Jungle of Nool' - ,'a small speck of dust on a small clover' - ,'a person's a person no matter how small' - ) - reached via file Exception/Lite.t, line 310 in main::hoo - @_=('Dr Hoovey' - ,'hoo-hoo scope' - ,'Mrs Tucanella' - ,'Uncle Nate' - ) - reached via file Exception/Lite.t, line 303 in main::weKnowBetterThanYou - @_=('ARRAY(0x83a8a90)' - ,'rot, rot, rot' - ,'Wikerson brothers' - ,'triculous tripe' - ,'There will be no more talking to hoos who are not!' - ,'black bottom birdie' - ,'from the three billionth flower' - ,'Mrs Tucanella returns with Wikerson uncles and cousins' - ,'sound off! sound off! come make yourself known!' - ,'Apartment 12J' - ,'Jo Jo the young lad' - ,'the whole world was saved by the tiny Yopp! of the smallest of all' - ) - - -=head3 Custom stringification subroutines - -The custom stringification subroutine expects one parameter, the -exception to be stringified. It returns the stringified form of -the exception. Here is an example of a fairly silly custom -stringification routine that just prints out the chained messages -without any stack trace: - - $Exception::Lite::STRINGIFY = sub { - my $e=$_[0]; # exception is sole input parameter - my $sMsg=''; - while ($e) { - $sMsg .= $e->getMessage() . "\n"; - $e= $e->getChained(); - } - return $sMsg; # return string repreentation of message - }; - -=head3 Adding information to the stack trace - -By default, each frame of the stack trace contains only the file, -line, containing subroutine, and the state of C<@_> at the time -C<$sFile>,C<$iLine> was reached. - -If your custom subroutine needs more information about the stack -than C normally provides, you can change the -contents of the stack trace by assigning a custom filter routine -to C<$Exception::Lite::FILTER>. - -The arguments to this subroutine are: - - - ($iFrame, $sFile, $iLine $sSub, $aArgs, $iSubFrame, $iLineFrame) - -where - -* C<$sFile> is the file of the current line in that frame - -* C<$iLine> is the line number of current line in that frame - -* C<$sSub> is the name of the subroutine that contains C<$sFile> and - C<$iLine> - -* C<$aArgs> is an array that holds the stringified value of each - member of @_ at the time the line at C<$sFile>, C<$sLine> was - called. Usually, this is the parameters passed into C<$sSub>, - but may not be. - -* C<$iSubFrame> is the stack frame that provided the name of the sub - and the contents of $aArgs. - -* C<$iLineFrame> is the stack frame that provided the file and line - number for the frame. - -Please be aware that each line of the stack trace passed into the -filter subroutine is a composite drawn from two different frames of -the Perl stack trace, C<$iSubFrame> and C<$iLineFrame>. This -composition is necessary because the Perl stack trace contains the -subroutine that was called at C<$sFile>, C<$iLine> rather than the -subroutine that I C<$sFile>,C<$iLine>. - -The subroutine returns 0 or any other false value if the stack frame -should be omitted. It returns to 1 accept the default stack frame as -is. If it accepts the stack frame but wants to insert extra data -in the frame, it returns -C<[$sFile,$iLine,$sSub,$aArgs, $extra1, $extra2, ...]> - -The extra data is always placed at the end after the C<$aArgs> -member. - -=head3 Stack trace filtering - -To avoid noise, by default, intermediate frames that are associated -with a block of code within a subroutine other than an anonymous -sub (e.g. the frame created by C) are -omitted from the stack trace. - -These omissions add to readability for most debugging purposes. -In most cases one just wants to see which subroutine called which -other subroutine. Frames created by eval blocks don't provide -useful information for that purpose and simply clutter up the -debugging output. - -However, there are situations where one either wants more or less -stack trace filtering. Stack filtering can turned on or off or -customized by setting C<$Exception::Lite::FILTER> to any of the -following values: - -Normally the filtering rule is set at the start of the program or -via the command line. It can also be set anywhere in code, with one -caveat: an error handling block. - -=over - -=item 0 - -Turns all filtering off so that you see each and every frame -in the stack trace. - -=item 1 - -Turns on filtering of eval frames only (default) - -=item C<[ regex1, regex2, ... ]> - -A list of regexes. If the fully qualified subroutine name matches -any one of these regular expressions it will be omitted from the -stack trace. - -=item C<$regex> - -A single regular expression. If the fully qualified subroutine name -matches this regular expression, it will be omitted from the stack -trace. - -=item C<$codeReference> - -The address of a named or anonymous routine that returns a boolean -value: true if the frame should be includeed, false if it should be -omitted. For parameters and return value of this subroutine see -L. - - -=back - -If filtering strategies change and an exception is chained, some of -its stack frames might be lost during the chaining process if the -filtering strategy that was in effect when the exception was -generated changes before it is chained to another exception. - - -=head2 Subclassing - -To declare a subclass with custom data and methods, use a three step -process: - -=over - -=item * - -choose an exception superclass. The choice of superclass follows -the rule, "like gives birth to like". Exception superclasses that -have formats must have a superclass that also takes a format. -Exception subclasses that have no format, must use an exception. - -=item * - -call C with its C<$bCustom> parameter set -to 1 - -=item * - -define a C<_new(...)> method (note the leading underscore _) and -subclass specific methods in a block that sets the package to -the subclass package. - -=back - - -When the C<$bCustom> flag is set to true, it might be best to think -of C as something like C or -C except that there is no implicit BEGIN block. Like -both these methods it handles all of the setup details for the -class so that you can focus on defining methods and functionality. - -Wnen C sees the C<$bCustom> flag set to true, it -assumes you plan on customizing the class. It will set up inhertance, -and generate all the usual method definition for an C -class. However, on account of C<$bCustom> being true, it will add a -few extra things so that and your custom code can play nicely -together: - -=over - -=item * - -a special hash reserved for your subclsses data. You can get -access to this hash by calling C<_p_getSubclassData()>. You are -free to add, change, or remove entries in the hash as needed. - -=item * - -at the end of its C method, it calls -C<< $sClass->_new($self) >>. This is why you must define a C<_new()> -method in your subclass package block. The C<_new> method is -responsible for doing additional setup of exception data. Since -this method is called last it can count on all of the normally -expected methods and data having been set up, including the -stack trace and the message generated by the classes format rule -(if there is one). - -=back - -For example, suppose we want to define a subclass that accepts -formats: - - #define a superclass that accepts formats - - declareExceptionClass('AnyError' - , ['Unexpected exception: %s','exception']); - - - # declare Exception subclass - - declareExceptionClass('TimedException', 'AnyError', $aFormatData,1); - { - package TimedException; - - sub _new { - my $self = $_[0]; #exception object created by Exception::Lite - - # do additional setup of properties here - my $timestamp=time(); - my $hMyData = $self->_p_getSubclassData(); - $hMyData->{when} = time(); - } - - sub getWhen { - my $self=$_[0]; - return $self->_p_getSubclassData()->{when}; - } - } - - -Now suppose we wish to extend our custom class further. There is -no difference in the way we do things just because it is a subclass -of a customized C class: - - # extend TimedException further so that it - # - # - adds two additional bits of data - the effective gid and uid - # at the time the exception was thrown - # - overrides getMessage() to include the time, egid, and euid - - declareExceptionClass('SecureException', 'TimedException' - , $aFormatData,1); - { - package TimedException; - - sub _new { - my $self = $_[0]; #exception object created by Exception::Lite - - # do additional setup of properties here - my $timestamp=time(); - my $hMyData = $self->_p_getSubclassData(); - $hMyData->{euid} = $>; - $hMyData->{egid} = $); - } - - sub getEuid { - my $self=$_[0]; - return $self->_p_getSubclassData()->{euid}; - } - sub getEgid { - my $self=$_[0]; - return $self->_p_getSubclassData()->{egid}; - } - sub getMessage { - my $self=$_[0]; - my $sMsg = $self->SUPER::getMessage(); - return sprintf("%s at %s, euid=%s, guid=%s", $sMsg - , $self->getWhen(), $self->getEuid(), $self->getGuid()); - } - } - -=head2 Converting other exceptions into Exception::Lite exceptions - -If you decide that you prefer the stack traces of this package, you -can temporarily force all exceptions to use the C -stack trace, even those not generated by your own code. - -There are two ways to do this: - -* production code: chaining/wrapping - -* active debugging: die/warn handlers - - -=head3 Wrapping and chaining - -The preferred solution for production code is wrapping and/or -chaining the exception. Any non-string exception, even one -of a class not created by C can be chained -to an C exception. - -To chain a string exception, you first need to wrap it in -an exception class. For this purpose you can create a special -purpose class or use the generic exception class provided by -the C module: C. - -If you don't want to chain the exception, you can also just -rethrow the wrapped exception, as is. Some examples: - - #----------------------------------------------------- - # define some classes - #----------------------------------------------------- - - # no format rule - declareExceptionClass('HouseholdRepairNeeded'); - - # format rule - declareExceptionClass('ProjectDelay' - , ['The project was delayed % days', qw(days)]); - - #----------------------------------------------------- - # chain and/or wrap some exceptins - #----------------------------------------------------- - - eval { - .... some code here ... - return 1; - } or do { - - my $e=$@; - if (Exception::Lite::isChainable($e)) { - if ("$e" =~ /project/) { - - # chain formatted message - die 'ProjectDelay'->new($e, days => 3); - - } elsif ("$e" =~ /water pipe exploded/) { - - # chain unformatted message - die 'HouseholdRepairNeeded'->new($e, 'Call the plumber'); - - } - } elsif ($e =~ 'repairman') { #exception is a string - - # wrapping a scalar exception so it has the stack trace - # up to this point, but _no_ chaining - # - # since the exception is a scalar, the constructor - # of a no-format exception class will treat the first - # parameter as a message rather than a chained exception - - die 'HouseholdRepairNeeded'->new($e); - - } else { - - # if we do want to chain a string exception, we need to - # wrap it first in an exception class: - - my $eWrapped = Exception::Lite::Any->new($e); - die 'HouseholdRepairNeeded' - ->new($eWrapped, "Call the repair guy"); - } - } - -=head3 Die/Warn Handlers - -Die/Warn handlers provide a quick and dirty way to at Exception::Lite -style stack traces to all warnings and exceptions. However, -it should ONLY BE USED DURING ACTIVE DEBUGGING. They should never -be used in production code. Setting these handlers -can interfere with the debugging style and techiniques of other -programmers and that is not nice. - -However, so long as you are actiely debugging, setting a die or -warn handler can be quite useful, especially if a third party module -is generating an exception or warning and you have no idea where it -is coming from. - -To set a die handler, you pass your desired stringify level or -code reference to C: - - Exception::Lite::onDie(4); - -This is roughly equivalent to: - - $SIG{__DIE__} = sub { - $Exception::Lite::STRINGIFY=4; - warn 'Exception::Lite::Any'->new('Unexpected death:'.$_[0]) - unless ($^S || Exception::Lite::isException($_[0])); - }; - -To set a warning handler, you pass your desired stringify level or -code reference to C: - - Exception::Lite::onWarn(4); - -This is roughly equivalent to: - - $SIG{__WARN__} = sub { - $Exception::Lite::STRINGIFY=4; - print STDERR 'Exception::Lite::Any'->new("Warning: $_[0]"); - }; - -Typically these handlers are placed at the top of a test script -like this: - - use strict; - use warnings; - use Test::More tests => 25; - - use Exception::Lite; - Exception::Lite::onDie(4); - Exception::Lite::onWarn(3); - - ... actual testing code here ... - - - -=head1 WHY A NEW EXCEPTION CLASS - -Aren't there enough already? Well, no. This class differs from -existing classes in several significant ways beyond "lite"-ness. - -=head2 Simplified integration of properties and messages - -C simplifies the creation of exceptions by -minimizing the amount of metadata that needs to be declared for -each exception and by closely integrating exception properties -and error messages. Though there are many exception modules -that let you define message and properties for exceptions, in -those other modules you have to manually maintain any connection -between the two either in your code or in a custom subclass. - -In L, for example, you have to -do something like this: - - #... at the start of your code ... - # notice how exception definition and message format - # string constant are in two different places and need - # to be manually coordinated by the programmer. - - use Exception::Class { - 'Exception::Copy::Mine' { - fields => [qw(from to)]; - } - # ... lots of other exceptions here ... - } - my $MSG_COPY='Could not copy A.txt to B.txt"; - - ... later on when you throw the exception ... - - # notice the repetition in the use of exception - # properties; the repetition is error prone and adds - # unnecessary extra typing - - my $sMsg = sprintf($MSG_COPY, 'A.txt', 'B.txt'); - Exception::Copy::Mine->throw(error => $sMsg - , from => 'A.txt' - , to => 'B.txt'); - - -C provides a succinct and easy to maintain -method of declaring those same exceptions - - # the declaration puts the message format string and the - # class declaration together for the programmer, thus - # resulting in less maintenence work - - declareExceptionClass("Exception::Mine::Copy" - , ["Could not copy %s to %s", qw(from, to) ]); - - - .... some where else in your code ... - - - # there is no need to explicitly call sprintf or - # repetitively type variable names, nor even remember - # the order of parameters in the format string or check - # for undefined values. Both of these will produce - # the same error message: - # "Could not copy A.txt to B.txt" - - die "Exception::Mine:Copy"->new(from =>'A.txt', to=>'B.txt'); - die "Exception::Mine:Copy"->new(to =>'B.txt', from=>'A.txt'); - - # and this will politely fill in 'undef' for the - # property you leave out: - # "Could not copy A.txt to " - - die "Exception::Mine::Copy"->new(from=>'A.txt'); - - -=head2 More intelligent stack trace - -The vast majority, if not all, of the exception modules on CPAN -essentially reproduce Carp's presentation of the stack trace. They -sometimes provide parameters to control the level of detail, but -make only minimal efforts, if any, to improve on the quality of -debugging information. - -C improves on the traditional Perl stack trace -provided by Carp in a number of ways. - -=over - -=item * - -Error messages are shown in full and never truncated (a problem with - C. - -=item * - -The ability to see a list of what called what without the clutter - of subroutine parameters. - -=item * - -The ability to see the context of a line that fails rather than -a pinhole snapshot of the line itself. Thus one sees -"at file Foo.pm, line 13 in sub doTheFunkyFunk" rather - than the contextless stack trace line displayed by nearly every, - if not all Perl stacktraces, including C: - "called foobar(...) at line 13 in Foo.pm". - When context rather than line snapshots - are provided, it is often enough simply to scan the list of what - called what to see where the error occurred. - -=item * - -Automatic filtering of stack frames that do not show the actual -Flow from call to call. Perl internally creates stack frames for -each eval block. Seeing these in the stack trace make it harder -to scan the stack trace and see what called what. - -=item * - -The automatic filtering can be turned off or, alternatively -customized to include/exclude arbitrary stack frames. - -=item * - -One can chain together exceptions and then print out what exception -triggered what other exception. Sometimes what a low level module -considers important about an exception is not what a higher level -module considers important. When that happens, the programmer can -create a new exception with a more relevant error message that -"remembers" the exception that inspired it. If need be, one can -see the entire history from origin to destination. - -=back - -The "traditional" stack trace smushes together all parameters into -a single long line that is very hard to read. C -provides a much more readable parametr listing: - -=over - -=item * - -They are displayed one per line so that they can be easily read - and distinguished one from another - -=item * - -The string value and the normal object representation is - shown when an object's string conversion is overloaded. That way - there can be no confusion about whether the actual object or a - string was passed in as a parameter. - -=item * - -It doesn't pretend that these are the parameters passed to the - subroutine. It is impossible to recreate the actual values in - the parameter list because the parameter list for any sub is - just C<@_> and that can be modified when a programmer uses shift - to process command line arguments. The most Perl can give (through - its DB module) is the way C<@_> looked at the time the next frame - in the stack was set up. Instead of positioning the parameters - as if they were being passed to the subroutine, they are listed - below the stacktrace line saying "thrown at in line X in - subroutine Y". In reality, the "parameters" are the value of - @_ passed to subroutine Y (or @ARGV if this is the entry point), - or what was left of it when we got to line X. - -=item - -A visual hint that leading Cs in C<@_> or C<@ARGV> may be - the result of shifts rather than a heap of Cs passed into - the subroutine. This lets the programmer focus on the code, not - on remembering the quirks of Perl stack tracing. - -=back - -=head1 CLASS REFERENCE - -=head2 Class factory methods - -=head3 C - - declareExceptionClass($sClass); - declareExceptionClass($sClass, $sSuperclass); - declareExceptionClass($sClass, $sSuperclass, $bCustom); - - declareExceptionClass($sClass, $aFormatRule); - declareExceptionClass($sClass, $sSuperclass, $aFormatRule); - declareExceptionClass($sClass, $sSuperclass, $aFormatRule - , $bCustom); - -Generates a lightweight class definition for an exception class. It -returns the name of the created class, i.e. $sClass. - -=over - -=item C<$sClass> - -The name of the class (package) to be created. Required. - -Any legal Perl package name may be used, so long as it hasn't -already been used to define an exception or any other class. - -=item C<$sSuperclass> - -The name of the superclass of C<$sClass>. Optional. - -If missing or undefed, C<$sClass> will be be a base class -whose only superclass is C, the root class of all Perl -classes. There is no special "Exception::Base" class that all -exceptions have to descend from, unless you want it that way -and choose to define your set of exception classes that way. - -=item C<$aFormatRule> - -An array reference describing how to use properties to construct -a message. Optional. - -If provided, the format rule is essential the same parameters as -used by sprintf with one major exception: instead of using actual -values as arguments, you use property names, like this: - - # insert value of 'from' property in place of first %s - # insert value of 'to' property in place of first %s - - [ 'Cannot copy from %s to %s, 'from', 'to' ] - -When a format rule is provided, C will auto-generate -the message from the properties whenever the properties are set or -changed. Regeneration is a lightweight process that selects property -values from the hash and sends them to C for formatting. - -Later on, when you are creating exceptions, you simply pass in the -property values. They can be listed in any order and extra properties -that do not appear in the message string can also be provided. If -for some reason the value of a property is unknown, you can assign it -C and C will politely insert a placeholder -for the missing value. All of the following are valid: - - - # These all generate "Cannot copy A.txt to B.txt" - - $sClass->new(from => 'A.txt', to => 'B.txt'); - $sClass->new(to => 'B.txt', from => 'A.txt'); - $sClass->new(to => 'B.txt', from => 'A.txt' - , reason => 'source doesn't exist' - , seriousness => 4 - ); - $sClass->new(reason => 'source doesn't exist' - , seriousness => 4 - , to => 'B.txt', from => 'A.txt' - ); - - # These generate "Cannot copy A.txt to " - - $sClass->new(from => 'A.txt'); - $sClass->new(from => 'A.txt', to => 'B.txt'); - -=item C<$bCustom> - -True if the caller intends to add custom methods and/or a custom -constructor to the newly declared class. This will force the -L to generate some extra methods and data so -that the subclass can have its own private data area in the class. -See L for more information. - - -=back - -=head2 Object construction methods - -=head3 C - - # class configured for no generation from properties - - $sClass->new($sMsg); - $sClass->new($sMsg,$prop1 => $val1, ....); - $sClass->new($e); - $sClass->new($e, $sMsg); - $sClass->new($e, $sMsg,$prop1 => $val1, ....); - - # class configured to generate messages from properties - # using a per-class format string - - $sClass->new($prop1 => $val1, ....); - $sClass->new($e, $prop1 => $val1, ....); - - -Creates a new instance of exception class C<$sClass>. The exception -may be independent or chained to the exception that triggered it. - -=over - -=item $e - -The exception that logically triggered this new exception. -May be omitted or left undefined. If defined, the new exception is -considered chained to C<$e>. - -=item $sMsg - -The message text, for classes with no autogeneration from properties, -that is, classes declared like - - declareExceptionClass($sClass); - declareExceptionClass($sClass, $sSuperclass); - -In the constructor, C< $sClass->new($e) >>, the message defaults to -the message of C<$e>. Otherwise the message is required for any -class that id declared in the above two ways. - -=item $prop1 => $val1 - -The first property name and its associated value. There can be -as many repetitions of this as there are properties. All types -of exception classes may have property lists. - -=back - -If you have chosen to have the message be completely independent -of properties: - - declareExceptionClass('A'); - - # unchained exception - print output "Hello" - - my $e1 = A->new("Hello", importance => 'small', risk => 'large'); - print "$e1\n"; - - # chained exception - print output "Hello" - - my $e2 = A->new($e1,'Goodbye'); - - $e2->getChained(); # returns $e1 - print $e1->getMessage(); # outputs "Goodbye" - print $e1; # outputs "Goodbye" - print $e2->getChained()->getMessage(); # outputs "Hello" - - -If you have chosen to have the message autogenerated from properties -your call to C will look like this: - - $sFormat ='the importance is %s, but the risk is %s'; - declareExceptionClass('B', [ $sFormat, qw(importance risk)]); - - - # unchained exception - - my $e1 = B->new(importance=>'small', risk=>'large'); - - $e1->getChained(); # returns undef - print "$e1\n"; # outputs "The importance is small, but the - # risk is large" - - # chained exception - - $e2 = B->new($e1, importance=>'yink', risk=>'hooboy'); - $e2->getChained(); # returns $e1 - "$e2" # evaluates to "The importance is yink, but - # the risk is hooboy" - $e2->getMessage() # same as "$e2" - $e2->getChained()->getMessage(); # same as "$e1" - - - -=head2 Object methods - -=head3 C - - $e->getMessage(); - -Returns the messsage, i.e. the value displayed when this exception -is treated as a string. This is the value without line numbers -stack trace or other information. It includes only the format -string with the property values inserted. - -=head3 C - - $e->getProperty($sName); - -Returns the property value for the C<$sName> property. - -=head3 C - - $e->isProperty($sName) - -Returns true if the exception has the C<$sName> property, even if -the value is undefined. (checks existance, not definition). - -=head3 C - - $e->getPid(); - -Returns the process id of the process where the exception was -thrown. - -=head3 C - - $e->getPackage(); - -Returns the package contining the entry point of the process, i.e. -the package identified at the top of the stack. - - -=head3 C - -Returns the thread where the exception was thrown. - - $e->getTid(); - -=head3 C - - $e->getStackTrace(); - -Returns the stack trace from the point where the exception was -thrown (frame 0) to the entry point (frame -1). The stack trace -is structured as an array of arrays (AoA) where each member array -represents a single lightweight frame with four data per frame: - - [0] the file - [1] the line number within the file - [2] the subroutine where the exception was called. File and - line number will be within this subroutine. - [3] a comma delimited string containing string representations - of the values that were stored in @_ at the time the - exception was thrown. If shift was used to process the - incoming subroutine arguments, @_ will usually contain - several leading undefs. - -For more information about each component of a stack frame, please -see the documentation below for the following methods: - -* C - explains what to expect in [0] of stack frame - -* C - explains what to expect in [1] of stack frame - -* C - explains what to expect in [2] of stack frame - -* C - explains what to expect in [3] of stack frame - -The frame closest to the thrown exception is numbered 0. In fact -frame 0, stores information about the actual point where the exception -was thrown. - - -=head3 C - - $e->getFrameCount(); - -Returns the number of frames in the stack trace. - -=head3 C - - $e->getFile(0); # gets frame where exception was thrown - $e->getFile(-1); # gets entry point frame - - $e->getFile(); # short hand for $e->getFile(0) - $e->getFile($i); - -Without an argument, this method returns the name of the file where -the exception was thrown. With an argument it returns the name of -the file in the C<$i>th frame of the stack trace. - -Negative values of C<$i> will be counted from the entry point with -C<-1> representing the entry point frame, C<-2> representing the -first call made within the script and so on. - -=head3 C - - $e->getLine(0); # gets frame where exception was thrown - $e->getLine(-1); # gets entry point frame - - $e->getLine(); # short hand for $e->getLine(0) - $e->getLine($i); - -Without an argument, this method returns the line number where the -exception was thrown. With an argument it returns the line number -in the C<$i>th frame of the stack trace. - -Negative values of C<$i> will be counted from the entry point with -C<-1> representing the entry point frame, C<-2> representing the -first call made within the script and so on. - -=head3 C - - $e->getSubroutine(0); # gets frame where exception was thrown - $e->getSubroutine(-1); # gets entry point frame - - $e->getSubroutine(); # short hand for $e->getSubroutine(0) - $e->getSubroutine($i); - -Without an argument, this method returns the name of the subroutine -where this exception was created via C. With an argument -it returns the value of the subroutine (or package entry point) in -the C<$i>th frame of the stack trace. - -Negative values of C<$i> will be counted from the entry point with -C<-1> representing the entry point frame, C<-2> representing the -first call made within the script and so on. - -Note: This is not the same value as returned by C. C returns the name of the subroutine that was being called -at the time of death rather than the containing subroutine. - -The subroutine name in array element [2] includes the package name -so it will be 'MyPackage::Utils::doit' and not just 'doit'. In the -entry point frame there is, of course, no containing subroutine so -the value in this string is instead the package name embedded in -the string "". - - -=head3 C - - $e->getArgs(0); # gets frame where exception was thrown - $e->getArgs(-1); # gets entry point frame - - $e->getArgs(); # short hand for $e->getArgs(0) - $e->getArgs($i); - -Without an argument, this method returns the value of C<@_> (or -C<@ARGV> for an entry point frame) at the time the exception was -thrown. With an argument it returns the name of -the file in the C<$i>th frame of the stack trace. - -Negative values of C<$i> will be counted from the entry point with -C<-1> representing the entry point frame, C<-2> representing the -first call made within the script and so on. - - @_, is the best approximation Perl provides for the arguments -used to call the subroutine. At the start of the subroutine it does -in fact reflect the parameters passed in, but frequently programmers -will process this array with the C operator which will set -leading arguments to C. The debugger does not cache the -oiginal value of @_, so all you can get from its stack trace is the -value at the time the exception was thrown, not the value when the -subroutine was entered. - -=head3 C - - $e->getPropagation(); - -Returns an array reference with one element for each time this -exception was caught and rethrown using either Perl's own rethrow -syntax C<$@=$e; die;> or this packages: C<< die->rethrow() >>. - -Each element of the array contains a file and line number where -the exception was rethrown: - - [0] file where exception was caught and rethrown - [1] line number where the exception was caught and rethrown - -Note: do not confuse the stack trace with propagation. The stack -trace is the sequence of calls that were made I the -exception was thrown. The propagation file and line numbers -refer to where the exception was caught in an exception handling -block I the exception was thrown. - -Generally, bad data is the reason behind an exception. To see -where the bad data came from, it is generally more useful to -look at the stack and see what data was passed down to the point -where the exception was generated than it is to look at where -the exception was caught after the fact. - -=head3 C - - my $eChained = $e->getChained(); - -Returns the chained exception, or undef if the exception is not -chained. Chained exceptions are created by inserting the triggering -exception as the first parameter to C. - - # class level format - MyException1->new(reason=>'blahblahblah'); #unchained - MyException1->new($e, reason=>'blahblahblah'); #chained - - # no format string - MyException1->new('blahblahblah'); #unchained - MyException1->new($e, reason=>'blahblahblah'); #chained - - -The chained exception can be a reference to any sort of data. It -does not need to belong to the same class as the new exception, -nor does it even have to belong to a class generated by -C. Its only restriction is that it may not be -a scalar(string, number, ec). To see if an exception -may be chained you can call C: - - if (Exception::Lite::isChainable($e)) { - die MyException1->new($e, reason=>'blahblahblah'); - } else { - - # another alternative for string exceptions - my $eWrapper=MyWrapperForStringExceptions->new($e); - die MyException1->new($eWrapper, reason=>'blahblahblah'); - - # another alternative for string exceptions - die MyException1->new($eWrapper, reason=>"blahblahblah: $e"); - } - - -=head3 C - - $e->rethrow(); - $e->rethrow($prop => $newValue); # format rule - - $e->rethrow($newMsg, $p1 => $newValue); # no format rule - $e->rethrow(undef, $pl => $newValue); # no format rule - $e->rethrow($sNewMsg); # no format rule - - -Propagates the exception using the method (C) as would -be called were one to use Perl's native 'rethrow' syntax, -C<$@=$e; die>. - -The first form with no arguments simply rethrows the exception. -The remain formats let one override property values and/or update -the message. The argument list is the same as for C except -that exceptions with no or object level format strings may have -an undefined message. - -For class format exceptions, the message will automatically be -updated if any of the properties used to construct it have changed. - -For exception classes with no formatting, property and message -changes are independent of each other. If C<$sMsg> is set to C -the properties will be changed and the message will be left alone. -If C<$sMsg> is provided, but no override properties are provided, -the message will change but the properties will be left untouched. - -=head3 C<_p_getSubclassData> - -Method for internal use by custom subclasses. This method retrieves -the data hash reserved for use by custom methods. - - -=head1 SEE ALSO - -=head2 Canned test modules - -Test modules for making sure your code generates the right -exceptions. They work with any OOP solution, even C - -* L - works with any OOP solution - -* L - works - with any OOP solution - -=head2 Alternate OOP solutions - -=head3 L - -This module has a fair number of non-core modules. There are several -extension modules. Most are adapter classes that convert exceptions -produced by popular CPAN modules into Exception::Class modules: - -* L - changes - the syntax for declaring exceptions. - -* L - - converts Moose exceptions to - C instances. - -* L - wrapper around HTTP exceptions - -* L - wrapper around - Mail::Log exceptions - -* L - wrapper around - DBI exceptions - -* L - prints out exception - properties as part of exception stringification. - -It takes a heavy approach to OOP, requiring all properties to be -predeclared. It also stores a lot of information about an exception, -not all of which is likely to be important to the average user, e.g. -pid, uid, guid and even the entire stack trace. - -There is no support for auto-generating messages based on -properties. - -For an extended discussion of C, see -L. - -=head3 L - -A light weight version of L. -Uses only core modules but is fairly new and has no significant -eco-system of extensions (yet). -Like C properties must be explicitly declared and -there is no support for autogenerating messages based on properties. - - -=head3 L - -Another light weight version of L. -Unlike C you can control the amount of system -state and stack trace information stored at the time an exception -is generated. - -=head2 Syntactic sugar solutions - -Syntactical sugar solutions allow java like try/catch blocks to -replace the more awkward C, C, and C<$@=$e; die> -pattern. Take care in chosing these methods as they sometimes -use coding strategies known to cause problems: - -=over - -=item * - -overriding signal handlers - possible interference with your own -code or third party module use of those handlers. - -=item * - -source code filtering - can shift line numbers so that the reported -line number and the actual line number may not be the same. - -=item * - -closures - there is a apparently a problem with nested closures -causing memory leaks in some versions of Perl (pre 5.8.4). This -has been since fixed since 5.8.4. - -=back - -Modules providing syntactic sugar include: - -* L - -* L - -* C - -* L - -* L - -* C - -* L - extension of L - -* L - extension of L - - -=head1 EXPORTS - -No subroutines are exported by default. See the start of the synopsis -for optional exports. - - -=head1 AUTHOR - -Elizabeth Grace Frank-Backman - -=head1 COPYRIGHT - -Copyright (c) 2011 Elizabeth Grace Frank-Backman. -All rights reserved. - -=head1 LICENSE - -This program is free software; you can redistribute it and/or -modify it under the same terms as Perl itself. -- 2.20.1