Merge branch 'py/call-do-quit-before-exit' of github.com:gitster/git-gui into py...
[git/git.git] / perl / FromCPAN / Error.pm
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
12 package Error;
13
14 use strict;
15 use warnings;
16
17 use vars qw($VERSION);
18 use 5.004;
19
20 $VERSION = "0.17025";
21
22 use 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
34 my $LAST; # Last error created
35 my %ERROR; # Last error associated with package
36
37 sub _throw_Error_Simple
38 {
39 my $args = shift;
40 return Error::Simple->new($args->{'text'});
41 }
42
43 $Error::ObjectifyCallback = \&_throw_Error_Simple;
44
45
46 # Exported subs are defined in Error::subs
47
48 use Scalar::Util ();
49
50 sub import {
51 shift;
52 my @tags = @_;
53 local $Exporter::ExportLevel = $Exporter::ExportLevel + 1;
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);
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
71 sub 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
94 sub 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
112 sub 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
126
127 sub 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
145
146 sub 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
179 sub 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
193 sub 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
204 sub 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
215 sub 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
228 sub object {
229 my $self = shift;
230 exists $self->{'-object'} ? $self->{'-object'} : undef;
231 }
232
233 sub file {
234 my $self = shift;
235 exists $self->{'-file'} ? $self->{'-file'} : undef;
236 }
237
238 sub line {
239 my $self = shift;
240 exists $self->{'-line'} ? $self->{'-line'} : undef;
241 }
242
243 sub text {
244 my $self = shift;
245 exists $self->{'-text'} ? $self->{'-text'} : undef;
246 }
247
248 # overload methods
249
250 sub stringify {
251 my $self = shift;
252 defined $self->{'-text'} ? $self->{'-text'} : "Died";
253 }
254
255 sub value {
256 my $self = shift;
257 exists $self->{'-value'} ? $self->{'-value'} : undef;
258 }
259
260 package Error::Simple;
261
262 use vars qw($VERSION);
263
264 $VERSION = "0.17025";
265
266 @Error::Simple::ISA = qw(Error);
267
268 sub 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
284 sub 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
298 package Error::subs;
299
300 use Exporter ();
301 use 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
308 sub 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
326 splice(@$catch,$i,2,$catch->[$i+1]->($err));
327 $i -= 2;
328 next CATCHLOOP;
329 }
330 elsif(Scalar::Util::blessed($err) && $err->isa($pkg)) {
331 $code = $catch->[$i+1];
332 while(1) {
333 my $more = 0;
334 local($Error::THROWN, $@);
335 my $ok = eval {
336 $@ = $err;
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 {
354 $err = $@ || $Error::THROWN;
355 $err = $Error::ObjectifyCallback->({'text' =>$err})
356 unless ref($err);
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;
369 local($Error::THROWN, $@);
370 my $ok = eval {
371 $@ = $err;
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 {
388 $err = $@ || $Error::THROWN;
389
390 $err = $Error::ObjectifyCallback->({'text' =>$err})
391 unless ref($err);
392 }
393 }
394 }
395 $err;
396 }
397
398 sub 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;
411 local $@ = undef;
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
426 $err = $@ || $Error::THROWN
427 unless $ok;
428 };
429
430 shift @Error::STACK;
431
432 $err = run_clauses($clauses,$err,wantarray,@result)
433 unless($ok);
434
435 $clauses->{'finally'}->()
436 if(defined($clauses->{'finally'}));
437
438 if (defined($err))
439 {
440 if (Scalar::Util::blessed($err) && $err->can('throw'))
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
467 sub with (&;$) {
468 @_
469 }
470
471 sub 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
480 sub 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
504 sub 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
518 1;
519
520 package Error::WarnDie;
521
522 sub 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
536 my $old_DIE;
537 my $old_WARN;
538
539 sub 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
584 sub 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
605 sub import
606 {
607 $old_DIE = $SIG{__DIE__};
608 $old_WARN = $SIG{__WARN__};
609
610 $SIG{__DIE__} = \&DEATH;
611 $SIG{__WARN__} = \&TAXES;
612 }
613
614 1;
615
616 __END__
617
618 =head1 NAME
619
620 Error - Error/exception handling in an OO-ish way
621
622 =head1 WARNING
623
624 Using the "Error" module is B<no longer recommended> due to the black-magical
625 nature of its syntactic sugar, which often tends to break. Its maintainers
626 have stopped actively writing code that uses it, and discourage people
627 from doing so. See the "SEE ALSO" section below for better recommendations.
628
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;
646 throw Error::Simple "Oops!" if $other_condition;
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
669 The C<Error> package provides two interfaces. Firstly C<Error> provides
670 a procedural interface to exception handling. Secondly C<Error> is a
671 base class for errors/exceptions that can either be thrown, for
672 subsequent catch, or can simply be recorded.
673
674 Errors in the class C<Error> should not be thrown directly, but the
675 user should throw errors from a sub-class of C<Error>.
676
677 =head1 PROCEDURAL INTERFACE
678
679 C<Error> exports subroutines to perform exception handling. These will
680 be exported if the C<:try> tag is used in the C<use> line.
681
682 =over 4
683
684 =item try BLOCK CLAUSES
685
686 C<try> is the main subroutine called by the user. All other subroutines
687 exported are clauses to the try subroutine.
688
689 The BLOCK will be evaluated and, if no error is throw, try will return
690 the result of the block.
691
692 C<CLAUSES> are the subroutines below, which describe what to do in the
693 event of an error being thrown within BLOCK.
694
695 =item catch CLASS with BLOCK
696
697 This clauses will cause all errors that satisfy C<$err-E<gt>isa(CLASS)>
698 to be caught and handled by evaluating C<BLOCK>.
699
700 C<BLOCK> will be passed two arguments. The first will be the error
701 being thrown. The second is a reference to a scalar variable. If this
702 variable is set by the catch block then, on return from the catch
703 block, try will continue processing as if the catch block was never
704 found. The error will also be available in C<$@>.
705
706 To propagate the error the catch block may call C<$err-E<gt>throw>
707
708 If the scalar reference by the second argument is not set, and the
709 error is not thrown. Then the current try block will return with the
710 result from the catch block.
711
712 =item except BLOCK
713
714 When C<try> is looking for a handler, if an except clause is found
715 C<BLOCK> is evaluated. The return value from this block should be a
716 HASHREF or a list of key-value pairs, where the keys are class names
717 and the values are CODE references for the handler of errors of that
718 type.
719
720 =item otherwise BLOCK
721
722 Catch any error by executing the code in C<BLOCK>
723
724 When evaluated C<BLOCK> will be passed one argument, which will be the
725 error being processed. The error will also be available in C<$@>.
726
727 Only one otherwise block may be specified per try block
728
729 =item finally BLOCK
730
731 Execute the code in C<BLOCK> either after the code in the try block has
732 successfully completed, or if the try block throws an error then
733 C<BLOCK> will be executed after the handler has completed.
734
735 If the handler throws an error then the error will be caught, the
736 finally block will be executed and the error will be re-thrown.
737
738 Only one finally block may be specified per try block
739
740 =back
741
742 =head1 COMPATIBILITY
743
744 L<Moose> exports a keyword called C<with> which clashes with Error's. This
745 example 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
755 =head1 CLASS INTERFACE
756
757 =head2 CONSTRUCTORS
758
759 The C<Error> object is implemented as a HASH. This HASH is initialized
760 with the arguments that are passed to it's constructor. The elements
761 that are used by, or are retrievable by the C<Error> class are listed
762 below, other classes may add to these.
763
764 -file
765 -line
766 -text
767 -value
768 -object
769
770 If C<-file> or C<-line> are not specified in the constructor arguments
771 then these will be initialized with the file name and line number where
772 the constructor was called from.
773
774 If the error is associated with an object then the object should be
775 passed as the C<-object> argument. This will allow the C<Error> package
776 to associate the error with the object.
777
778 The C<Error> package remembers the last error created, and also the
779 last error associated with a package. This could either be the last
780 error created by a sub in that package, or the last error which passed
781 an object blessed into that package as the C<-object> argument.
782
783 =over 4
784
785 =item Error->new()
786
787 See the Error::Simple documentation.
788
789 =item throw ( [ ARGS ] )
790
791 Create a new C<Error> object and throw an error, which will be caught
792 by a surrounding C<try> block, if there is one. Otherwise it will cause
793 the program to exit.
794
795 C<throw> may also be called on an existing error to re-throw it.
796
797 =item with ( [ ARGS ] )
798
799 Create a new C<Error> object and returns it. This is defined for
800 syntactic sugar, eg
801
802 die with Some::Error ( ... );
803
804 =item record ( [ ARGS ] )
805
806 Create a new C<Error> object and returns it. This is defined for
807 syntactic 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
820 Return the last error created, or the last error associated with
821 C<PACKAGE>
822
823 =item flush ( [ PACKAGE ] )
824
825 Flush the last error created, or the last error associated with
826 C<PACKAGE>.It is necessary to clear the error stack before exiting the
827 package 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
841 If the variable C<$Error::Debug> was non-zero when the error was
842 created, then C<stacktrace> returns a string created by calling
843 C<Carp::longmess>. If the variable was zero the C<stacktrace> returns
844 the text of the error appended with the filename and line number of
845 where the error was created, providing the text does not end with a
846 newline.
847
848 =item object
849
850 The object this error was associated with
851
852 =item file
853
854 The file where the constructor of this error was called from
855
856 =item line
857
858 The line where the constructor of this error was called from
859
860 =item text
861
862 The text of the error
863
864 =item $err->associate($obj)
865
866 Associates an error with an object to allow error propagation. I.e:
867
868 $ber->encode(...) or
869 return Error->prior($ber)->associate($ldap);
870
871 =back
872
873 =head2 OVERLOAD METHODS
874
875 =over 4
876
877 =item stringify
878
879 A method that converts the object into a string. This method may simply
880 return the same as the C<text> method, or it may append more
881 information. For example the file name and line number.
882
883 By default this method returns the C<-text> argument that was passed to
884 the constructor, or the string C<"Died"> if none was given.
885
886 =item value
887
888 A method that will return a value that can be associated with the
889 error. For example if an error was created due to the failure of a
890 system call, then this may return the numeric value of C<$!> at the
891 time.
892
893 By default this method returns the C<-value> argument that was passed
894 to the constructor.
895
896 =back
897
898 =head1 PRE-DEFINED ERROR CLASSES
899
900 =head2 Error::Simple
901
902 This class can be used to hold simple error strings and values. It's
903 constructor takes two arguments. The first is a text value, the second
904 is a numeric value. These values are what will be returned by the
905 overload methods.
906
907 If the text value ends with C<at file line 1> as $@ strings do, then
908 this information will be used to set the C<-file> and C<-line> arguments
909 of the error object.
910
911 This class is used internally if an eval'd block die's with an error
912 that is a plain string. (Unless C<$Error::ObjectifyCallback> is modified)
913
914
915 =head1 $Error::ObjectifyCallback
916
917 This variable holds a reference to a subroutine that converts errors that
918 are plain strings to objects. It is used by Error.pm to convert textual
919 errors to objects, and can be overridden by the user.
920
921 It accepts a single argument which is a hash reference to named parameters.
922 Currently the only named parameter passed is C<'text'> which is the text
923 of the error, but others may be available in the future.
924
925 For example the following code will cause Error.pm to throw objects of the
926 class 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
942 =cut
943
944 =head1 MESSAGE HANDLERS
945
946 C<Error> also provides handlers to extend the output of the C<warn()> perl
947 function, and to handle the printing of a thrown C<Error> that is not caught
948 or otherwise handled. These are not installed by default, but are requested
949 using the C<:warndie> tag in the C<use> line.
950
951 use Error qw( :warndie );
952
953 These new error handlers are installed in C<$SIG{__WARN__}> and
954 C<$SIG{__DIE__}>. If these handlers are already defined when the tag is
955 imported, the old values are stored, and used during the new code. Thus, to
956 arrange for custom handling of warnings and errors, you will need to perform
957 something 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
967 Note that setting C<$SIG{__WARN__}> after the C<:warndie> tag has been
968 imported will overwrite the handler that C<Error> provides. If this cannot be
969 avoided, 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
979 The 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
983 into
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
1000 See L<Exception::Class> for a different module providing Object-Oriented
1001 exception handling, along with a convenient syntax for declaring hierarchies
1002 for them. It doesn't provide Error's syntactic sugar of C<try { ... }>,
1003 C<catch { ... }>, etc. which may be a good thing or a bad thing based
1004 on what you want. (Because Error's syntactic sugar tends to break.)
1005
1006 L<Error::Exception> aims to combine L<Error> and L<Exception::Class>
1007 "with correct stringification".
1008
1009 L<TryCatch> and L<Try::Tiny> are similar in concept to Error.pm only providing
1010 a syntax that hopefully breaks less.
1011
1012 =head1 KNOWN BUGS
1013
1014 None, but that does not mean there are not any.
1015
1016 =head1 AUTHORS
1017
1018 Graham Barr <gbarr@pobox.com>
1019
1020 The code that inspired me to write this was originally written by
1021 Peter Seibel <peter@weblogic.com> and adapted by Jesse Glick
1022 <jglick@sig.bsh.com>.
1023
1024 C<:warndie> handlers added by Paul Evans <leonerd@leonerd.org.uk>
1025
1026 =head1 MAINTAINER
1027
1028 Shlomi Fish, L<http://www.shlomifish.org/> .
1029
1030 =head1 PAST MAINTAINERS
1031
1032 Arun Kumar U <u_arunkumar@yahoo.com>
1033
1034 =head1 COPYRIGHT
1035
1036 Copyright (c) 1997-8 Graham Barr. All rights reserved.
1037 This program is free software; you can redistribute it and/or modify it
1038 under the same terms as Perl itself.
1039
1040 =cut