This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
bump autodie version for blead test fix
[perl5.git] / cpan / autodie / lib / Fatal.pm
CommitLineData
e92e55da
MB
1package Fatal;
2
0b09a93a 3use 5.008; # 5.8.x needed for autodie
e92e55da
MB
4use Carp;
5use strict;
0b09a93a 6use warnings;
9b657a62 7use Tie::RefHash; # To cache subroutine refs
a009834b 8use Config;
9b657a62
PF
9
10use constant PERL510 => ( $] >= 5.010 );
e92e55da 11
0b09a93a
PF
12use constant LEXICAL_TAG => q{:lexical};
13use constant VOID_TAG => q{:void};
9b657a62 14use constant INSIST_TAG => q{!};
e92e55da 15
0b09a93a
PF
16use constant ERROR_NOARGS => 'Cannot use lexical %s with no arguments';
17use constant ERROR_VOID_LEX => VOID_TAG.' cannot be used with lexical scope';
18use constant ERROR_LEX_FIRST => LEXICAL_TAG.' must be used as first argument';
19use constant ERROR_NO_LEX => "no %s can only start with ".LEXICAL_TAG;
20use constant ERROR_BADNAME => "Bad subroutine name for %s: %s";
21use constant ERROR_NOTSUB => "%s is not a Perl subroutine";
22use constant ERROR_NOT_BUILT => "%s is neither a builtin, nor a Perl subroutine";
9b657a62
PF
23use constant ERROR_NOHINTS => "No user hints defined for %s";
24
0b09a93a
PF
25use constant ERROR_CANT_OVERRIDE => "Cannot make the non-overridable builtin %s fatal";
26
27use constant ERROR_NO_IPC_SYS_SIMPLE => "IPC::System::Simple required for Fatalised/autodying system()";
28
29use constant ERROR_IPC_SYS_SIMPLE_OLD => "IPC::System::Simple version %f required for Fatalised/autodying system(). We only have version %f";
30
31use constant ERROR_AUTODIE_CONFLICT => q{"no autodie '%s'" is not allowed while "use Fatal '%s'" is in effect};
32
33use constant ERROR_FATAL_CONFLICT => q{"use Fatal '%s'" is not allowed while "no autodie '%s'" is in effect};
34
9b657a62
PF
35use constant ERROR_58_HINTS => q{Non-subroutine %s hints for %s are not supported under Perl 5.8.x};
36
0b09a93a
PF
37# Older versions of IPC::System::Simple don't support all the
38# features we need.
39
40use constant MIN_IPC_SYS_SIMPLE_VER => 0.12;
41
42# All the Fatal/autodie modules share the same version number.
c2512f8a 43our $VERSION = '2.1001';
0b09a93a
PF
44
45our $Debug ||= 0;
46
47# EWOULDBLOCK values for systems that don't supply their own.
48# Even though this is defined with our, that's to help our
49# test code. Please don't rely upon this variable existing in
50# the future.
51
52our %_EWOULDBLOCK = (
53 MSWin32 => 33,
54);
55
a009834b
CBW
56# the linux parisc port has separate EAGAIN and EWOULDBLOCK,
57# and the kernel returns EAGAIN
58my $try_EAGAIN = ($^O eq 'linux' and $Config{archname} =~ /hppa|parisc/) ? 1 : 0;
59
0b09a93a
PF
60# We have some tags that can be passed in for use with import.
61# These are all assumed to be CORE::
62
63my %TAGS = (
64 ':io' => [qw(:dbm :file :filesys :ipc :socket
65 read seek sysread syswrite sysseek )],
66 ':dbm' => [qw(dbmopen dbmclose)],
67 ':file' => [qw(open close flock sysopen fcntl fileno binmode
a009834b 68 ioctl truncate chmod)],
0b09a93a
PF
69 ':filesys' => [qw(opendir closedir chdir link unlink rename mkdir
70 symlink rmdir readlink umask)],
71 ':ipc' => [qw(:msg :semaphore :shm pipe)],
72 ':msg' => [qw(msgctl msgget msgrcv msgsnd)],
73 ':threads' => [qw(fork)],
74 ':semaphore'=>[qw(semctl semget semop)],
75 ':shm' => [qw(shmctl shmget shmread)],
76 ':system' => [qw(system exec)],
77
78 # Can we use qw(getpeername getsockname)? What do they do on failure?
9b657a62 79 # TODO - Can socket return false?
0b09a93a
PF
80 ':socket' => [qw(accept bind connect getsockopt listen recv send
81 setsockopt shutdown socketpair)],
82
83 # Our defaults don't include system(), because it depends upon
84 # an optional module, and it breaks the exotic form.
85 #
86 # This *may* change in the future. I'd love IPC::System::Simple
87 # to be a dependency rather than a recommendation, and hence for
88 # system() to be autodying by default.
89
90 ':default' => [qw(:io :threads)],
91
a009834b
CBW
92 # Everything in v2.07 and brefore. This was :default less chmod.
93 ':v207' => [qw(:threads :dbm :filesys :ipc :socket read seek sysread
94 syswrite sysseek open close flock sysopen fcntl fileno
95 binmode ioctl truncate)],
96
0b09a93a
PF
97 # Version specific tags. These allow someone to specify
98 # use autodie qw(:1.994) and know exactly what they'll get.
99
a009834b
CBW
100 ':1.994' => [qw(:v207)],
101 ':1.995' => [qw(:v207)],
102 ':1.996' => [qw(:v207)],
103 ':1.997' => [qw(:v207)],
104 ':1.998' => [qw(:v207)],
105 ':1.999' => [qw(:v207)],
106 ':1.999_01' => [qw(:v207)],
107 ':2.00' => [qw(:v207)],
108 ':2.01' => [qw(:v207)],
109 ':2.02' => [qw(:v207)],
110 ':2.03' => [qw(:v207)],
111 ':2.04' => [qw(:v207)],
112 ':2.05' => [qw(:v207)],
113 ':2.06' => [qw(:v207)],
114 ':2.06_01' => [qw(:v207)],
115 ':2.07' => [qw(:v207)], # Last release without chmod
116 ':2.08' => [qw(:default)],
117 ':2.09' => [qw(:default)],
118 ':2.10' => [qw(:default)],
0b09a93a
PF
119);
120
a009834b
CBW
121# chmod was only introduced in 2.07
122
0b09a93a
PF
123$TAGS{':all'} = [ keys %TAGS ];
124
125# This hash contains subroutines for which we should
126# subroutine() // die() rather than subroutine() || die()
127
128my %Use_defined_or;
129
130# CORE::open returns undef on failure. It can legitimately return
131# 0 on success, eg: open(my $fh, '-|') || exec(...);
132
133@Use_defined_or{qw(
134 CORE::fork
135 CORE::recv
136 CORE::send
137 CORE::open
138 CORE::fileno
139 CORE::read
140 CORE::readlink
141 CORE::sysread
142 CORE::syswrite
143 CORE::sysseek
144 CORE::umask
145)} = ();
146
147# Cached_fatalised_sub caches the various versions of our
148# fatalised subs as they're produced. This means we don't
149# have to build our own replacement of CORE::open and friends
150# for every single package that wants to use them.
151
152my %Cached_fatalised_sub = ();
153
154# Every time we're called with package scope, we record the subroutine
155# (including package or CORE::) in %Package_Fatal. This allows us
156# to detect illegal combinations of autodie and Fatal, and makes sure
157# we don't accidently make a Fatal function autodying (which isn't
158# very useful).
159
160my %Package_Fatal = ();
161
162# The first time we're called with a user-sub, we cache it here.
163# In the case of a "no autodie ..." we put back the cached copy.
164
165my %Original_user_sub = ();
166
9b657a62
PF
167# Is_fatalised_sub simply records a big map of fatalised subroutine
168# refs. It means we can avoid repeating work, or fatalising something
169# we've already processed.
170
171my %Is_fatalised_sub = ();
172tie %Is_fatalised_sub, 'Tie::RefHash';
173
0b09a93a
PF
174# We use our package in a few hash-keys. Having it in a scalar is
175# convenient. The "guard $PACKAGE" string is used as a key when
176# setting up lexical guards.
177
178my $PACKAGE = __PACKAGE__;
179my $PACKAGE_GUARD = "guard $PACKAGE";
180my $NO_PACKAGE = "no $PACKAGE"; # Used to detect 'no autodie'
181
182# Here's where all the magic happens when someone write 'use Fatal'
183# or 'use autodie'.
e92e55da
MB
184
185sub import {
9b657a62 186 my $class = shift(@_);
a009834b 187 my @original_args = @_;
9b657a62
PF
188 my $void = 0;
189 my $lexical = 0;
190 my $insist_hints = 0;
0b09a93a
PF
191
192 my ($pkg, $filename) = caller();
193
194 @_ or return; # 'use Fatal' is a no-op.
195
196 # If we see the :lexical flag, then _all_ arguments are
197 # changed lexically
198
199 if ($_[0] eq LEXICAL_TAG) {
200 $lexical = 1;
201 shift @_;
202
203 # If we see no arguments and :lexical, we assume they
204 # wanted ':default'.
205
206 if (@_ == 0) {
207 push(@_, ':default');
208 }
209
210 # Don't allow :lexical with :void, it's needlessly confusing.
211 if ( grep { $_ eq VOID_TAG } @_ ) {
212 croak(ERROR_VOID_LEX);
213 }
214 }
215
216 if ( grep { $_ eq LEXICAL_TAG } @_ ) {
217 # If we see the lexical tag as the non-first argument, complain.
218 croak(ERROR_LEX_FIRST);
219 }
220
221 my @fatalise_these = @_;
222
223 # Thiese subs will get unloaded at the end of lexical scope.
224 my %unload_later;
225
226 # This hash helps us track if we've alredy done work.
227 my %done_this;
228
229 # NB: we're using while/shift rather than foreach, since
230 # we'll be modifying the array as we walk through it.
231
232 while (my $func = shift @fatalise_these) {
233
234 if ($func eq VOID_TAG) {
235
236 # When we see :void, set the void flag.
237 $void = 1;
238
9b657a62
PF
239 } elsif ($func eq INSIST_TAG) {
240
241 $insist_hints = 1;
242
0b09a93a
PF
243 } elsif (exists $TAGS{$func}) {
244
245 # When it's a tag, expand it.
246 push(@fatalise_these, @{ $TAGS{$func} });
247
248 } else {
249
250 # Otherwise, fatalise it.
251
9b657a62
PF
252 # Check to see if there's an insist flag at the front.
253 # If so, remove it, and insist we have hints for this sub.
254 my $insist_this;
255
256 if ($func =~ s/^!//) {
257 $insist_this = 1;
258 }
259
260 # TODO: Even if we've already fatalised, we should
261 # check we've done it with hints (if $insist_hints).
262
0b09a93a
PF
263 # If we've already made something fatal this call,
264 # then don't do it twice.
265
266 next if $done_this{$func};
267
268 # We're going to make a subroutine fatalistic.
269 # However if we're being invoked with 'use Fatal qw(x)'
270 # and we've already been called with 'no autodie qw(x)'
271 # in the same scope, we consider this to be an error.
272 # Mixing Fatal and autodie effects was considered to be
273 # needlessly confusing on p5p.
274
275 my $sub = $func;
276 $sub = "${pkg}::$sub" unless $sub =~ /::/;
277
278 # If we're being called as Fatal, and we've previously
279 # had a 'no X' in scope for the subroutine, then complain
280 # bitterly.
281
282 if (! $lexical and $^H{$NO_PACKAGE}{$sub}) {
283 croak(sprintf(ERROR_FATAL_CONFLICT, $func, $func));
284 }
285
286 # We're not being used in a confusing way, so make
287 # the sub fatal. Note that _make_fatal returns the
288 # old (original) version of the sub, or undef for
289 # built-ins.
290
291 my $sub_ref = $class->_make_fatal(
9b657a62
PF
292 $func, $pkg, $void, $lexical, $filename,
293 ( $insist_this || $insist_hints )
0b09a93a
PF
294 );
295
296 $done_this{$func}++;
297
298 $Original_user_sub{$sub} ||= $sub_ref;
299
300 # If we're making lexical changes, we need to arrange
301 # for them to be cleaned at the end of our scope, so
302 # record them here.
303
304 $unload_later{$func} = $sub_ref if $lexical;
305 }
306 }
307
308 if ($lexical) {
309
310 # Dark magic to have autodie work under 5.8
311 # Copied from namespace::clean, that copied it from
312 # autobox, that found it on an ancient scroll written
313 # in blood.
314
315 # This magic bit causes %^H to be lexically scoped.
316
317 $^H |= 0x020000;
318
319 # Our package guard gets invoked when we leave our lexical
320 # scope.
321
322 push(@ { $^H{$PACKAGE_GUARD} }, autodie::Scope::Guard->new(sub {
323 $class->_install_subs($pkg, \%unload_later);
324 }));
325
a009834b
CBW
326 # To allow others to determine when autodie was in scope,
327 # and with what arguments, we also set a %^H hint which
328 # is how we were called.
329
330 # This feature should be considered EXPERIMENTAL, and
331 # may change without notice. Please e-mail pjf@cpan.org
332 # if you're actually using it.
333
334 $^H{autodie} = "$PACKAGE @original_args";
335
0b09a93a
PF
336 }
337
338 return;
339
340}
341
342# The code here is originally lifted from namespace::clean,
343# by Robert "phaylon" Sedlacek.
344#
345# It's been redesigned after feedback from ikegami on perlmonks.
346# See http://perlmonks.org/?node_id=693338 . Ikegami rocks.
347#
348# Given a package, and hash of (subname => subref) pairs,
349# we install the given subroutines into the package. If
350# a subref is undef, the subroutine is removed. Otherwise
351# it replaces any existing subs which were already there.
352
353sub _install_subs {
354 my ($class, $pkg, $subs_to_reinstate) = @_;
355
356 my $pkg_sym = "${pkg}::";
357
358 while(my ($sub_name, $sub_ref) = each %$subs_to_reinstate) {
359
360 my $full_path = $pkg_sym.$sub_name;
361
362 # Copy symbols across to temp area.
363
364 no strict 'refs'; ## no critic
365
366 local *__tmp = *{ $full_path };
367
368 # Nuke the old glob.
369 { no strict; delete $pkg_sym->{$sub_name}; } ## no critic
370
9b657a62
PF
371 # Copy innocent bystanders back. Note that we lose
372 # formats; it seems that Perl versions up to 5.10.0
373 # have a bug which causes copying formats to end up in
374 # the scalar slot. Thanks to Ben Morrow for spotting this.
0b09a93a 375
9b657a62 376 foreach my $slot (qw( SCALAR ARRAY HASH IO ) ) {
0b09a93a
PF
377 next unless defined *__tmp{ $slot };
378 *{ $full_path } = *__tmp{ $slot };
379 }
380
381 # Put back the old sub (if there was one).
382
383 if ($sub_ref) {
384
385 no strict; ## no critic
386 *{ $pkg_sym . $sub_name } = $sub_ref;
387 }
388 }
389
390 return;
391}
392
393sub unimport {
394 my $class = shift;
395
396 # Calling "no Fatal" must start with ":lexical"
397 if ($_[0] ne LEXICAL_TAG) {
398 croak(sprintf(ERROR_NO_LEX,$class));
399 }
400
401 shift @_; # Remove :lexical
402
403 my $pkg = (caller)[0];
404
405 # If we've been called with arguments, then the developer
406 # has explicitly stated 'no autodie qw(blah)',
407 # in which case, we disable Fatalistic behaviour for 'blah'.
408
409 my @unimport_these = @_ ? @_ : ':all';
410
411 while (my $symbol = shift @unimport_these) {
412
413 if ($symbol =~ /^:/) {
414
415 # Looks like a tag! Expand it!
416 push(@unimport_these, @{ $TAGS{$symbol} });
417
418 next;
419 }
420
421 my $sub = $symbol;
422 $sub = "${pkg}::$sub" unless $sub =~ /::/;
423
424 # If 'blah' was already enabled with Fatal (which has package
425 # scope) then, this is considered an error.
426
427 if (exists $Package_Fatal{$sub}) {
428 croak(sprintf(ERROR_AUTODIE_CONFLICT,$symbol,$symbol));
429 }
430
431 # Record 'no autodie qw($sub)' as being in effect.
432 # This is to catch conflicting semantics elsewhere
433 # (eg, mixing Fatal with no autodie)
434
435 $^H{$NO_PACKAGE}{$sub} = 1;
436
437 if (my $original_sub = $Original_user_sub{$sub}) {
438 # Hey, we've got an original one of these, put it back.
439 $class->_install_subs($pkg, { $symbol => $original_sub });
440 next;
441 }
442
443 # We don't have an original copy of the sub, on the assumption
444 # it's core (or doesn't exist), we'll just nuke it.
445
446 $class->_install_subs($pkg,{ $symbol => undef });
447
448 }
449
450 return;
451
452}
453
454# TODO - This is rather terribly inefficient right now.
455
456# NB: Perl::Critic's dump-autodie-tag-contents depends upon this
457# continuing to work.
458
459{
460 my %tag_cache;
461
462 sub _expand_tag {
463 my ($class, $tag) = @_;
464
465 if (my $cached = $tag_cache{$tag}) {
466 return $cached;
467 }
468
469 if (not exists $TAGS{$tag}) {
470 croak "Invalid exception class $tag";
471 }
472
473 my @to_process = @{$TAGS{$tag}};
474
475 my @taglist = ();
476
477 while (my $item = shift @to_process) {
478 if ($item =~ /^:/) {
a009834b 479 # Expand :tags
0b09a93a 480 push(@to_process, @{$TAGS{$item}} );
a009834b
CBW
481 }
482 else {
0b09a93a
PF
483 push(@taglist, "CORE::$item");
484 }
485 }
486
487 $tag_cache{$tag} = \@taglist;
488
489 return \@taglist;
490
491 }
492
e92e55da
MB
493}
494
0b09a93a 495# This code is from the original Fatal. It scares me.
9b657a62
PF
496# It is 100% compatible with the 5.10.0 Fatal module, right down
497# to the scary 'XXXX' comment. ;)
0b09a93a 498
e92e55da 499sub fill_protos {
0b09a93a
PF
500 my $proto = shift;
501 my ($n, $isref, @out, @out1, $seen_semi) = -1;
502 while ($proto =~ /\S/) {
503 $n++;
504 push(@out1,[$n,@out]) if $seen_semi;
505 push(@out, $1 . "{\$_[$n]}"), next if $proto =~ s/^\s*\\([\@%\$\&])//;
506 push(@out, "\$_[$n]"), next if $proto =~ s/^\s*([_*\$&])//;
507 push(@out, "\@_[$n..\$#_]"), last if $proto =~ s/^\s*(;\s*)?\@//;
508 $seen_semi = 1, $n--, next if $proto =~ s/^\s*;//; # XXXX ????
509 die "Internal error: Unknown prototype letters: \"$proto\"";
510 }
511 push(@out1,[$n+1,@out]);
512 return @out1;
e92e55da
MB
513}
514
9b657a62
PF
515# This is a backwards compatible version of _write_invocation. It's
516# recommended you don't use it.
0b09a93a 517
e92e55da 518sub write_invocation {
9b657a62
PF
519 my ($core, $call, $name, $void, @args) = @_;
520
521 return Fatal->_write_invocation(
522 $core, $call, $name, $void,
523 0, # Lexical flag
524 undef, # Sub, unused in legacy mode
525 undef, # Subref, unused in legacy mode.
526 @args
527 );
528}
529
530# This version of _write_invocation is used internally. It's not
531# recommended you call it from external code, as the interface WILL
532# change in the future.
533
534sub _write_invocation {
535
536 my ($class, $core, $call, $name, $void, $lexical, $sub, $sref, @argvs) = @_;
0b09a93a
PF
537
538 if (@argvs == 1) { # No optional arguments
539
540 my @argv = @{$argvs[0]};
541 shift @argv;
542
9b657a62 543 return $class->_one_invocation($core,$call,$name,$void,$sub,! $lexical, $sref, @argv);
0b09a93a
PF
544
545 } else {
546 my $else = "\t";
547 my (@out, @argv, $n);
548 while (@argvs) {
549 @argv = @{shift @argvs};
550 $n = shift @argv;
551
a009834b
CBW
552 my $condition = "\@_ == $n";
553
554 if (@argv and $argv[-1] =~ /#_/) {
555 # This argv ends with '@' in the prototype, so it matches
556 # any number of args >= the number of expressions in the
557 # argv.
558 $condition = "\@_ >= $n";
559 }
560
561 push @out, "${else}if ($condition) {\n";
562
0b09a93a
PF
563 $else = "\t} els";
564
9b657a62 565 push @out, $class->_one_invocation($core,$call,$name,$void,$sub,! $lexical, $sref, @argv);
0b09a93a 566 }
9b657a62 567 push @out, qq[
0b09a93a 568 }
9b657a62 569 die "Internal error: $name(\@_): Do not expect to get ", scalar(\@_), " arguments";
0b09a93a
PF
570 ];
571
572 return join '', @out;
573 }
e92e55da
MB
574}
575
9b657a62
PF
576
577# This is a slim interface to ensure backward compatibility with
578# anyone doing very foolish things with old versions of Fatal.
579
e92e55da 580sub one_invocation {
9b657a62
PF
581 my ($core, $call, $name, $void, @argv) = @_;
582
583 return Fatal->_one_invocation(
584 $core, $call, $name, $void,
585 undef, # Sub. Unused in back-compat mode.
586 1, # Back-compat flag
587 undef, # Subref, unused in back-compat mode.
588 @argv
589 );
590
591}
592
593# This is the internal interface that generates code.
594# NOTE: This interface WILL change in the future. Please do not
595# call this subroutine directly.
596
597# TODO: Whatever's calling this code has already looked up hints. Pass
598# them in, rather than look them up a second time.
599
600sub _one_invocation {
601 my ($class, $core, $call, $name, $void, $sub, $back_compat, $sref, @argv) = @_;
602
0b09a93a
PF
603
604 # If someone is calling us directly (a child class perhaps?) then
605 # they could try to mix void without enabling backwards
606 # compatibility. We just don't support this at all, so we gripe
607 # about it rather than doing something unwise.
608
609 if ($void and not $back_compat) {
610 Carp::confess("Internal error: :void mode not supported with $class");
611 }
612
613 # @argv only contains the results of the in-built prototype
614 # function, and is therefore safe to interpolate in the
615 # code generators below.
616
617 # TODO - The following clobbers context, but that's what the
618 # old Fatal did. Do we care?
619
620 if ($back_compat) {
621
9b657a62
PF
622 # Use Fatal qw(system) will never be supported. It generated
623 # a compile-time error with legacy Fatal, and there's no reason
624 # to support it when autodie does a better job.
0b09a93a
PF
625
626 if ($call eq 'CORE::system') {
627 return q{
9b657a62 628 croak("UNIMPLEMENTED: use Fatal qw(system) not supported.");
0b09a93a
PF
629 };
630 }
631
632 local $" = ', ';
633
634 if ($void) {
635 return qq/return (defined wantarray)?$call(@argv):
a009834b
CBW
636 $call(@argv) || Carp::croak("Can't $name(\@_)/ .
637 ($core ? ': $!' : ', \$! is \"$!\"') . '")'
0b09a93a 638 } else {
a009834b
CBW
639 return qq{return $call(@argv) || Carp::croak("Can't $name(\@_)} .
640 ($core ? ': $!' : ', \$! is \"$!\"') . '")';
0b09a93a
PF
641 }
642 }
643
644 # The name of our original function is:
645 # $call if the function is CORE
646 # $sub if our function is non-CORE
647
648 # The reason for this is that $call is what we're actualling
649 # calling. For our core functions, this is always
650 # CORE::something. However for user-defined subs, we're about to
651 # replace whatever it is that we're calling; as such, we actually
652 # calling a subroutine ref.
653
9b657a62
PF
654 my $human_sub_name = $core ? $call : $sub;
655
656 # Should we be testing to see if our result is defined, or
657 # just true?
658
659 my $use_defined_or;
660
661 my $hints; # All user-sub hints, including list hints.
662
663 if ( $core ) {
664
665 # Core hints are built into autodie.
666
667 $use_defined_or = exists ( $Use_defined_or{$call} );
668
669 }
670 else {
671
672 # User sub hints are looked up using autodie::hints,
673 # since users may wish to add their own hints.
674
675 require autodie::hints;
676
677 $hints = autodie::hints->get_hints_for( $sref );
eb8d423f
PF
678
679 # We'll look up the sub's fullname. This means we
680 # get better reports of where it came from in our
681 # error messages, rather than what imported it.
682
683 $human_sub_name = autodie::hints->sub_fullname( $sref );
684
9b657a62 685 }
0b09a93a 686
9b657a62 687 # Checks for special core subs.
0b09a93a
PF
688
689 if ($call eq 'CORE::system') {
690
691 # Leverage IPC::System::Simple if we're making an autodying
692 # system.
693
694 local $" = ", ";
695
696 # We need to stash $@ into $E, rather than using
697 # local $@ for the whole sub. If we don't then
698 # any exceptions from internal errors in autodie/Fatal
699 # will mysteriously disappear before propogating
700 # upwards.
701
702 return qq{
703 my \$retval;
704 my \$E;
705
706
707 {
708 local \$@;
709
710 eval {
711 \$retval = IPC::System::Simple::system(@argv);
712 };
713
714 \$E = \$@;
715 }
716
717 if (\$E) {
718
9b657a62 719 # TODO - This can't be overridden in child
0b09a93a
PF
720 # classes!
721
722 die autodie::exception::system->new(
723 function => q{CORE::system}, args => [ @argv ],
724 message => "\$E", errno => \$!,
725 );
726 }
727
728 return \$retval;
729 };
730
731 }
732
0b09a93a
PF
733 local $" = ', ';
734
735 # If we're going to throw an exception, here's the code to use.
736 my $die = qq{
737 die $class->throw(
9b657a62 738 function => q{$human_sub_name}, args => [ @argv ],
0b09a93a 739 pragma => q{$class}, errno => \$!,
eb8d423f 740 context => \$context, return => \$retval,
7840a289 741 eval_error => \$@
0b09a93a
PF
742 )
743 };
744
745 if ($call eq 'CORE::flock') {
746
747 # flock needs special treatment. When it fails with
748 # LOCK_UN and EWOULDBLOCK, then it's not really fatal, it just
749 # means we couldn't get the lock right now.
750
751 require POSIX; # For POSIX::EWOULDBLOCK
752
753 local $@; # Don't blat anyone else's $@.
754
755 # Ensure that our vendor supports EWOULDBLOCK. If they
756 # don't (eg, Windows), then we use known values for its
757 # equivalent on other systems.
758
759 my $EWOULDBLOCK = eval { POSIX::EWOULDBLOCK(); }
760 || $_EWOULDBLOCK{$^O}
761 || _autocroak("Internal error - can't overload flock - EWOULDBLOCK not defined on this system.");
a009834b
CBW
762 my $EAGAIN = $EWOULDBLOCK;
763 if ($try_EAGAIN) {
764 $EAGAIN = eval { POSIX::EAGAIN(); }
765 || _autocroak("Internal error - can't overload flock - EAGAIN not defined on this system.");
766 }
0b09a93a
PF
767
768 require Fcntl; # For Fcntl::LOCK_NB
769
770 return qq{
771
eb8d423f
PF
772 my \$context = wantarray() ? "list" : "scalar";
773
0b09a93a
PF
774 # Try to flock. If successful, return it immediately.
775
776 my \$retval = $call(@argv);
777 return \$retval if \$retval;
778
779 # If we failed, but we're using LOCK_NB and
780 # returned EWOULDBLOCK, it's not a real error.
781
a009834b
CBW
782 if (\$_[1] & Fcntl::LOCK_NB() and
783 (\$! == $EWOULDBLOCK or
784 ($try_EAGAIN and \$! == $EAGAIN ))) {
0b09a93a
PF
785 return \$retval;
786 }
787
788 # Otherwise, we failed. Die noisily.
789
790 $die;
791
792 };
793 }
794
795 # AFAIK everything that can be given an unopned filehandle
796 # will fail if it tries to use it, so we don't really need
797 # the 'unopened' warning class here. Especially since they
798 # then report the wrong line number.
799
eb8d423f
PF
800 # Other warnings are disabled because they produce excessive
801 # complaints from smart-match hints under 5.10.1.
802
9b657a62 803 my $code = qq[
eb8d423f 804 no warnings qw(unopened uninitialized numeric);
0b09a93a
PF
805
806 if (wantarray) {
807 my \@results = $call(@argv);
eb8d423f
PF
808 my \$retval = \\\@results;
809 my \$context = "list";
9b657a62
PF
810
811 ];
812
813 if ( $hints and ( ref($hints->{list} ) || "" ) eq 'CODE' ) {
814
815 # NB: Subroutine hints are passed as a full list.
816 # This differs from the 5.10.0 smart-match behaviour,
817 # but means that context unaware subroutines can use
818 # the same hints in both list and scalar context.
819
820 $code .= qq{
821 if ( \$hints->{list}->(\@results) ) { $die };
822 };
823 }
824 elsif ( PERL510 and $hints ) {
825 $code .= qq{
826 if ( \@results ~~ \$hints->{list} ) { $die };
827 };
828 }
829 elsif ( $hints ) {
830 croak sprintf(ERROR_58_HINTS, 'list', $sub);
831 }
832 else {
833 $code .= qq{
834 # An empty list, or a single undef is failure
0b09a93a
PF
835 if (! \@results or (\@results == 1 and ! defined \$results[0])) {
836 $die;
9b657a62
PF
837 }
838 }
839 }
840
841 # Tidy up the end of our wantarray call.
842
843 $code .= qq[
0b09a93a
PF
844 return \@results;
845 }
9b657a62 846 ];
0b09a93a 847
0b09a93a 848
9b657a62
PF
849 # Otherwise, we're in scalar context.
850 # We're never in a void context, since we have to look
851 # at the result.
852
853 $code .= qq{
eb8d423f
PF
854 my \$retval = $call(@argv);
855 my \$context = "scalar";
9b657a62
PF
856 };
857
858 if ( $hints and ( ref($hints->{scalar} ) || "" ) eq 'CODE' ) {
859
860 # We always call code refs directly, since that always
861 # works in 5.8.x, and always works in 5.10.1
862
863 return $code .= qq{
eb8d423f
PF
864 if ( \$hints->{scalar}->(\$retval) ) { $die };
865 return \$retval;
9b657a62 866 };
0b09a93a 867
9b657a62
PF
868 }
869 elsif (PERL510 and $hints) {
870 return $code . qq{
871
eb8d423f 872 if ( \$retval ~~ \$hints->{scalar} ) { $die };
9b657a62 873
eb8d423f 874 return \$retval;
9b657a62
PF
875 };
876 }
877 elsif ( $hints ) {
878 croak sprintf(ERROR_58_HINTS, 'scalar', $sub);
879 }
880
881 return $code .
882 ( $use_defined_or ? qq{
0b09a93a 883
eb8d423f 884 $die if not defined \$retval;
0b09a93a 885
eb8d423f 886 return \$retval;
0b09a93a
PF
887
888 } : qq{
889
eb8d423f 890 return \$retval || $die;
0b09a93a
PF
891
892 } ) ;
893
e92e55da
MB
894}
895
0b09a93a
PF
896# This returns the old copy of the sub, so we can
897# put it back at end of scope.
898
899# TODO : Check to make sure prototypes are restored correctly.
900
901# TODO: Taking a huge list of arguments is awful. Rewriting to
902# take a hash would be lovely.
903
9b657a62
PF
904# TODO - BACKCOMPAT - This is not yet compatible with 5.10.0
905
e92e55da 906sub _make_fatal {
9b657a62
PF
907 my($class, $sub, $pkg, $void, $lexical, $filename, $insist) = @_;
908 my($name, $code, $sref, $real_proto, $proto, $core, $call, $hints);
e92e55da
MB
909 my $ini = $sub;
910
911 $sub = "${pkg}::$sub" unless $sub =~ /::/;
0b09a93a
PF
912
913 # Figure if we're using lexical or package semantics and
914 # twiddle the appropriate bits.
915
916 if (not $lexical) {
917 $Package_Fatal{$sub} = 1;
918 }
919
920 # TODO - We *should* be able to do skipping, since we know when
921 # we've lexicalised / unlexicalised a subroutine.
922
e92e55da
MB
923 $name = $sub;
924 $name =~ s/.*::// or $name =~ s/^&//;
0b09a93a
PF
925
926 warn "# _make_fatal: sub=$sub pkg=$pkg name=$name void=$void\n" if $Debug;
927 croak(sprintf(ERROR_BADNAME, $class, $name)) unless $name =~ /^\w+$/;
928
929 if (defined(&$sub)) { # user subroutine
930
9b657a62
PF
931 # NOTE: Previously we would localise $@ at this point, so
932 # the following calls to eval {} wouldn't interfere with anything
933 # that's already in $@. Unfortunately, it would also stop
934 # any of our croaks from triggering(!), which is even worse.
935
0b09a93a
PF
936 # This could be something that we've fatalised that
937 # was in core.
938
9b657a62 939 if ( $Package_Fatal{$sub} and do { local $@; eval { prototype "CORE::$name" } } ) {
0b09a93a
PF
940
941 # Something we previously made Fatal that was core.
942 # This is safe to replace with an autodying to core
943 # version.
944
945 $core = 1;
946 $call = "CORE::$name";
947 $proto = prototype $call;
948
949 # We return our $sref from this subroutine later
950 # on, indicating this subroutine should be placed
951 # back when we're finished.
952
953 $sref = \&$sub;
954
955 } else {
956
9b657a62
PF
957 # If this is something we've already fatalised or played with,
958 # then look-up the name of the original sub for the rest of
959 # our processing.
960
961 $sub = $Is_fatalised_sub{\&$sub} || $sub;
962
0b09a93a
PF
963 # A regular user sub, or a user sub wrapping a
964 # core sub.
965
966 $sref = \&$sub;
967 $proto = prototype $sref;
968 $call = '&$sref';
9b657a62
PF
969 require autodie::hints;
970
971 $hints = autodie::hints->get_hints_for( $sref );
972
973 # If we've insisted on hints, but don't have them, then
974 # bail out!
975
976 if ($insist and not $hints) {
977 croak(sprintf(ERROR_NOHINTS, $name));
978 }
979
980 # Otherwise, use the default hints if we don't have
981 # any.
982
983 $hints ||= autodie::hints::DEFAULT_HINTS();
0b09a93a
PF
984
985 }
986
910ad8dd 987 } elsif ($sub eq $ini && $sub !~ /^CORE::GLOBAL::/) {
0b09a93a
PF
988 # Stray user subroutine
989 croak(sprintf(ERROR_NOTSUB,$sub));
990
991 } elsif ($name eq 'system') {
992
993 # If we're fatalising system, then we need to load
994 # helper code.
995
9b657a62
PF
996 # The business with $E is to avoid clobbering our caller's
997 # $@, and to avoid $@ being localised when we croak.
0b09a93a 998
9b657a62 999 my $E;
0b09a93a 1000
9b657a62
PF
1001 {
1002 local $@;
1003
1004 eval {
1005 require IPC::System::Simple; # Only load it if we need it.
1006 require autodie::exception::system;
1007 };
1008 $E = $@;
1009 }
1010
1011 if ($E) { croak ERROR_NO_IPC_SYS_SIMPLE; }
1012
1013 # Make sure we're using a recent version of ISS that actually
1014 # support fatalised system.
1015 if ($IPC::System::Simple::VERSION < MIN_IPC_SYS_SIMPLE_VER) {
1016 croak sprintf(
1017 ERROR_IPC_SYS_SIMPLE_OLD, MIN_IPC_SYS_SIMPLE_VER,
1018 $IPC::System::Simple::VERSION
1019 );
1020 }
0b09a93a
PF
1021
1022 $call = 'CORE::system';
1023 $name = 'system';
db4e6d09 1024 $core = 1;
0b09a93a
PF
1025
1026 } elsif ($name eq 'exec') {
1027 # Exec doesn't have a prototype. We don't care. This
1028 # breaks the exotic form with lexical scope, and gives
1029 # the regular form a "do or die" beaviour as expected.
1030
1031 $call = 'CORE::exec';
1032 $name = 'exec';
1033 $core = 1;
1034
1035 } else { # CORE subroutine
9b657a62
PF
1036 my $E;
1037 {
1038 local $@;
1039 $proto = eval { prototype "CORE::$name" };
1040 $E = $@;
1041 }
1042 croak(sprintf(ERROR_NOT_BUILT,$name)) if $E;
0b09a93a
PF
1043 croak(sprintf(ERROR_CANT_OVERRIDE,$name)) if not defined $proto;
1044 $core = 1;
1045 $call = "CORE::$name";
e92e55da 1046 }
0b09a93a 1047
e92e55da 1048 if (defined $proto) {
0b09a93a 1049 $real_proto = " ($proto)";
e92e55da 1050 } else {
0b09a93a
PF
1051 $real_proto = '';
1052 $proto = '@';
1053 }
1054
1055 my $true_name = $core ? $call : $sub;
1056
1057 # TODO: This caching works, but I don't like using $void and
1058 # $lexical as keys. In particular, I suspect our code may end up
1059 # wrapping already wrapped code when autodie and Fatal are used
1060 # together.
1061
1062 # NB: We must use '$sub' (the name plus package) and not
1063 # just '$name' (the short name) here. Failing to do so
1064 # results code that's in the wrong package, and hence has
1065 # access to the wrong package filehandles.
1066
1067 if (my $subref = $Cached_fatalised_sub{$class}{$sub}{$void}{$lexical}) {
1068 $class->_install_subs($pkg, { $name => $subref });
1069 return $sref;
e92e55da 1070 }
0b09a93a
PF
1071
1072 $code = qq[
1073 sub$real_proto {
1074 local(\$", \$!) = (', ', 0); # TODO - Why do we do this?
1075 ];
1076
1077 # Don't have perl whine if exec fails, since we'll be handling
1078 # the exception now.
1079 $code .= "no warnings qw(exec);\n" if $call eq "CORE::exec";
1080
e92e55da 1081 my @protos = fill_protos($proto);
9b657a62 1082 $code .= $class->_write_invocation($core, $call, $name, $void, $lexical, $sub, $sref, @protos);
e92e55da 1083 $code .= "}\n";
0b09a93a
PF
1084 warn $code if $Debug;
1085
1086 # I thought that changing package was a monumental waste of
1087 # time for CORE subs, since they'll always be the same. However
1088 # that's not the case, since they may refer to package-based
1089 # filehandles (eg, with open).
1090 #
1091 # There is potential to more aggressively cache core subs
1092 # that we know will never want to interact with package variables
1093 # and filehandles.
1094
2ba6ecf4 1095 {
0b09a93a 1096 no strict 'refs'; ## no critic # to avoid: Can't use string (...) as a symbol ref ...
0b09a93a 1097
9b657a62
PF
1098 my $E;
1099
1100 {
1101 local $@;
a009834b 1102 $code = eval("package $pkg; require Carp; $code"); ## no critic
9b657a62
PF
1103 $E = $@;
1104 }
0b09a93a 1105
9b657a62
PF
1106 if (not $code) {
1107 croak("Internal error in autodie/Fatal processing $true_name: $E");
0b09a93a
PF
1108
1109 }
1110 }
1111
1112 # Now we need to wrap our fatalised sub inside an itty bitty
1113 # closure, which can detect if we've leaked into another file.
1114 # Luckily, we only need to do this for lexical (autodie)
1115 # subs. Fatal subs can leak all they want, it's considered
1116 # a "feature" (or at least backwards compatible).
1117
1118 # TODO: Cache our leak guards!
1119
1120 # TODO: This is pretty hairy code. A lot more tests would
1121 # be really nice for this.
1122
1123 my $leak_guard;
1124
1125 if ($lexical) {
1126
1127 $leak_guard = qq<
1128 package $pkg;
1129
1130 sub$real_proto {
1131
db4e6d09
PF
1132 # If we're inside a string eval, we can end up with a
1133 # whacky filename. The following code allows autodie
1134 # to propagate correctly into string evals.
1135
1136 my \$caller_level = 0;
1137
b0745470
PF
1138 my \$caller;
1139
1140 while ( (\$caller = (caller \$caller_level)[1]) =~ m{^\\(eval \\d+\\)\$} ) {
1141
1142 # If our filename is actually an eval, and we
1143 # reach it, then go to our autodying code immediatately.
1144
1145 goto &\$code if (\$caller eq \$filename);
db4e6d09
PF
1146 \$caller_level++;
1147 }
1148
b0745470
PF
1149 # We're now out of the eval stack.
1150
0b09a93a
PF
1151 # If we're called from the correct file, then use the
1152 # autodying code.
db4e6d09 1153 goto &\$code if ((caller \$caller_level)[1] eq \$filename);
0b09a93a
PF
1154
1155 # Oh bother, we've leaked into another file. Call the
1156 # original code. Note that \$sref may actually be a
1157 # reference to a Fatalised version of a core built-in.
1158 # That's okay, because Fatal *always* leaks between files.
1159
1160 goto &\$sref if \$sref;
1161 >;
1162
1163
1164 # If we're here, it must have been a core subroutine called.
1165 # Warning: The following code may disturb some viewers.
1166
1167 # TODO: It should be possible to combine this with
1168 # write_invocation().
1169
1170 foreach my $proto (@protos) {
1171 local $" = ", "; # So @args is formatted correctly.
1172 my ($count, @args) = @$proto;
1173 $leak_guard .= qq<
1174 if (\@_ == $count) {
1175 return $call(@args);
1176 }
1177 >;
1178 }
1179
a009834b 1180 $leak_guard .= qq< Carp::croak("Internal error in Fatal/autodie. Leak-guard failure"); } >;
0b09a93a
PF
1181
1182 # warn "$leak_guard\n";
1183
9b657a62
PF
1184 my $E;
1185 {
1186 local $@;
1187
1188 $leak_guard = eval $leak_guard; ## no critic
0b09a93a 1189
9b657a62
PF
1190 $E = $@;
1191 }
0b09a93a 1192
9b657a62 1193 die "Internal error in $class: Leak-guard installation failure: $E" if $E;
0b09a93a
PF
1194 }
1195
9b657a62
PF
1196 my $installed_sub = $leak_guard || $code;
1197
1198 $class->_install_subs($pkg, { $name => $installed_sub });
1199
1200 $Cached_fatalised_sub{$class}{$sub}{$void}{$lexical} = $installed_sub;
1201
1202 # Cache that we've now overriddent this sub. If we get called
1203 # again, we may need to find that find subroutine again (eg, for hints).
0b09a93a 1204
9b657a62 1205 $Is_fatalised_sub{$installed_sub} = $sref;
0b09a93a
PF
1206
1207 return $sref;
1208
1209}
1210
1211# This subroutine exists primarily so that child classes can override
1212# it to point to their own exception class. Doing this is significantly
1213# less complex than overriding throw()
1214
1215sub exception_class { return "autodie::exception" };
1216
1217{
1218 my %exception_class_for;
1219 my %class_loaded;
1220
1221 sub throw {
1222 my ($class, @args) = @_;
1223
1224 # Find our exception class if we need it.
1225 my $exception_class =
1226 $exception_class_for{$class} ||= $class->exception_class;
1227
1228 if (not $class_loaded{$exception_class}) {
1229 if ($exception_class =~ /[^\w:']/) {
1230 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.";
1231 }
1232
1233 # Alas, Perl does turn barewords into modules unless they're
1234 # actually barewords. As such, we're left doing a string eval
1235 # to make sure we load our file correctly.
1236
1237 my $E;
1238
1239 {
1240 local $@; # We can't clobber $@, it's wrong!
1241 eval "require $exception_class"; ## no critic
1242 $E = $@; # Save $E despite ending our local.
1243 }
1244
1245 # We need quotes around $@ to make sure it's stringified
1246 # while still in scope. Without them, we run the risk of
1247 # $@ having been cleared by us exiting the local() block.
1248
1249 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;
1250
1251 $class_loaded{$exception_class}++;
1252
1253 }
1254
1255 return $exception_class->new(@args);
2ba6ecf4 1256 }
e92e55da
MB
1257}
1258
0b09a93a
PF
1259# For some reason, dying while replacing our subs doesn't
1260# kill our calling program. It simply stops the loading of
1261# autodie and keeps going with everything else. The _autocroak
1262# sub allows us to die with a vegence. It should *only* ever be
1263# used for serious internal errors, since the results of it can't
1264# be captured.
1265
1266sub _autocroak {
1267 warn Carp::longmess(@_);
1268 exit(255); # Ugh!
1269}
1270
1271package autodie::Scope::Guard;
1272
1273# This code schedules the cleanup of subroutines at the end of
1274# scope. It's directly inspired by chocolateboy's excellent
1275# Scope::Guard module.
1276
1277sub new {
1278 my ($class, $handler) = @_;
1279
1280 return bless $handler, $class;
1281}
1282
1283sub DESTROY {
1284 my ($self) = @_;
1285
1286 $self->();
1287}
1288
e92e55da
MB
12891;
1290
1291__END__
1292
1293=head1 NAME
1294
0b09a93a 1295Fatal - Replace functions with equivalents which succeed or die
e92e55da
MB
1296
1297=head1 SYNOPSIS
1298
1299 use Fatal qw(open close);
1300
0b09a93a
PF
1301 open(my $fh, "<", $filename); # No need to check errors!
1302
1303 use File::Copy qw(move);
1304 use Fatal qw(move);
1305
1306 move($file1, $file2); # No need to check errors!
1307
e92e55da 1308 sub juggle { . . . }
0b09a93a
PF
1309 Fatal->import('juggle');
1310
1311=head1 BEST PRACTICE
1312
1313B<Fatal has been obsoleted by the new L<autodie> pragma.> Please use
1314L<autodie> in preference to C<Fatal>. L<autodie> supports lexical scoping,
1315throws real exception objects, and provides much nicer error messages.
1316
1317The use of C<:void> with Fatal is discouraged.
e92e55da
MB
1318
1319=head1 DESCRIPTION
1320
0b09a93a
PF
1321C<Fatal> provides a way to conveniently replace
1322functions which normally return a false value when they fail with
1323equivalents which raise exceptions if they are not successful. This
1324lets you use these functions without having to test their return
1325values explicitly on each call. Exceptions can be caught using
1326C<eval{}>. See L<perlfunc> and L<perlvar> for details.
e92e55da
MB
1327
1328The do-or-die equivalents are set up simply by calling Fatal's
1329C<import> routine, passing it the names of the functions to be
1330replaced. You may wrap both user-defined functions and overridable
0b09a93a
PF
1331CORE operators (except C<exec>, C<system>, C<print>, or any other
1332built-in that cannot be expressed via prototypes) in this way.
e92e55da 1333
91c7a880
GS
1334If the symbol C<:void> appears in the import list, then functions
1335named later in that import list raise an exception only when
1336these are called in void context--that is, when their return
1337values are ignored. For example
1338
0b09a93a 1339 use Fatal qw/:void open close/;
91c7a880 1340
0b09a93a 1341 # properly checked, so no exception raised on error
9b657a62 1342 if (not open(my $fh, '<', '/bogotic') {
0b09a93a
PF
1343 warn "Can't open /bogotic: $!";
1344 }
91c7a880 1345
0b09a93a
PF
1346 # not checked, so error raises an exception
1347 close FH;
1348
1349The use of C<:void> is discouraged, as it can result in exceptions
1350not being thrown if you I<accidentally> call a method without
1351void context. Use L<autodie> instead if you need to be able to
1352disable autodying/Fatal behaviour for a small block of code.
1353
1354=head1 DIAGNOSTICS
1355
1356=over 4
1357
1358=item Bad subroutine name for Fatal: %s
1359
1360You've called C<Fatal> with an argument that doesn't look like
1361a subroutine name, nor a switch that this version of Fatal
1362understands.
1363
1364=item %s is not a Perl subroutine
1365
1366You've asked C<Fatal> to try and replace a subroutine which does not
1367exist, or has not yet been defined.
1368
1369=item %s is neither a builtin, nor a Perl subroutine
1370
1371You've asked C<Fatal> to replace a subroutine, but it's not a Perl
1372built-in, and C<Fatal> couldn't find it as a regular subroutine.
1373It either doesn't exist or has not yet been defined.
1374
1375=item Cannot make the non-overridable %s fatal
1376
1377You've tried to use C<Fatal> on a Perl built-in that can't be
1378overridden, such as C<print> or C<system>, which means that
1379C<Fatal> can't help you, although some other modules might.
1380See the L</"SEE ALSO"> section of this documentation.
1381
1382=item Internal error: %s
1383
1384You've found a bug in C<Fatal>. Please report it using
1385the C<perlbug> command.
1386
1387=back
91c7a880 1388
a6fd7f3f
RGS
1389=head1 BUGS
1390
0b09a93a
PF
1391C<Fatal> clobbers the context in which a function is called and always
1392makes it a scalar context, except when the C<:void> tag is used.
1393This problem does not exist in L<autodie>.
a6fd7f3f 1394
3776a202
PF
1395"Used only once" warnings can be generated when C<autodie> or C<Fatal>
1396is used with package filehandles (eg, C<FILE>). It's strongly recommended
1397you use scalar filehandles instead.
1398
e92e55da
MB
1399=head1 AUTHOR
1400
0b09a93a 1401Original module by Lionel Cons (CERN).
e92e55da 1402
10af26ed 1403Prototype updates by Ilya Zakharevich <ilya@math.ohio-state.edu>.
e92e55da 1404
0b09a93a
PF
1405L<autodie> support, bugfixes, extended diagnostics, C<system>
1406support, and major overhauling by Paul Fenwick <pjf@perltraining.com.au>
1407
1408=head1 LICENSE
1409
1410This module is free software, you may distribute it under the
1411same terms as Perl itself.
1412
1413=head1 SEE ALSO
1414
1415L<autodie> for a nicer way to use lexical Fatal.
1416
1417L<IPC::System::Simple> for a similar idea for calls to C<system()>
1418and backticks.
1419
e92e55da 1420=cut