3 use 5.008; # 5.8.x needed for autodie
8 use constant LEXICAL_TAG => q{:lexical};
9 use constant VOID_TAG => q{:void};
11 use constant ERROR_NOARGS => 'Cannot use lexical %s with no arguments';
12 use constant ERROR_VOID_LEX => VOID_TAG.' cannot be used with lexical scope';
13 use constant ERROR_LEX_FIRST => LEXICAL_TAG.' must be used as first argument';
14 use constant ERROR_NO_LEX => "no %s can only start with ".LEXICAL_TAG;
15 use constant ERROR_BADNAME => "Bad subroutine name for %s: %s";
16 use constant ERROR_NOTSUB => "%s is not a Perl subroutine";
17 use constant ERROR_NOT_BUILT => "%s is neither a builtin, nor a Perl subroutine";
18 use constant ERROR_CANT_OVERRIDE => "Cannot make the non-overridable builtin %s fatal";
20 use constant ERROR_NO_IPC_SYS_SIMPLE => "IPC::System::Simple required for Fatalised/autodying system()";
22 use constant ERROR_IPC_SYS_SIMPLE_OLD => "IPC::System::Simple version %f required for Fatalised/autodying system(). We only have version %f";
24 use constant ERROR_AUTODIE_CONFLICT => q{"no autodie '%s'" is not allowed while "use Fatal '%s'" is in effect};
26 use constant ERROR_FATAL_CONFLICT => q{"use Fatal '%s'" is not allowed while "no autodie '%s'" is in effect};
28 # Older versions of IPC::System::Simple don't support all the
31 use constant MIN_IPC_SYS_SIMPLE_VER => 0.12;
33 # All the Fatal/autodie modules share the same version number.
34 our $VERSION = '1.999';
38 # EWOULDBLOCK values for systems that don't supply their own.
39 # Even though this is defined with our, that's to help our
40 # test code. Please don't rely upon this variable existing in
47 # We have some tags that can be passed in for use with import.
48 # These are all assumed to be CORE::
51 ':io' => [qw(:dbm :file :filesys :ipc :socket
52 read seek sysread syswrite sysseek )],
53 ':dbm' => [qw(dbmopen dbmclose)],
54 ':file' => [qw(open close flock sysopen fcntl fileno binmode
56 ':filesys' => [qw(opendir closedir chdir link unlink rename mkdir
57 symlink rmdir readlink umask)],
58 ':ipc' => [qw(:msg :semaphore :shm pipe)],
59 ':msg' => [qw(msgctl msgget msgrcv msgsnd)],
60 ':threads' => [qw(fork)],
61 ':semaphore'=>[qw(semctl semget semop)],
62 ':shm' => [qw(shmctl shmget shmread)],
63 ':system' => [qw(system exec)],
65 # Can we use qw(getpeername getsockname)? What do they do on failure?
66 # XXX - Can socket return false?
67 ':socket' => [qw(accept bind connect getsockopt listen recv send
68 setsockopt shutdown socketpair)],
70 # Our defaults don't include system(), because it depends upon
71 # an optional module, and it breaks the exotic form.
73 # This *may* change in the future. I'd love IPC::System::Simple
74 # to be a dependency rather than a recommendation, and hence for
75 # system() to be autodying by default.
77 ':default' => [qw(:io :threads)],
79 # Version specific tags. These allow someone to specify
80 # use autodie qw(:1.994) and know exactly what they'll get.
82 ':1.994' => [qw(:default)],
83 ':1.995' => [qw(:default)],
84 ':1.996' => [qw(:default)],
85 ':1.997' => [qw(:default)],
86 ':1.998' => [qw(:default)],
87 ':1.999' => [qw(:default)],
91 $TAGS{':all'} = [ keys %TAGS ];
93 # This hash contains subroutines for which we should
94 # subroutine() // die() rather than subroutine() || die()
98 # CORE::open returns undef on failure. It can legitimately return
99 # 0 on success, eg: open(my $fh, '-|') || exec(...);
115 # Cached_fatalised_sub caches the various versions of our
116 # fatalised subs as they're produced. This means we don't
117 # have to build our own replacement of CORE::open and friends
118 # for every single package that wants to use them.
120 my %Cached_fatalised_sub = ();
122 # Every time we're called with package scope, we record the subroutine
123 # (including package or CORE::) in %Package_Fatal. This allows us
124 # to detect illegal combinations of autodie and Fatal, and makes sure
125 # we don't accidently make a Fatal function autodying (which isn't
128 my %Package_Fatal = ();
130 # The first time we're called with a user-sub, we cache it here.
131 # In the case of a "no autodie ..." we put back the cached copy.
133 my %Original_user_sub = ();
135 # We use our package in a few hash-keys. Having it in a scalar is
136 # convenient. The "guard $PACKAGE" string is used as a key when
137 # setting up lexical guards.
139 my $PACKAGE = __PACKAGE__;
140 my $PACKAGE_GUARD = "guard $PACKAGE";
141 my $NO_PACKAGE = "no $PACKAGE"; # Used to detect 'no autodie'
143 # Here's where all the magic happens when someone write 'use Fatal'
147 my $class = shift(@_);
151 my ($pkg, $filename) = caller();
153 @_ or return; # 'use Fatal' is a no-op.
155 # If we see the :lexical flag, then _all_ arguments are
158 if ($_[0] eq LEXICAL_TAG) {
162 # If we see no arguments and :lexical, we assume they
166 push(@_, ':default');
169 # Don't allow :lexical with :void, it's needlessly confusing.
170 if ( grep { $_ eq VOID_TAG } @_ ) {
171 croak(ERROR_VOID_LEX);
175 if ( grep { $_ eq LEXICAL_TAG } @_ ) {
176 # If we see the lexical tag as the non-first argument, complain.
177 croak(ERROR_LEX_FIRST);
180 my @fatalise_these = @_;
182 # Thiese subs will get unloaded at the end of lexical scope.
185 # This hash helps us track if we've alredy done work.
188 # NB: we're using while/shift rather than foreach, since
189 # we'll be modifying the array as we walk through it.
191 while (my $func = shift @fatalise_these) {
193 if ($func eq VOID_TAG) {
195 # When we see :void, set the void flag.
198 } elsif (exists $TAGS{$func}) {
200 # When it's a tag, expand it.
201 push(@fatalise_these, @{ $TAGS{$func} });
205 # Otherwise, fatalise it.
207 # If we've already made something fatal this call,
208 # then don't do it twice.
210 next if $done_this{$func};
212 # We're going to make a subroutine fatalistic.
213 # However if we're being invoked with 'use Fatal qw(x)'
214 # and we've already been called with 'no autodie qw(x)'
215 # in the same scope, we consider this to be an error.
216 # Mixing Fatal and autodie effects was considered to be
217 # needlessly confusing on p5p.
220 $sub = "${pkg}::$sub" unless $sub =~ /::/;
222 # If we're being called as Fatal, and we've previously
223 # had a 'no X' in scope for the subroutine, then complain
226 if (! $lexical and $^H{$NO_PACKAGE}{$sub}) {
227 croak(sprintf(ERROR_FATAL_CONFLICT, $func, $func));
230 # We're not being used in a confusing way, so make
231 # the sub fatal. Note that _make_fatal returns the
232 # old (original) version of the sub, or undef for
235 my $sub_ref = $class->_make_fatal(
236 $func, $pkg, $void, $lexical, $filename
241 $Original_user_sub{$sub} ||= $sub_ref;
243 # If we're making lexical changes, we need to arrange
244 # for them to be cleaned at the end of our scope, so
247 $unload_later{$func} = $sub_ref if $lexical;
253 # Dark magic to have autodie work under 5.8
254 # Copied from namespace::clean, that copied it from
255 # autobox, that found it on an ancient scroll written
258 # This magic bit causes %^H to be lexically scoped.
262 # Our package guard gets invoked when we leave our lexical
265 push(@ { $^H{$PACKAGE_GUARD} }, autodie::Scope::Guard->new(sub {
266 $class->_install_subs($pkg, \%unload_later);
275 # The code here is originally lifted from namespace::clean,
276 # by Robert "phaylon" Sedlacek.
278 # It's been redesigned after feedback from ikegami on perlmonks.
279 # See http://perlmonks.org/?node_id=693338 . Ikegami rocks.
281 # Given a package, and hash of (subname => subref) pairs,
282 # we install the given subroutines into the package. If
283 # a subref is undef, the subroutine is removed. Otherwise
284 # it replaces any existing subs which were already there.
287 my ($class, $pkg, $subs_to_reinstate) = @_;
289 my $pkg_sym = "${pkg}::";
291 while(my ($sub_name, $sub_ref) = each %$subs_to_reinstate) {
293 my $full_path = $pkg_sym.$sub_name;
295 # Copy symbols across to temp area.
297 no strict 'refs'; ## no critic
299 local *__tmp = *{ $full_path };
302 { no strict; delete $pkg_sym->{$sub_name}; } ## no critic
304 # Copy innocent bystanders back.
306 foreach my $slot (qw( SCALAR ARRAY HASH IO FORMAT ) ) {
307 next unless defined *__tmp{ $slot };
308 *{ $full_path } = *__tmp{ $slot };
311 # Put back the old sub (if there was one).
315 no strict; ## no critic
316 *{ $pkg_sym . $sub_name } = $sub_ref;
326 # Calling "no Fatal" must start with ":lexical"
327 if ($_[0] ne LEXICAL_TAG) {
328 croak(sprintf(ERROR_NO_LEX,$class));
331 shift @_; # Remove :lexical
333 my $pkg = (caller)[0];
335 # If we've been called with arguments, then the developer
336 # has explicitly stated 'no autodie qw(blah)',
337 # in which case, we disable Fatalistic behaviour for 'blah'.
339 my @unimport_these = @_ ? @_ : ':all';
341 while (my $symbol = shift @unimport_these) {
343 if ($symbol =~ /^:/) {
345 # Looks like a tag! Expand it!
346 push(@unimport_these, @{ $TAGS{$symbol} });
352 $sub = "${pkg}::$sub" unless $sub =~ /::/;
354 # If 'blah' was already enabled with Fatal (which has package
355 # scope) then, this is considered an error.
357 if (exists $Package_Fatal{$sub}) {
358 croak(sprintf(ERROR_AUTODIE_CONFLICT,$symbol,$symbol));
361 # Record 'no autodie qw($sub)' as being in effect.
362 # This is to catch conflicting semantics elsewhere
363 # (eg, mixing Fatal with no autodie)
365 $^H{$NO_PACKAGE}{$sub} = 1;
367 if (my $original_sub = $Original_user_sub{$sub}) {
368 # Hey, we've got an original one of these, put it back.
369 $class->_install_subs($pkg, { $symbol => $original_sub });
373 # We don't have an original copy of the sub, on the assumption
374 # it's core (or doesn't exist), we'll just nuke it.
376 $class->_install_subs($pkg,{ $symbol => undef });
384 # TODO - This is rather terribly inefficient right now.
386 # NB: Perl::Critic's dump-autodie-tag-contents depends upon this
387 # continuing to work.
393 my ($class, $tag) = @_;
395 if (my $cached = $tag_cache{$tag}) {
399 if (not exists $TAGS{$tag}) {
400 croak "Invalid exception class $tag";
403 my @to_process = @{$TAGS{$tag}};
407 while (my $item = shift @to_process) {
409 push(@to_process, @{$TAGS{$item}} );
411 push(@taglist, "CORE::$item");
415 $tag_cache{$tag} = \@taglist;
423 # This code is from the original Fatal. It scares me.
427 my ($n, $isref, @out, @out1, $seen_semi) = -1;
428 while ($proto =~ /\S/) {
430 push(@out1,[$n,@out]) if $seen_semi;
431 push(@out, $1 . "{\$_[$n]}"), next if $proto =~ s/^\s*\\([\@%\$\&])//;
432 push(@out, "\$_[$n]"), next if $proto =~ s/^\s*([_*\$&])//;
433 push(@out, "\@_[$n..\$#_]"), last if $proto =~ s/^\s*(;\s*)?\@//;
434 $seen_semi = 1, $n--, next if $proto =~ s/^\s*;//; # XXXX ????
435 die "Internal error: Unknown prototype letters: \"$proto\"";
437 push(@out1,[$n+1,@out]);
441 # This generates the code that will become our fatalised subroutine.
443 sub write_invocation {
444 my ($class, $core, $call, $name, $void, $lexical, $sub, @argvs) = @_;
446 if (@argvs == 1) { # No optional arguments
448 my @argv = @{$argvs[0]};
451 return $class->one_invocation($core,$call,$name,$void,$sub,! $lexical,@argv);
455 my (@out, @argv, $n);
457 @argv = @{shift @argvs};
460 push @out, "${else}if (\@_ == $n) {\n";
463 push @out, $class->one_invocation($core,$call,$name,$void,$sub,! $lexical,@argv);
467 die "Internal error: $name(\@_): Do not expect to get ", scalar \@_, " arguments";
470 return join '', @out;
475 my ($class, $core, $call, $name, $void, $sub, $back_compat, @argv) = @_;
477 # If someone is calling us directly (a child class perhaps?) then
478 # they could try to mix void without enabling backwards
479 # compatibility. We just don't support this at all, so we gripe
480 # about it rather than doing something unwise.
482 if ($void and not $back_compat) {
483 Carp::confess("Internal error: :void mode not supported with $class");
486 # @argv only contains the results of the in-built prototype
487 # function, and is therefore safe to interpolate in the
488 # code generators below.
490 # TODO - The following clobbers context, but that's what the
491 # old Fatal did. Do we care?
495 # TODO - Use Fatal qw(system) is not yet supported. It should be!
497 if ($call eq 'CORE::system') {
499 croak("UNIMPLEMENTED: use Fatal qw(system) not yet supported.");
506 return qq/return (defined wantarray)?$call(@argv):
507 $call(@argv) || croak "Can't $name(\@_)/ .
508 ($core ? ': $!' : ', \$! is \"$!\"') . '"'
510 return qq{return $call(@argv) || croak "Can't $name(\@_)} .
511 ($core ? ': $!' : ', \$! is \"$!\"') . '"';
515 # The name of our original function is:
516 # $call if the function is CORE
517 # $sub if our function is non-CORE
519 # The reason for this is that $call is what we're actualling
520 # calling. For our core functions, this is always
521 # CORE::something. However for user-defined subs, we're about to
522 # replace whatever it is that we're calling; as such, we actually
523 # calling a subroutine ref.
525 # Unfortunately, none of this tells us the *ultimate* name.
526 # For example, if I export 'copy' from File::Copy, I'd like my
527 # ultimate name to be File::Copy::copy.
529 # TODO - Is there any way to find the ultimate name of a sub, as
532 my $true_sub_name = $core ? $call : $sub;
534 if ($call eq 'CORE::system') {
536 # Leverage IPC::System::Simple if we're making an autodying
541 # We need to stash $@ into $E, rather than using
542 # local $@ for the whole sub. If we don't then
543 # any exceptions from internal errors in autodie/Fatal
544 # will mysteriously disappear before propogating
556 \$retval = IPC::System::Simple::system(@argv);
564 # XXX - TODO - This can't be overridden in child
567 die autodie::exception::system->new(
568 function => q{CORE::system}, args => [ @argv ],
569 message => "\$E", errno => \$!,
578 # Should we be testing to see if our result is defined, or
580 my $use_defined_or = exists ( $Use_defined_or{$call} );
584 # If we're going to throw an exception, here's the code to use.
587 function => q{$true_sub_name}, args => [ @argv ],
588 pragma => q{$class}, errno => \$!,
592 if ($call eq 'CORE::flock') {
594 # flock needs special treatment. When it fails with
595 # LOCK_UN and EWOULDBLOCK, then it's not really fatal, it just
596 # means we couldn't get the lock right now.
598 require POSIX; # For POSIX::EWOULDBLOCK
600 local $@; # Don't blat anyone else's $@.
602 # Ensure that our vendor supports EWOULDBLOCK. If they
603 # don't (eg, Windows), then we use known values for its
604 # equivalent on other systems.
606 my $EWOULDBLOCK = eval { POSIX::EWOULDBLOCK(); }
607 || $_EWOULDBLOCK{$^O}
608 || _autocroak("Internal error - can't overload flock - EWOULDBLOCK not defined on this system.");
610 require Fcntl; # For Fcntl::LOCK_NB
614 # Try to flock. If successful, return it immediately.
616 my \$retval = $call(@argv);
617 return \$retval if \$retval;
619 # If we failed, but we're using LOCK_NB and
620 # returned EWOULDBLOCK, it's not a real error.
622 if (\$_[1] & Fcntl::LOCK_NB() and \$! == $EWOULDBLOCK ) {
626 # Otherwise, we failed. Die noisily.
633 # AFAIK everything that can be given an unopned filehandle
634 # will fail if it tries to use it, so we don't really need
635 # the 'unopened' warning class here. Especially since they
636 # then report the wrong line number.
639 no warnings qw(unopened);
642 my \@results = $call(@argv);
643 # If we got back nothing, or we got back a single
645 if (! \@results or (\@results == 1 and ! defined \$results[0])) {
651 # Otherwise, we're in scalar context.
652 # We're never in a void context, since we have to look
655 my \$result = $call(@argv);
657 } . ( $use_defined_or ? qq{
659 $die if not defined \$result;
665 return \$result || $die;
671 # This returns the old copy of the sub, so we can
672 # put it back at end of scope.
674 # TODO : Check to make sure prototypes are restored correctly.
676 # TODO: Taking a huge list of arguments is awful. Rewriting to
677 # take a hash would be lovely.
680 my($class, $sub, $pkg, $void, $lexical, $filename) = @_;
681 my($name, $code, $sref, $real_proto, $proto, $core, $call);
684 $sub = "${pkg}::$sub" unless $sub =~ /::/;
686 # Figure if we're using lexical or package semantics and
687 # twiddle the appropriate bits.
690 $Package_Fatal{$sub} = 1;
693 # TODO - We *should* be able to do skipping, since we know when
694 # we've lexicalised / unlexicalised a subroutine.
697 $name =~ s/.*::// or $name =~ s/^&//;
699 warn "# _make_fatal: sub=$sub pkg=$pkg name=$name void=$void\n" if $Debug;
700 croak(sprintf(ERROR_BADNAME, $class, $name)) unless $name =~ /^\w+$/;
702 if (defined(&$sub)) { # user subroutine
704 # This could be something that we've fatalised that
707 local $@; # Don't clobber anyone else's $@
709 if ( $Package_Fatal{$sub} and eval { prototype "CORE::$name" } ) {
711 # Something we previously made Fatal that was core.
712 # This is safe to replace with an autodying to core
716 $call = "CORE::$name";
717 $proto = prototype $call;
719 # We return our $sref from this subroutine later
720 # on, indicating this subroutine should be placed
721 # back when we're finished.
727 # A regular user sub, or a user sub wrapping a
731 $proto = prototype $sref;
736 } elsif ($sub eq $ini && $sub !~ /^CORE::GLOBAL::/) {
737 # Stray user subroutine
738 croak(sprintf(ERROR_NOTSUB,$sub));
740 } elsif ($name eq 'system') {
742 # If we're fatalising system, then we need to load
746 require IPC::System::Simple; # Only load it if we need it.
747 require autodie::exception::system;
750 if ($@) { croak ERROR_NO_IPC_SYS_SIMPLE; }
752 # Make sure we're using a recent version of ISS that actually
753 # support fatalised system.
754 if ($IPC::System::Simple::VERSION < MIN_IPC_SYS_SIMPLE_VER) {
756 ERROR_IPC_SYS_SIMPLE_OLD, MIN_IPC_SYS_SIMPLE_VER,
757 $IPC::System::Simple::VERSION
761 $call = 'CORE::system';
765 } elsif ($name eq 'exec') {
766 # Exec doesn't have a prototype. We don't care. This
767 # breaks the exotic form with lexical scope, and gives
768 # the regular form a "do or die" beaviour as expected.
770 $call = 'CORE::exec';
774 } else { # CORE subroutine
775 $proto = eval { prototype "CORE::$name" };
776 croak(sprintf(ERROR_NOT_BUILT,$name)) if $@;
777 croak(sprintf(ERROR_CANT_OVERRIDE,$name)) if not defined $proto;
779 $call = "CORE::$name";
782 if (defined $proto) {
783 $real_proto = " ($proto)";
789 my $true_name = $core ? $call : $sub;
791 # TODO: This caching works, but I don't like using $void and
792 # $lexical as keys. In particular, I suspect our code may end up
793 # wrapping already wrapped code when autodie and Fatal are used
796 # NB: We must use '$sub' (the name plus package) and not
797 # just '$name' (the short name) here. Failing to do so
798 # results code that's in the wrong package, and hence has
799 # access to the wrong package filehandles.
801 if (my $subref = $Cached_fatalised_sub{$class}{$sub}{$void}{$lexical}) {
802 $class->_install_subs($pkg, { $name => $subref });
808 local(\$", \$!) = (', ', 0); # TODO - Why do we do this?
811 # Don't have perl whine if exec fails, since we'll be handling
813 $code .= "no warnings qw(exec);\n" if $call eq "CORE::exec";
815 my @protos = fill_protos($proto);
816 $code .= $class->write_invocation($core, $call, $name, $void, $lexical, $sub, @protos);
818 warn $code if $Debug;
820 # I thought that changing package was a monumental waste of
821 # time for CORE subs, since they'll always be the same. However
822 # that's not the case, since they may refer to package-based
823 # filehandles (eg, with open).
825 # There is potential to more aggressively cache core subs
826 # that we know will never want to interact with package variables
831 no strict 'refs'; ## no critic # to avoid: Can't use string (...) as a symbol ref ...
832 $code = eval("package $pkg; use Carp; $code"); ## no critic
835 # For some reason, using a die, croak, or confess in here
836 # results in the error being completely surpressed. As such,
837 # we need to do our own reporting.
839 # TODO: Fix the above.
841 _autocroak("Internal error in autodie/Fatal processing $true_name: $@");
846 # Now we need to wrap our fatalised sub inside an itty bitty
847 # closure, which can detect if we've leaked into another file.
848 # Luckily, we only need to do this for lexical (autodie)
849 # subs. Fatal subs can leak all they want, it's considered
850 # a "feature" (or at least backwards compatible).
852 # TODO: Cache our leak guards!
854 # TODO: This is pretty hairy code. A lot more tests would
855 # be really nice for this.
866 # If we're inside a string eval, we can end up with a
867 # whacky filename. The following code allows autodie
868 # to propagate correctly into string evals.
870 my \$caller_level = 0;
872 while ( (caller \$caller_level)[1] =~ m{^\\(eval \\d+\\)\$} ) {
876 # If we're called from the correct file, then use the
878 goto &\$code if ((caller \$caller_level)[1] eq \$filename);
880 # Oh bother, we've leaked into another file. Call the
881 # original code. Note that \$sref may actually be a
882 # reference to a Fatalised version of a core built-in.
883 # That's okay, because Fatal *always* leaks between files.
885 goto &\$sref if \$sref;
889 # If we're here, it must have been a core subroutine called.
890 # Warning: The following code may disturb some viewers.
892 # TODO: It should be possible to combine this with
893 # write_invocation().
895 foreach my $proto (@protos) {
896 local $" = ", "; # So @args is formatted correctly.
897 my ($count, @args) = @$proto;
905 $leak_guard .= qq< croak "Internal error in Fatal/autodie. Leak-guard failure"; } >;
907 # warn "$leak_guard\n";
911 $leak_guard = eval $leak_guard; ## no critic
913 die "Internal error in $class: Leak-guard installation failure: $@" if $@;
916 $class->_install_subs($pkg, { $name => $leak_guard || $code });
918 $Cached_fatalised_sub{$class}{$sub}{$void}{$lexical} = $leak_guard || $code;
924 # This subroutine exists primarily so that child classes can override
925 # it to point to their own exception class. Doing this is significantly
926 # less complex than overriding throw()
928 sub exception_class { return "autodie::exception" };
931 my %exception_class_for;
935 my ($class, @args) = @_;
937 # Find our exception class if we need it.
938 my $exception_class =
939 $exception_class_for{$class} ||= $class->exception_class;
941 if (not $class_loaded{$exception_class}) {
942 if ($exception_class =~ /[^\w:']/) {
943 confess "Bad exception class '$exception_class'.\nThe '$class->exception_class' method wants to use $exception_class\nfor exceptions, but it contains characters which are not word-characters or colons.";
946 # Alas, Perl does turn barewords into modules unless they're
947 # actually barewords. As such, we're left doing a string eval
948 # to make sure we load our file correctly.
953 local $@; # We can't clobber $@, it's wrong!
954 eval "require $exception_class"; ## no critic
955 $E = $@; # Save $E despite ending our local.
958 # We need quotes around $@ to make sure it's stringified
959 # while still in scope. Without them, we run the risk of
960 # $@ having been cleared by us exiting the local() block.
962 confess "Failed to load '$exception_class'.\nThis may be a typo in the '$class->exception_class' method,\nor the '$exception_class' module may not exist.\n\n $E" if $E;
964 $class_loaded{$exception_class}++;
968 return $exception_class->new(@args);
972 # For some reason, dying while replacing our subs doesn't
973 # kill our calling program. It simply stops the loading of
974 # autodie and keeps going with everything else. The _autocroak
975 # sub allows us to die with a vegence. It should *only* ever be
976 # used for serious internal errors, since the results of it can't
980 warn Carp::longmess(@_);
984 package autodie::Scope::Guard;
986 # This code schedules the cleanup of subroutines at the end of
987 # scope. It's directly inspired by chocolateboy's excellent
988 # Scope::Guard module.
991 my ($class, $handler) = @_;
993 return bless $handler, $class;
1008 Fatal - Replace functions with equivalents which succeed or die
1012 use Fatal qw(open close);
1014 open(my $fh, "<", $filename); # No need to check errors!
1016 use File::Copy qw(move);
1019 move($file1, $file2); # No need to check errors!
1021 sub juggle { . . . }
1022 Fatal->import('juggle');
1024 =head1 BEST PRACTICE
1026 B<Fatal has been obsoleted by the new L<autodie> pragma.> Please use
1027 L<autodie> in preference to C<Fatal>. L<autodie> supports lexical scoping,
1028 throws real exception objects, and provides much nicer error messages.
1030 The use of C<:void> with Fatal is discouraged.
1034 C<Fatal> provides a way to conveniently replace
1035 functions which normally return a false value when they fail with
1036 equivalents which raise exceptions if they are not successful. This
1037 lets you use these functions without having to test their return
1038 values explicitly on each call. Exceptions can be caught using
1039 C<eval{}>. See L<perlfunc> and L<perlvar> for details.
1041 The do-or-die equivalents are set up simply by calling Fatal's
1042 C<import> routine, passing it the names of the functions to be
1043 replaced. You may wrap both user-defined functions and overridable
1044 CORE operators (except C<exec>, C<system>, C<print>, or any other
1045 built-in that cannot be expressed via prototypes) in this way.
1047 If the symbol C<:void> appears in the import list, then functions
1048 named later in that import list raise an exception only when
1049 these are called in void context--that is, when their return
1050 values are ignored. For example
1052 use Fatal qw/:void open close/;
1054 # properly checked, so no exception raised on error
1055 if (not open(my $fh, '<' '/bogotic') {
1056 warn "Can't open /bogotic: $!";
1059 # not checked, so error raises an exception
1062 The use of C<:void> is discouraged, as it can result in exceptions
1063 not being thrown if you I<accidentally> call a method without
1064 void context. Use L<autodie> instead if you need to be able to
1065 disable autodying/Fatal behaviour for a small block of code.
1071 =item Bad subroutine name for Fatal: %s
1073 You've called C<Fatal> with an argument that doesn't look like
1074 a subroutine name, nor a switch that this version of Fatal
1077 =item %s is not a Perl subroutine
1079 You've asked C<Fatal> to try and replace a subroutine which does not
1080 exist, or has not yet been defined.
1082 =item %s is neither a builtin, nor a Perl subroutine
1084 You've asked C<Fatal> to replace a subroutine, but it's not a Perl
1085 built-in, and C<Fatal> couldn't find it as a regular subroutine.
1086 It either doesn't exist or has not yet been defined.
1088 =item Cannot make the non-overridable %s fatal
1090 You've tried to use C<Fatal> on a Perl built-in that can't be
1091 overridden, such as C<print> or C<system>, which means that
1092 C<Fatal> can't help you, although some other modules might.
1093 See the L</"SEE ALSO"> section of this documentation.
1095 =item Internal error: %s
1097 You've found a bug in C<Fatal>. Please report it using
1098 the C<perlbug> command.
1104 C<Fatal> clobbers the context in which a function is called and always
1105 makes it a scalar context, except when the C<:void> tag is used.
1106 This problem does not exist in L<autodie>.
1108 "Used only once" warnings can be generated when C<autodie> or C<Fatal>
1109 is used with package filehandles (eg, C<FILE>). It's strongly recommended
1110 you use scalar filehandles instead.
1114 Original module by Lionel Cons (CERN).
1116 Prototype updates by Ilya Zakharevich <ilya@math.ohio-state.edu>.
1118 L<autodie> support, bugfixes, extended diagnostics, C<system>
1119 support, and major overhauling by Paul Fenwick <pjf@perltraining.com.au>
1123 This module is free software, you may distribute it under the
1124 same terms as Perl itself.
1128 L<autodie> for a nicer way to use lexical Fatal.
1130 L<IPC::System::Simple> for a similar idea for calls to C<system()>