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