1--- Error-0.15/Error.pm Tue Feb 10 18:37:07 2004 2+++ /tmp/Error.pm Thu Apr 15 12:13:04 2004 3@@ -250,6 +250,36 @@ 4 $text; 5 } 6 7+sub id () { 8+ my $self = shift; 9+ 10+ my $id = $self->{id}; 11+ 12+ if ( defined( $id )) { 13+ return( $id ); 14+ } 15+ 16+ $self->{id} = Message->id( from => $self->{-text} ); 17+ return( $self->{ id } ); 18+} 19+ 20+sub idMatches { 21+ my $self = shift; 22+ 23+ my %args; 24+ my %targs = @_; 25+ foreach my $arg ( keys %targs ) { 26+ $args{ lc( $arg ) } = lc( $targs{ $arg } ); 27+ } 28+ my $argID = $args{ id }; 29+ 30+ my $id = lc($self->id()); 31+ 32+ my $match = ( $id eq $argID ); 33+ 34+ return $match; 35+} 36+ 37 ########################################################################## 38 ########################################################################## 39 40@@ -258,10 +288,11 @@ 41 42 package Error::subs; 43 44+use Data::Dumper; 45 use Exporter (); 46 use vars qw(@EXPORT_OK @ISA %EXPORT_TAGS); 47 48-@EXPORT_OK = qw(try with finally except otherwise); 49+@EXPORT_OK = qw(try with finally except otherwise catch annotate ); 50 %EXPORT_TAGS = (try => \@EXPORT_OK); 51 52 @ISA = qw(Exporter); 53@@ -269,9 +300,19 @@ 54 sub run_clauses ($$$\@) { 55 my($clauses,$err,$wantarray,$result) = @_; 56 my $code = undef; 57+ my $annotate = $clauses->{'annotate'}; 58 59 $err = new Error::Simple($err) unless ref($err); 60 61+ #----------------------------------------- 62+ # Prepend the annotation if there is one. 63+ # Keep the message id in front. 64+ #----------------------------------------- 65+ if(defined($annotate)) { 66+ my $annotation = eval{ $annotate->() }; 67+ $err->{'-stacktrace'} = $annotation . $err if !$@ && $annotation ne ''; 68+ } 69+ 70 CATCH: { 71 72 # catch 73@@ -282,6 +323,7 @@ 74 CATCHLOOP: 75 for( ; $i < @$catch ; $i += 2) { 76 my $pkg = $catch->[$i]; 77+ 78 unless(defined $pkg) { 79 #except 80 splice(@$catch,$i,2,$catch->[$i+1]->()); 81@@ -324,7 +366,11 @@ 82 83 # otherwise 84 my $owise; 85- if(defined($owise = $clauses->{'otherwise'})) { 86+ if ( (! $err->isa('Termination') ) && 87+ ( defined( $owise = $clauses->{'otherwise'} ))) 88+ { 89+ 90+# if(defined($owise = $clauses->{'otherwise'})) { 91 my $code = $clauses->{'otherwise'}; 92 my $more = 0; 93 my $ok = eval { 94@@ -463,6 +509,29 @@ 95 $clauses; 96 } 97 98+sub catch (&;$) { 99+ if ( ref( $_[0] ) eq "CODE" ) { 100+ goto &otherwise; 101+ } 102+ else { 103+ Error::catch( @_ ); 104+ } 105+} 106+ 107+sub annotate (&;$) { 108+ my $code = shift; 109+ my $clauses = shift || {}; 110+ 111+ if(exists $clauses->{'annotate'}) { 112+ require Carp; 113+ Carp::croak("Multiple annotate clauses"); 114+ } 115+ 116+ $clauses->{'annotate'} = $code; 117+ 118+ $clauses; 119+} 120+ 121 1; 122 __END__ 123 124