Update autodie to CPAN version 2.12
authorChris 'BinGOs' Williams <chris@bingosnet.co.uk>
Fri, 6 Jul 2012 21:27:14 +0000 (22:27 +0100)
committerChris 'BinGOs' Williams <chris@bingosnet.co.uk>
Thu, 12 Jul 2012 08:34:22 +0000 (09:34 +0100)
  [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.

Porting/Maintainers.pl
cpan/autodie/lib/Fatal.pm
cpan/autodie/lib/autodie.pm
cpan/autodie/lib/autodie/exception.pm
cpan/autodie/lib/autodie/exception/system.pm
cpan/autodie/lib/autodie/hints.pm

index 3f0ce08..4848bae 100755 (executable)
@@ -229,7 +229,7 @@ use File::Glob qw(:case);
 
     'autodie' => {
         'MAINTAINER'   => 'pjf',
-        'DISTRIBUTION' => 'PJF/autodie-2.11.tar.gz',
+        'DISTRIBUTION' => 'PJF/autodie-2.12.tar.gz',
         'FILES'        => q[cpan/autodie],
         'EXCLUDED'     => [
             qr{^inc/Module/},
index 3526fe0..87d9da4 100644 (file)
@@ -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;
 
     } ) ;
index 95a940c..a2360e3 100644 (file)
@@ -8,7 +8,7 @@ our @ISA = qw(Fatal);
 our $VERSION;
 
 BEGIN {
-    $VERSION = '2.11';
+    $VERSION = '2.12';
 }
 
 use constant ERROR_WRONG_FATAL => q{
index 474d929..cd06639 100644 (file)
@@ -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.
 
index a3557d3..d3047a8 100644 (file)
@@ -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__;
 
index 3758eca..71c8be3 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 
 use constant PERL58 => ( $] < 5.009 );
 
-our $VERSION = '2.11';
+our $VERSION = '2.12';
 
 =head1 NAME