Merge branch 'py/call-do-quit-before-exit' of github.com:gitster/git-gui into py...
[git/git.git] / perl / FromCPAN / Error.pm
CommitLineData
5c4082fd
PB
1# Error.pm
2#
3# Copyright (c) 1997-8 Graham Barr <gbarr@ti.com>. All rights reserved.
4# This program is free software; you can redistribute it and/or
5# modify it under the same terms as Perl itself.
6#
7# Based on my original Error.pm, and Exceptions.pm by Peter Seibel
8# <peter@weblogic.com> and adapted by Jesse Glick <jglick@sig.bsh.com>.
9#
10# but modified ***significantly***
11
12package Error;
13
14use strict;
e5741c36
ÆAB
15use warnings;
16
5c4082fd
PB
17use vars qw($VERSION);
18use 5.004;
19
e5741c36 20$VERSION = "0.17025";
5c4082fd
PB
21
22use overload (
23 '""' => 'stringify',
24 '0+' => 'value',
25 'bool' => sub { return 1; },
26 'fallback' => 1
27);
28
29$Error::Depth = 0; # Depth to pass to caller()
30$Error::Debug = 0; # Generate verbose stack traces
31@Error::STACK = (); # Clause stack for try
32$Error::THROWN = undef; # last error thrown, a workaround until die $ref works
33
34my $LAST; # Last error created
35my %ERROR; # Last error associated with package
36
e5741c36 37sub _throw_Error_Simple
5c4082fd
PB
38{
39 my $args = shift;
40 return Error::Simple->new($args->{'text'});
41}
42
e5741c36 43$Error::ObjectifyCallback = \&_throw_Error_Simple;
5c4082fd
PB
44
45
46# Exported subs are defined in Error::subs
47
e5741c36
ÆAB
48use Scalar::Util ();
49
5c4082fd
PB
50sub import {
51 shift;
e5741c36 52 my @tags = @_;
5c4082fd 53 local $Exporter::ExportLevel = $Exporter::ExportLevel + 1;
e5741c36
ÆAB
54
55 @tags = grep {
56 if( $_ eq ':warndie' ) {
57 Error::WarnDie->import();
58 0;
59 }
60 else {
61 1;
62 }
63 } @tags;
64
65 Error::subs->import(@tags);
5c4082fd
PB
66}
67
68# I really want to use last for the name of this method, but it is a keyword
69# which prevent the syntax last Error
70
71sub prior {
72 shift; # ignore
73
74 return $LAST unless @_;
75
76 my $pkg = shift;
77 return exists $ERROR{$pkg} ? $ERROR{$pkg} : undef
78 unless ref($pkg);
79
80 my $obj = $pkg;
81 my $err = undef;
82 if($obj->isa('HASH')) {
83 $err = $obj->{'__Error__'}
84 if exists $obj->{'__Error__'};
85 }
86 elsif($obj->isa('GLOB')) {
87 $err = ${*$obj}{'__Error__'}
88 if exists ${*$obj}{'__Error__'};
89 }
90
91 $err;
92}
93
94sub flush {
95 shift; #ignore
96
97 unless (@_) {
98 $LAST = undef;
99 return;
100 }
101
102 my $pkg = shift;
103 return unless ref($pkg);
104
105 undef $ERROR{$pkg} if defined $ERROR{$pkg};
106}
107
108# Return as much information as possible about where the error
109# happened. The -stacktrace element only exists if $Error::DEBUG
110# was set when the error was created
111
112sub stacktrace {
113 my $self = shift;
114
115 return $self->{'-stacktrace'}
116 if exists $self->{'-stacktrace'};
117
118 my $text = exists $self->{'-text'} ? $self->{'-text'} : "Died";
119
120 $text .= sprintf(" at %s line %d.\n", $self->file, $self->line)
121 unless($text =~ /\n$/s);
122
123 $text;
124}
125
5c4082fd
PB
126
127sub associate {
128 my $err = shift;
129 my $obj = shift;
130
131 return unless ref($obj);
132
133 if($obj->isa('HASH')) {
134 $obj->{'__Error__'} = $err;
135 }
136 elsif($obj->isa('GLOB')) {
137 ${*$obj}{'__Error__'} = $err;
138 }
139 $obj = ref($obj);
140 $ERROR{ ref($obj) } = $err;
141
142 return;
143}
144
e5741c36 145
5c4082fd
PB
146sub new {
147 my $self = shift;
148 my($pkg,$file,$line) = caller($Error::Depth);
149
150 my $err = bless {
151 '-package' => $pkg,
152 '-file' => $file,
153 '-line' => $line,
154 @_
155 }, $self;
156
157 $err->associate($err->{'-object'})
158 if(exists $err->{'-object'});
159
160 # To always create a stacktrace would be very inefficient, so
161 # we only do it if $Error::Debug is set
162
163 if($Error::Debug) {
164 require Carp;
165 local $Carp::CarpLevel = $Error::Depth;
166 my $text = defined($err->{'-text'}) ? $err->{'-text'} : "Error";
167 my $trace = Carp::longmess($text);
168 # Remove try calls from the trace
169 $trace =~ s/(\n\s+\S+__ANON__[^\n]+)?\n\s+eval[^\n]+\n\s+Error::subs::try[^\n]+(?=\n)//sog;
170 $trace =~ s/(\n\s+\S+__ANON__[^\n]+)?\n\s+eval[^\n]+\n\s+Error::subs::run_clauses[^\n]+\n\s+Error::subs::try[^\n]+(?=\n)//sog;
171 $err->{'-stacktrace'} = $trace
172 }
173
174 $@ = $LAST = $ERROR{$pkg} = $err;
175}
176
177# Throw an error. this contains some very gory code.
178
179sub throw {
180 my $self = shift;
181 local $Error::Depth = $Error::Depth + 1;
182
183 # if we are not rethrow-ing then create the object to throw
184 $self = $self->new(@_) unless ref($self);
185
186 die $Error::THROWN = $self;
187}
188
189# syntactic sugar for
190#
191# die with Error( ... );
192
193sub with {
194 my $self = shift;
195 local $Error::Depth = $Error::Depth + 1;
196
197 $self->new(@_);
198}
199
200# syntactic sugar for
201#
202# record Error( ... ) and return;
203
204sub record {
205 my $self = shift;
206 local $Error::Depth = $Error::Depth + 1;
207
208 $self->new(@_);
209}
210
211# catch clause for
212#
213# try { ... } catch CLASS with { ... }
214
215sub catch {
216 my $pkg = shift;
217 my $code = shift;
218 my $clauses = shift || {};
219 my $catch = $clauses->{'catch'} ||= [];
220
221 unshift @$catch, $pkg, $code;
222
223 $clauses;
224}
225
226# Object query methods
227
228sub object {
229 my $self = shift;
230 exists $self->{'-object'} ? $self->{'-object'} : undef;
231}
232
233sub file {
234 my $self = shift;
235 exists $self->{'-file'} ? $self->{'-file'} : undef;
236}
237
238sub line {
239 my $self = shift;
240 exists $self->{'-line'} ? $self->{'-line'} : undef;
241}
242
243sub text {
244 my $self = shift;
245 exists $self->{'-text'} ? $self->{'-text'} : undef;
246}
247
248# overload methods
249
250sub stringify {
251 my $self = shift;
252 defined $self->{'-text'} ? $self->{'-text'} : "Died";
253}
254
255sub value {
256 my $self = shift;
257 exists $self->{'-value'} ? $self->{'-value'} : undef;
258}
259
260package Error::Simple;
261
e5741c36
ÆAB
262use vars qw($VERSION);
263
264$VERSION = "0.17025";
265
5c4082fd
PB
266@Error::Simple::ISA = qw(Error);
267
268sub new {
269 my $self = shift;
270 my $text = "" . shift;
271 my $value = shift;
272 my(@args) = ();
273
274 local $Error::Depth = $Error::Depth + 1;
275
276 @args = ( -file => $1, -line => $2)
277 if($text =~ s/\s+at\s+(\S+)\s+line\s+(\d+)(?:,\s*<[^>]*>\s+line\s+\d+)?\.?\n?$//s);
278 push(@args, '-value', 0 + $value)
279 if defined($value);
280
281 $self->SUPER::new(-text => $text, @args);
282}
283
284sub stringify {
285 my $self = shift;
286 my $text = $self->SUPER::stringify;
287 $text .= sprintf(" at %s line %d.\n", $self->file, $self->line)
288 unless($text =~ /\n$/s);
289 $text;
290}
291
292##########################################################################
293##########################################################################
294
295# Inspired by code from Jesse Glick <jglick@sig.bsh.com> and
296# Peter Seibel <peter@weblogic.com>
297
298package Error::subs;
299
300use Exporter ();
301use vars qw(@EXPORT_OK @ISA %EXPORT_TAGS);
302
303@EXPORT_OK = qw(try with finally except otherwise);
304%EXPORT_TAGS = (try => \@EXPORT_OK);
305
306@ISA = qw(Exporter);
307
308sub run_clauses ($$$\@) {
309 my($clauses,$err,$wantarray,$result) = @_;
310 my $code = undef;
311
312 $err = $Error::ObjectifyCallback->({'text' =>$err}) unless ref($err);
313
314 CATCH: {
315
316 # catch
317 my $catch;
318 if(defined($catch = $clauses->{'catch'})) {
319 my $i = 0;
320
321 CATCHLOOP:
322 for( ; $i < @$catch ; $i += 2) {
323 my $pkg = $catch->[$i];
324 unless(defined $pkg) {
325 #except
e5741c36 326 splice(@$catch,$i,2,$catch->[$i+1]->($err));
5c4082fd
PB
327 $i -= 2;
328 next CATCHLOOP;
329 }
e5741c36 330 elsif(Scalar::Util::blessed($err) && $err->isa($pkg)) {
5c4082fd
PB
331 $code = $catch->[$i+1];
332 while(1) {
333 my $more = 0;
e5741c36 334 local($Error::THROWN, $@);
5c4082fd 335 my $ok = eval {
e5741c36 336 $@ = $err;
5c4082fd
PB
337 if($wantarray) {
338 @{$result} = $code->($err,\$more);
339 }
340 elsif(defined($wantarray)) {
341 @{$result} = ();
342 $result->[0] = $code->($err,\$more);
343 }
344 else {
345 $code->($err,\$more);
346 }
347 1;
348 };
349 if( $ok ) {
350 next CATCHLOOP if $more;
351 undef $err;
352 }
353 else {
e5741c36
ÆAB
354 $err = $@ || $Error::THROWN;
355 $err = $Error::ObjectifyCallback->({'text' =>$err})
356 unless ref($err);
5c4082fd
PB
357 }
358 last CATCH;
359 };
360 }
361 }
362 }
363
364 # otherwise
365 my $owise;
366 if(defined($owise = $clauses->{'otherwise'})) {
367 my $code = $clauses->{'otherwise'};
368 my $more = 0;
e5741c36 369 local($Error::THROWN, $@);
5c4082fd 370 my $ok = eval {
e5741c36 371 $@ = $err;
5c4082fd
PB
372 if($wantarray) {
373 @{$result} = $code->($err,\$more);
374 }
375 elsif(defined($wantarray)) {
376 @{$result} = ();
377 $result->[0] = $code->($err,\$more);
378 }
379 else {
380 $code->($err,\$more);
381 }
382 1;
383 };
384 if( $ok ) {
385 undef $err;
386 }
387 else {
e5741c36 388 $err = $@ || $Error::THROWN;
5c4082fd 389
e5741c36
ÆAB
390 $err = $Error::ObjectifyCallback->({'text' =>$err})
391 unless ref($err);
5c4082fd
PB
392 }
393 }
394 }
395 $err;
396}
397
398sub try (&;$) {
399 my $try = shift;
400 my $clauses = @_ ? shift : {};
401 my $ok = 0;
402 my $err = undef;
403 my @result = ();
404
405 unshift @Error::STACK, $clauses;
406
407 my $wantarray = wantarray();
408
409 do {
410 local $Error::THROWN = undef;
e5741c36 411 local $@ = undef;
5c4082fd
PB
412
413 $ok = eval {
414 if($wantarray) {
415 @result = $try->();
416 }
417 elsif(defined $wantarray) {
418 $result[0] = $try->();
419 }
420 else {
421 $try->();
422 }
423 1;
424 };
425
e5741c36 426 $err = $@ || $Error::THROWN
5c4082fd
PB
427 unless $ok;
428 };
429
430 shift @Error::STACK;
431
432 $err = run_clauses($clauses,$err,wantarray,@result)
e5741c36 433 unless($ok);
5c4082fd
PB
434
435 $clauses->{'finally'}->()
436 if(defined($clauses->{'finally'}));
437
438 if (defined($err))
439 {
e5741c36 440 if (Scalar::Util::blessed($err) && $err->can('throw'))
5c4082fd
PB
441 {
442 throw $err;
443 }
444 else
445 {
446 die $err;
447 }
448 }
449
450 wantarray ? @result : $result[0];
451}
452
453# Each clause adds a sub to the list of clauses. The finally clause is
454# always the last, and the otherwise clause is always added just before
455# the finally clause.
456#
457# All clauses, except the finally clause, add a sub which takes one argument
458# this argument will be the error being thrown. The sub will return a code ref
459# if that clause can handle that error, otherwise undef is returned.
460#
461# The otherwise clause adds a sub which unconditionally returns the users
462# code reference, this is why it is forced to be last.
463#
464# The catch clause is defined in Error.pm, as the syntax causes it to
465# be called as a method
466
467sub with (&;$) {
468 @_
469}
470
471sub finally (&) {
472 my $code = shift;
473 my $clauses = { 'finally' => $code };
474 $clauses;
475}
476
477# The except clause is a block which returns a hashref or a list of
478# key-value pairs, where the keys are the classes and the values are subs.
479
480sub except (&;$) {
481 my $code = shift;
482 my $clauses = shift || {};
483 my $catch = $clauses->{'catch'} ||= [];
484
485 my $sub = sub {
486 my $ref;
487 my(@array) = $code->($_[0]);
488 if(@array == 1 && ref($array[0])) {
489 $ref = $array[0];
490 $ref = [ %$ref ]
491 if(UNIVERSAL::isa($ref,'HASH'));
492 }
493 else {
494 $ref = \@array;
495 }
496 @$ref
497 };
498
499 unshift @{$catch}, undef, $sub;
500
501 $clauses;
502}
503
504sub otherwise (&;$) {
505 my $code = shift;
506 my $clauses = shift || {};
507
508 if(exists $clauses->{'otherwise'}) {
509 require Carp;
510 Carp::croak("Multiple otherwise clauses");
511 }
512
513 $clauses->{'otherwise'} = $code;
514
515 $clauses;
516}
517
5181;
e5741c36
ÆAB
519
520package Error::WarnDie;
521
522sub gen_callstack($)
523{
524 my ( $start ) = @_;
525
526 require Carp;
527 local $Carp::CarpLevel = $start;
528 my $trace = Carp::longmess("");
529 # Remove try calls from the trace
530 $trace =~ s/(\n\s+\S+__ANON__[^\n]+)?\n\s+eval[^\n]+\n\s+Error::subs::try[^\n]+(?=\n)//sog;
531 $trace =~ s/(\n\s+\S+__ANON__[^\n]+)?\n\s+eval[^\n]+\n\s+Error::subs::run_clauses[^\n]+\n\s+Error::subs::try[^\n]+(?=\n)//sog;
532 my @callstack = split( m/\n/, $trace );
533 return @callstack;
534}
535
536my $old_DIE;
537my $old_WARN;
538
539sub DEATH
540{
541 my ( $e ) = @_;
542
543 local $SIG{__DIE__} = $old_DIE if( defined $old_DIE );
544
545 die @_ if $^S;
546
547 my ( $etype, $message, $location, @callstack );
548 if ( ref($e) && $e->isa( "Error" ) ) {
549 $etype = "exception of type " . ref( $e );
550 $message = $e->text;
551 $location = $e->file . ":" . $e->line;
552 @callstack = split( m/\n/, $e->stacktrace );
553 }
554 else {
555 # Don't apply subsequent layer of message formatting
556 die $e if( $e =~ m/^\nUnhandled perl error caught at toplevel:\n\n/ );
557 $etype = "perl error";
558 my $stackdepth = 0;
559 while( caller( $stackdepth ) =~ m/^Error(?:$|::)/ ) {
560 $stackdepth++
561 }
562
563 @callstack = gen_callstack( $stackdepth + 1 );
564
565 $message = "$e";
566 chomp $message;
567
568 if ( $message =~ s/ at (.*?) line (\d+)\.$// ) {
569 $location = $1 . ":" . $2;
570 }
571 else {
572 my @caller = caller( $stackdepth );
573 $location = $caller[1] . ":" . $caller[2];
574 }
575 }
576
577 shift @callstack;
578 # Do it this way in case there are no elements; we don't print a spurious \n
579 my $callstack = join( "", map { "$_\n"} @callstack );
580
581 die "\nUnhandled $etype caught at toplevel:\n\n $message\n\nThrown from: $location\n\nFull stack trace:\n\n$callstack\n";
582}
583
584sub TAXES
585{
586 my ( $message ) = @_;
587
588 local $SIG{__WARN__} = $old_WARN if( defined $old_WARN );
589
590 $message =~ s/ at .*? line \d+\.$//;
591 chomp $message;
592
593 my @callstack = gen_callstack( 1 );
594 my $location = shift @callstack;
595
596 # $location already starts in a leading space
597 $message .= $location;
598
599 # Do it this way in case there are no elements; we don't print a spurious \n
600 my $callstack = join( "", map { "$_\n"} @callstack );
601
602 warn "$message:\n$callstack";
603}
604
605sub import
606{
607 $old_DIE = $SIG{__DIE__};
608 $old_WARN = $SIG{__WARN__};
609
610 $SIG{__DIE__} = \&DEATH;
611 $SIG{__WARN__} = \&TAXES;
612}
613
6141;
615
5c4082fd
PB
616__END__
617
618=head1 NAME
619
620Error - Error/exception handling in an OO-ish way
621
e5741c36
ÆAB
622=head1 WARNING
623
624Using the "Error" module is B<no longer recommended> due to the black-magical
625nature of its syntactic sugar, which often tends to break. Its maintainers
626have stopped actively writing code that uses it, and discourage people
627from doing so. See the "SEE ALSO" section below for better recommendations.
628
5c4082fd
PB
629=head1 SYNOPSIS
630
631 use Error qw(:try);
632
633 throw Error::Simple( "A simple error");
634
635 sub xyz {
636 ...
637 record Error::Simple("A simple error")
638 and return;
639 }
640
641 unlink($file) or throw Error::Simple("$file: $!",$!);
642
643 try {
644 do_some_stuff();
645 die "error!" if $condition;
e5741c36 646 throw Error::Simple "Oops!" if $other_condition;
5c4082fd
PB
647 }
648 catch Error::IO with {
649 my $E = shift;
650 print STDERR "File ", $E->{'-file'}, " had a problem\n";
651 }
652 except {
653 my $E = shift;
654 my $general_handler=sub {send_message $E->{-description}};
655 return {
656 UserException1 => $general_handler,
657 UserException2 => $general_handler
658 };
659 }
660 otherwise {
661 print STDERR "Well I don't know what to say\n";
662 }
663 finally {
664 close_the_garage_door_already(); # Should be reliable
665 }; # Don't forget the trailing ; or you might be surprised
666
667=head1 DESCRIPTION
668
669The C<Error> package provides two interfaces. Firstly C<Error> provides
670a procedural interface to exception handling. Secondly C<Error> is a
671base class for errors/exceptions that can either be thrown, for
672subsequent catch, or can simply be recorded.
673
674Errors in the class C<Error> should not be thrown directly, but the
675user should throw errors from a sub-class of C<Error>.
676
677=head1 PROCEDURAL INTERFACE
678
679C<Error> exports subroutines to perform exception handling. These will
680be exported if the C<:try> tag is used in the C<use> line.
681
682=over 4
683
684=item try BLOCK CLAUSES
685
686C<try> is the main subroutine called by the user. All other subroutines
687exported are clauses to the try subroutine.
688
689The BLOCK will be evaluated and, if no error is throw, try will return
690the result of the block.
691
692C<CLAUSES> are the subroutines below, which describe what to do in the
693event of an error being thrown within BLOCK.
694
695=item catch CLASS with BLOCK
696
697This clauses will cause all errors that satisfy C<$err-E<gt>isa(CLASS)>
698to be caught and handled by evaluating C<BLOCK>.
699
700C<BLOCK> will be passed two arguments. The first will be the error
701being thrown. The second is a reference to a scalar variable. If this
702variable is set by the catch block then, on return from the catch
703block, try will continue processing as if the catch block was never
e5741c36 704found. The error will also be available in C<$@>.
5c4082fd
PB
705
706To propagate the error the catch block may call C<$err-E<gt>throw>
707
708If the scalar reference by the second argument is not set, and the
709error is not thrown. Then the current try block will return with the
710result from the catch block.
711
712=item except BLOCK
713
714When C<try> is looking for a handler, if an except clause is found
715C<BLOCK> is evaluated. The return value from this block should be a
716HASHREF or a list of key-value pairs, where the keys are class names
717and the values are CODE references for the handler of errors of that
718type.
719
720=item otherwise BLOCK
721
722Catch any error by executing the code in C<BLOCK>
723
724When evaluated C<BLOCK> will be passed one argument, which will be the
e5741c36 725error being processed. The error will also be available in C<$@>.
5c4082fd
PB
726
727Only one otherwise block may be specified per try block
728
729=item finally BLOCK
730
731Execute the code in C<BLOCK> either after the code in the try block has
732successfully completed, or if the try block throws an error then
733C<BLOCK> will be executed after the handler has completed.
734
735If the handler throws an error then the error will be caught, the
736finally block will be executed and the error will be re-thrown.
737
738Only one finally block may be specified per try block
739
740=back
741
e5741c36
ÆAB
742=head1 COMPATIBILITY
743
744L<Moose> exports a keyword called C<with> which clashes with Error's. This
745example returns a prototype mismatch error:
746
747 package MyTest;
748
749 use warnings;
750 use Moose;
751 use Error qw(:try);
752
753(Thanks to C<maik.hentsche@amd.com> for the report.).
754
5c4082fd
PB
755=head1 CLASS INTERFACE
756
757=head2 CONSTRUCTORS
758
759The C<Error> object is implemented as a HASH. This HASH is initialized
e5741c36 760with the arguments that are passed to it's constructor. The elements
5c4082fd
PB
761that are used by, or are retrievable by the C<Error> class are listed
762below, other classes may add to these.
763
764 -file
765 -line
766 -text
767 -value
768 -object
769
770If C<-file> or C<-line> are not specified in the constructor arguments
771then these will be initialized with the file name and line number where
772the constructor was called from.
773
774If the error is associated with an object then the object should be
775passed as the C<-object> argument. This will allow the C<Error> package
776to associate the error with the object.
777
778The C<Error> package remembers the last error created, and also the
779last error associated with a package. This could either be the last
780error created by a sub in that package, or the last error which passed
781an object blessed into that package as the C<-object> argument.
782
783=over 4
784
e5741c36
ÆAB
785=item Error->new()
786
787See the Error::Simple documentation.
788
5c4082fd
PB
789=item throw ( [ ARGS ] )
790
791Create a new C<Error> object and throw an error, which will be caught
792by a surrounding C<try> block, if there is one. Otherwise it will cause
793the program to exit.
794
795C<throw> may also be called on an existing error to re-throw it.
796
797=item with ( [ ARGS ] )
798
799Create a new C<Error> object and returns it. This is defined for
800syntactic sugar, eg
801
802 die with Some::Error ( ... );
803
804=item record ( [ ARGS ] )
805
806Create a new C<Error> object and returns it. This is defined for
807syntactic sugar, eg
808
809 record Some::Error ( ... )
810 and return;
811
812=back
813
814=head2 STATIC METHODS
815
816=over 4
817
818=item prior ( [ PACKAGE ] )
819
820Return the last error created, or the last error associated with
821C<PACKAGE>
822
823=item flush ( [ PACKAGE ] )
824
825Flush the last error created, or the last error associated with
826C<PACKAGE>.It is necessary to clear the error stack before exiting the
827package or uncaught errors generated using C<record> will be reported.
828
829 $Error->flush;
830
831=cut
832
833=back
834
835=head2 OBJECT METHODS
836
837=over 4
838
839=item stacktrace
840
841If the variable C<$Error::Debug> was non-zero when the error was
842created, then C<stacktrace> returns a string created by calling
843C<Carp::longmess>. If the variable was zero the C<stacktrace> returns
844the text of the error appended with the filename and line number of
845where the error was created, providing the text does not end with a
846newline.
847
848=item object
849
850The object this error was associated with
851
852=item file
853
854The file where the constructor of this error was called from
855
856=item line
857
858The line where the constructor of this error was called from
859
860=item text
861
862The text of the error
863
e5741c36
ÆAB
864=item $err->associate($obj)
865
866Associates an error with an object to allow error propagation. I.e:
867
868 $ber->encode(...) or
869 return Error->prior($ber)->associate($ldap);
870
5c4082fd
PB
871=back
872
873=head2 OVERLOAD METHODS
874
875=over 4
876
877=item stringify
878
879A method that converts the object into a string. This method may simply
880return the same as the C<text> method, or it may append more
881information. For example the file name and line number.
882
883By default this method returns the C<-text> argument that was passed to
884the constructor, or the string C<"Died"> if none was given.
885
886=item value
887
888A method that will return a value that can be associated with the
889error. For example if an error was created due to the failure of a
890system call, then this may return the numeric value of C<$!> at the
891time.
892
893By default this method returns the C<-value> argument that was passed
894to the constructor.
895
896=back
897
898=head1 PRE-DEFINED ERROR CLASSES
899
e5741c36 900=head2 Error::Simple
5c4082fd 901
e5741c36 902This class can be used to hold simple error strings and values. It's
5c4082fd
PB
903constructor takes two arguments. The first is a text value, the second
904is a numeric value. These values are what will be returned by the
905overload methods.
906
907If the text value ends with C<at file line 1> as $@ strings do, then
41ccfdd9 908this information will be used to set the C<-file> and C<-line> arguments
5c4082fd
PB
909of the error object.
910
911This class is used internally if an eval'd block die's with an error
912that is a plain string. (Unless C<$Error::ObjectifyCallback> is modified)
913
5c4082fd
PB
914
915=head1 $Error::ObjectifyCallback
916
917This variable holds a reference to a subroutine that converts errors that
918are plain strings to objects. It is used by Error.pm to convert textual
3dff5379 919errors to objects, and can be overridden by the user.
5c4082fd
PB
920
921It accepts a single argument which is a hash reference to named parameters.
922Currently the only named parameter passed is C<'text'> which is the text
923of the error, but others may be available in the future.
924
925For example the following code will cause Error.pm to throw objects of the
926class MyError::Bar by default:
927
928 sub throw_MyError_Bar
929 {
930 my $args = shift;
931 my $err = MyError::Bar->new();
932 $err->{'MyBarText'} = $args->{'text'};
933 return $err;
934 }
935
936 {
937 local $Error::ObjectifyCallback = \&throw_MyError_Bar;
938
939 # Error handling here.
940 }
941
e5741c36
ÆAB
942=cut
943
944=head1 MESSAGE HANDLERS
945
946C<Error> also provides handlers to extend the output of the C<warn()> perl
947function, and to handle the printing of a thrown C<Error> that is not caught
948or otherwise handled. These are not installed by default, but are requested
949using the C<:warndie> tag in the C<use> line.
950
951 use Error qw( :warndie );
952
953These new error handlers are installed in C<$SIG{__WARN__}> and
954C<$SIG{__DIE__}>. If these handlers are already defined when the tag is
955imported, the old values are stored, and used during the new code. Thus, to
956arrange for custom handling of warnings and errors, you will need to perform
957something like the following:
958
959 BEGIN {
960 $SIG{__WARN__} = sub {
961 print STDERR "My special warning handler: $_[0]"
962 };
963 }
964
965 use Error qw( :warndie );
966
967Note that setting C<$SIG{__WARN__}> after the C<:warndie> tag has been
968imported will overwrite the handler that C<Error> provides. If this cannot be
969avoided, then the tag can be explicitly C<import>ed later
970
971 use Error;
972
973 $SIG{__WARN__} = ...;
974
975 import Error qw( :warndie );
976
977=head2 EXAMPLE
978
979The C<__DIE__> handler turns messages such as
980
981 Can't call method "foo" on an undefined value at examples/warndie.pl line 16.
982
983into
984
985 Unhandled perl error caught at toplevel:
986
987 Can't call method "foo" on an undefined value
988
989 Thrown from: examples/warndie.pl:16
990
991 Full stack trace:
992
993 main::inner('undef') called at examples/warndie.pl line 20
994 main::outer('undef') called at examples/warndie.pl line 23
995
996=cut
997
998=head1 SEE ALSO
999
1000See L<Exception::Class> for a different module providing Object-Oriented
1001exception handling, along with a convenient syntax for declaring hierarchies
1002for them. It doesn't provide Error's syntactic sugar of C<try { ... }>,
1003C<catch { ... }>, etc. which may be a good thing or a bad thing based
1004on what you want. (Because Error's syntactic sugar tends to break.)
1005
1006L<Error::Exception> aims to combine L<Error> and L<Exception::Class>
1007"with correct stringification".
1008
1009L<TryCatch> and L<Try::Tiny> are similar in concept to Error.pm only providing
1010a syntax that hopefully breaks less.
1011
5c4082fd
PB
1012=head1 KNOWN BUGS
1013
1014None, but that does not mean there are not any.
1015
1016=head1 AUTHORS
1017
1018Graham Barr <gbarr@pobox.com>
1019
1020The code that inspired me to write this was originally written by
1021Peter Seibel <peter@weblogic.com> and adapted by Jesse Glick
1022<jglick@sig.bsh.com>.
1023
e5741c36
ÆAB
1024C<:warndie> handlers added by Paul Evans <leonerd@leonerd.org.uk>
1025
5c4082fd
PB
1026=head1 MAINTAINER
1027
e5741c36 1028Shlomi Fish, L<http://www.shlomifish.org/> .
5c4082fd
PB
1029
1030=head1 PAST MAINTAINERS
1031
1032Arun Kumar U <u_arunkumar@yahoo.com>
1033
e5741c36
ÆAB
1034=head1 COPYRIGHT
1035
1036Copyright (c) 1997-8 Graham Barr. All rights reserved.
1037This program is free software; you can redistribute it and/or modify it
1038under the same terms as Perl itself.
1039
5c4082fd 1040=cut