From: Chris Williams Date: Wed, 13 Jan 2010 13:30:52 +0000 (+0000) Subject: Update File-Fetch to CPAN version 0.24 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=16610ad906328dde8c0ce186f28478759b0d03ba;p=p5sagit%2Fp5-mst-13.2.git Update File-Fetch to CPAN version 0.24 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. --- diff --git a/MANIFEST b/MANIFEST index 83a6f6b..bae7398 100644 --- 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 diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index fdde7f3..a946ddc 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -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', diff --git a/cpan/File-Fetch/lib/File/Fetch.pm b/cpan/File-Fetch/lib/File/Fetch.pm index d90232f..4aabc29 100644 --- a/cpan/File-Fetch/lib/File/Fetch.pm +++ b/cpan/File-Fetch/lib/File/Fetch.pm @@ -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 index 0000000..630a607 --- /dev/null +++ b/cpan/File-Fetch/t/null_subclass.t @@ -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); + }