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.24
authorChris Williams <chris@bingosnet.co.uk>
Wed, 13 Jan 2010 13:30:52 +0000 (13:30 +0000)
committerChris Williams <chris@bingosnet.co.uk>
Wed, 13 Jan 2010 13:30:52 +0000 (13:30 +0000)
  Changes for 0.24        Wed Jan  6 23:32:19 2010
  =================================================
  * Applied a patch from brian d foy RT #53427
    that makes new() respect sub-classes.

MANIFEST
Porting/Maintainers.pl
cpan/File-Fetch/lib/File/Fetch.pm
cpan/File-Fetch/t/null_subclass.t [new file with mode: 0644]

index 83a6f6b..bae7398 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1053,6 +1053,7 @@ cpan/ExtUtils-ParseXS/t/XSUsage.pm                ExtUtils::ParseXS tests
 cpan/ExtUtils-ParseXS/t/XSUsage.xs             ExtUtils::ParseXS tests
 cpan/File-Fetch/lib/File/Fetch.pm      File::Fetch
 cpan/File-Fetch/t/01_File-Fetch.t      File::Fetch tests
+cpan/File-Fetch/t/null_subclass.t
 cpan/File-Path/lib/File/Path.pm                Do things like 'mkdir -p' and 'rm -r'
 cpan/File-Path/t/Path.t                        See if File::Path works
 cpan/File-Path/t/taint.t               See if File::Path works with -T
index fdde7f3..a946ddc 100755 (executable)
@@ -660,7 +660,7 @@ use File::Glob qw(:case);
     'File::Fetch' =>
        {
        'MAINTAINER'    => 'kane',
-       'DISTRIBUTION'  => 'BINGOS/File-Fetch-0.22.tar.gz',
+       'DISTRIBUTION'  => 'BINGOS/File-Fetch-0.24.tar.gz',
        'FILES'         => q[cpan/File-Fetch],
        'CPAN'          => 1,
        'UPSTREAM'      => 'cpan',
index d90232f..4aabc29 100644 (file)
@@ -22,7 +22,7 @@ use vars    qw[ $VERBOSE $PREFER_BIN $FROM_EMAIL $USER_AGENT
                 $FTP_PASSIVE $TIMEOUT $DEBUG $WARN
             ];
 
-$VERSION        = '0.22';
+$VERSION        = '0.24';
 $VERSION        = eval $VERSION;    # avoid warnings with development releases
 $PREFER_BIN     = 0;                # XXX TODO implement
 $FROM_EMAIL     = 'File-Fetch@example.com';
@@ -178,13 +178,13 @@ result of $ff->output_file will be used.
         bless $args, $class;
     
         if( lc($args->scheme) ne 'file' and not $args->host ) {
-            return File::Fetch->_error(loc(
+            return $class->_error(loc(
                 "Hostname required when fetching from '%1'",$args->scheme));
         }
         
         for (qw[path file]) {
             unless( $args->$_() ) { # 5.5.x needs the ()
-                return File::Fetch->_error(loc("No '%1' specified",$_));
+                return $class->_error(loc("No '%1' specified",$_));
             }
         }
         
@@ -275,10 +275,10 @@ sub new {
     check( $tmpl, \%hash ) or return;
 
     ### parse the uri to usable parts ###
-    my $href    = __PACKAGE__->_parse_uri( $uri ) or return;
+    my $href    = $class->_parse_uri( $uri ) or return;
 
     ### make it into a FFI object ###
-    my $ff      = File::Fetch->_create( %$href ) or return;
+    my $ff      = $class->_create( %$href ) or return;
 
 
     ### return the object ###
diff --git a/cpan/File-Fetch/t/null_subclass.t b/cpan/File-Fetch/t/null_subclass.t
new file mode 100644 (file)
index 0000000..630a607
--- /dev/null
@@ -0,0 +1,23 @@
+use strict;
+use warnings;
+
+use Test::More tests => 5;
+
+my $parent_class = 'File::Fetch';
+my $child_class  = 'File::Fetch::Subclass';
+
+use_ok( $parent_class );
+
+my $ff_parent = $parent_class->new( uri => 'http://example.com/index.html' );
+isa_ok( $ff_parent, $parent_class );
+
+can_ok( $child_class, qw( new fetch ) );
+my $ff_child = $child_class->new( uri => 'http://example.com/index.html' );
+isa_ok( $ff_child, $child_class );
+isa_ok( $ff_child, $parent_class );
+
+BEGIN {
+       package File::Fetch::Subclass;
+       use vars qw(@ISA);
+       unshift @ISA, qw(File::Fetch);
+       }