diff options
author | Chris 'BinGOs' Williams <chris@bingosnet.co.uk> | 2012-07-06 22:27:14 +0100 |
---|---|---|
committer | Chris 'BinGOs' Williams <chris@bingosnet.co.uk> | 2012-07-12 09:34:22 +0100 |
commit | 20da2e5b86ba0d7b84f7fde98446cf2287b33741 (patch) | |
tree | 69c2beafadc4c010c62a687ba30d0c5e983f3ad9 /cpan | |
parent | ea8337ba3382e650133fb4941d3d1372437b631e (diff) | |
download | perl-20da2e5b86ba0d7b84f7fde98446cf2287b33741.tar.gz |
Update autodie to CPAN version 2.12
[DELTA]
2.12 Tue Jun 26 14:55:04 PDT 2012
* BUGFIX: autodie now plays nicely with the 'open' pragma
(RT #54777, thanks to Schwern).
* BUILD: Updated to Module::Install 1.06
* BUILD: Makefile.PL is less redundant.
* TEST: t/pod-coverage.t no longer thinks LEXICAL_TAG is
a user-visible subroutine.
Diffstat (limited to 'cpan')
-rw-r--r-- | cpan/autodie/lib/Fatal.pm | 63 | ||||
-rw-r--r-- | cpan/autodie/lib/autodie.pm | 2 | ||||
-rw-r--r-- | cpan/autodie/lib/autodie/exception.pm | 2 | ||||
-rw-r--r-- | cpan/autodie/lib/autodie/exception/system.pm | 2 | ||||
-rw-r--r-- | cpan/autodie/lib/autodie/hints.pm | 2 |
5 files changed, 64 insertions, 7 deletions
diff --git a/cpan/autodie/lib/Fatal.pm b/cpan/autodie/lib/Fatal.pm index 3526fe0364..87d9da495c 100644 --- a/cpan/autodie/lib/Fatal.pm +++ b/cpan/autodie/lib/Fatal.pm @@ -40,7 +40,7 @@ use constant ERROR_58_HINTS => q{Non-subroutine %s hints for %s are not supporte use constant MIN_IPC_SYS_SIMPLE_VER => 0.12; # All the Fatal/autodie modules share the same version number. -our $VERSION = '2.11'; +our $VERSION = '2.12'; our $Debug ||= 0; @@ -117,6 +117,7 @@ my %TAGS = ( ':2.09' => [qw(:default)], ':2.10' => [qw(:default)], ':2.11' => [qw(:default)], + ':2.12' => [qw(:default)], ); # chmod was only introduced in 2.07 @@ -145,6 +146,58 @@ my %Use_defined_or; CORE::umask )} = (); + +# A snippet of code to apply the open pragma to a handle + + + +# Optional actions to take on the return value before returning it. + +my %Retval_action = ( + "CORE::open" => q{ + + # apply the open pragma from our caller + if( defined $retval ) { + # Get the caller's hint hash + my $hints = (caller 0)[10]; + + # Decide if we're reading or writing and apply the appropriate encoding + # These keys are undocumented. + # Match what PerlIO_context_layers() does. Read gets the read layer, + # everything else gets the write layer. + my $encoding = $_[1] =~ /^\+?>/ ? $hints->{"open>"} : $hints->{"open<"}; + + # Apply the encoding, if any. + if( $encoding ) { + binmode $_[0], $encoding; + } + } + +}, + "CORE::sysopen" => q{ + + # apply the open pragma from our caller + if( defined $retval ) { + # Get the caller's hint hash + my $hints = (caller 0)[10]; + + require Fcntl; + + # Decide if we're reading or writing and apply the appropriate encoding. + # Match what PerlIO_context_layers() does. Read gets the read layer, + # everything else gets the write layer. + my $open_read_only = !($_[2] ^ Fcntl::O_RDONLY()); + my $encoding = $open_read_only ? $hints->{"open<"} : $hints->{"open>"}; + + # Apply the encoding, if any. + if( $encoding ) { + binmode $_[0], $encoding; + } + } + +}, +); + # Cached_fatalised_sub caches the various versions of our # fatalised subs as they're produced. This means we don't # have to build our own replacement of CORE::open and friends @@ -811,6 +864,8 @@ sub _one_invocation { ]; + my $retval_action = $Retval_action{$call} || ''; + if ( $hints and ( ref($hints->{list} ) || "" ) eq 'CODE' ) { # NB: Subroutine hints are passed as a full list. @@ -863,6 +918,7 @@ sub _one_invocation { return $code .= qq{ if ( \$hints->{scalar}->(\$retval) ) { $die }; + $retval_action return \$retval; }; @@ -871,7 +927,7 @@ sub _one_invocation { return $code . qq{ if ( \$retval ~~ \$hints->{scalar} ) { $die }; - + $retval_action return \$retval; }; } @@ -883,11 +939,12 @@ sub _one_invocation { ( $use_defined_or ? qq{ $die if not defined \$retval; - + $retval_action return \$retval; } : qq{ + $retval_action return \$retval || $die; } ) ; diff --git a/cpan/autodie/lib/autodie.pm b/cpan/autodie/lib/autodie.pm index 95a940c178..a2360e3d20 100644 --- a/cpan/autodie/lib/autodie.pm +++ b/cpan/autodie/lib/autodie.pm @@ -8,7 +8,7 @@ our @ISA = qw(Fatal); our $VERSION; BEGIN { - $VERSION = '2.11'; + $VERSION = '2.12'; } use constant ERROR_WRONG_FATAL => q{ diff --git a/cpan/autodie/lib/autodie/exception.pm b/cpan/autodie/lib/autodie/exception.pm index 474d9293b2..cd06639fdf 100644 --- a/cpan/autodie/lib/autodie/exception.pm +++ b/cpan/autodie/lib/autodie/exception.pm @@ -14,7 +14,7 @@ use overload use if ($] >= 5.010), overload => '~~' => "matches"; -our $VERSION = '2.11'; +our $VERSION = '2.12'; my $PACKAGE = __PACKAGE__; # Useful to have a scalar for hash keys. diff --git a/cpan/autodie/lib/autodie/exception/system.pm b/cpan/autodie/lib/autodie/exception/system.pm index a3557d3282..d3047a8cda 100644 --- a/cpan/autodie/lib/autodie/exception/system.pm +++ b/cpan/autodie/lib/autodie/exception/system.pm @@ -5,7 +5,7 @@ use warnings; use base 'autodie::exception'; use Carp qw(croak); -our $VERSION = '2.11'; +our $VERSION = '2.12'; my $PACKAGE = __PACKAGE__; diff --git a/cpan/autodie/lib/autodie/hints.pm b/cpan/autodie/lib/autodie/hints.pm index 3758eca03e..71c8be389c 100644 --- a/cpan/autodie/lib/autodie/hints.pm +++ b/cpan/autodie/lib/autodie/hints.pm @@ -5,7 +5,7 @@ use warnings; use constant PERL58 => ( $] < 5.009 ); -our $VERSION = '2.11'; +our $VERSION = '2.12'; =head1 NAME |