diff --git a/ChangeLog b/ChangeLog index 7809891c..4c2b3db6 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +Changes for 0.9134 Mon Jan 21 20:00:03 2013 +================================================ +* $VERSION all library files + Changes for 0.9133 Sat Sep 29 11:49:02 2012 ================================================ * Fix MANIFEST for last release diff --git a/META.yml b/META.yml index 0ee956b4..0b1209b0 100644 --- a/META.yml +++ b/META.yml @@ -18,4 +18,4 @@ resources: license: http://dev.perl.org/licenses/ homepage: http://github.com/jib/cpanplus-devel repository: http://github.com/jib/cpanplus-devel -version: 0.9133 +version: 0.9134 diff --git a/inc/bundle/Archive/Extract.pm b/inc/bundle/Archive/Extract.pm index 91436df0..2607f8bc 100644 --- a/inc/bundle/Archive/Extract.pm +++ b/inc/bundle/Archive/Extract.pm @@ -16,6 +16,7 @@ use Locale::Maketext::Simple Style => 'gettext'; ### solaris has silly /bin/tar output ### use constant ON_SOLARIS => $^O eq 'solaris' ? 1 : 0; use constant ON_NETBSD => $^O eq 'netbsd' ? 1 : 0; +use constant ON_OPENBSD => $^O eq 'openbsd' ? 1 : 0; use constant ON_FREEBSD => $^O eq 'freebsd' ? 1 : 0; use constant ON_LINUX => $^O eq 'linux' ? 1 : 0; use constant FILE_EXISTS => sub { -e $_[0] ? 1 : 0 }; @@ -46,7 +47,7 @@ use vars qw[$VERSION $PREFER_BIN $PROGRAMS $WARN $DEBUG $_ALLOW_BIN $_ALLOW_PURE_PERL $_ALLOW_TAR_ITER ]; -$VERSION = '0.60'; +$VERSION = '0.62'; $PREFER_BIN = 0; $WARN = 1; $DEBUG = 0; @@ -140,6 +141,10 @@ CMD: for my $pgm (qw[tar unzip gzip bunzip2 uncompress unlzma unxz]) { ($PROGRAMS->{$pgm}) = grep { scalar run(command=> [ $_, $opt, '-1' ]) } can_run($pgm); next CMD; } + if ( $pgm eq 'tar' and ON_OPENBSD ) { + # try gtar first + next CMD if $PROGRAMS->{$pgm} = can_run('gtar'); + } $PROGRAMS->{$pgm} = can_run($pgm); } @@ -654,7 +659,7 @@ sub have_old_bunzip2 { ### check for /bin/tar ### ### check for /bin/gzip if we need it ### ### if any of the binaries are not available, return NA - { my $diag = not $self->bin_tar ? + { my $diag = !$self->bin_tar ? loc("No '%1' program found", '/bin/tar') : $self->is_tgz && !$self->bin_gzip ? loc("No '%1' program found", '/bin/gzip') : @@ -1662,7 +1667,7 @@ thread safe. See C bug C<#45671> for details. =head1 BUG REPORTS -Please report bugs or other issues to Ebug-archive-extract@rt.cpan.org. +Please report bugs or other issues to Ebug-archive-extract@rt.cpan.orgE. =head1 AUTHOR diff --git a/inc/bundle/File/Fetch.pm b/inc/bundle/File/Fetch.pm index 99f1f795..37f7bc6c 100644 --- a/inc/bundle/File/Fetch.pm +++ b/inc/bundle/File/Fetch.pm @@ -22,7 +22,7 @@ use vars qw[ $VERBOSE $PREFER_BIN $FROM_EMAIL $USER_AGENT $FTP_PASSIVE $TIMEOUT $DEBUG $WARN ]; -$VERSION = '0.36'; +$VERSION = '0.38'; $VERSION = eval $VERSION; # avoid warnings with development releases $PREFER_BIN = 0; # XXX TODO implement $FROM_EMAIL = 'File-Fetch@example.com'; @@ -164,6 +164,7 @@ http://www.abc.net.au/ the contents retrieved may be from a remote file called vol => { default => '' }, # windows for file:// uris share => { default => '' }, # windows for file:// uris file_default => { default => 'file_default' }, + tempdir_root => { required => 1 }, # Should be lazy-set at ->new() _error_msg => { no_override => 1 }, _error_msg_long => { no_override => 1 }, }; @@ -277,10 +278,11 @@ sub new { my $class = shift; my %hash = @_; - my ($uri, $file_default); + my ($uri, $file_default, $tempdir_root); my $tmpl = { uri => { required => 1, store => \$uri }, file_default => { required => 0, store => \$file_default }, + tempdir_root => { required => 0, store => \$tempdir_root }, }; check( $tmpl, \%hash ) or return; @@ -289,6 +291,8 @@ sub new { my $href = $class->_parse_uri( $uri ) or return; $href->{file_default} = $file_default if $file_default; + $href->{tempdir_root} = File::Spec->rel2abs( $tempdir_root ) if $tempdir_root; + $href->{tempdir_root} = File::Spec->rel2abs( Cwd::cwd ) if not $href->{tempdir_root}; ### make it into a FFI object ### my $ff = $class->_create( %$href ) or return; @@ -444,7 +448,7 @@ sub fetch { my ($to, $fh); ### you want us to slurp the contents if( ref $target and UNIVERSAL::isa( $target, 'SCALAR' ) ) { - $to = tempdir( 'FileFetch.XXXXXX', CLEANUP => 1 ); + $to = tempdir( 'FileFetch.XXXXXX', DIR => $self->tempdir_root, CLEANUP => 1 ); ### plain old fetch } else { @@ -560,41 +564,40 @@ sub _lwp_fetch { }; - if( can_load(modules => $use_list) ) { - - ### setup the uri object - my $uri = URI->new( File::Spec::Unix->catfile( - $self->path, $self->file - ) ); + unless( can_load( modules => $use_list ) ) { + $METHOD_FAIL->{'lwp'} = 1; + return; + } - ### special rules apply for file:// uris ### - $uri->scheme( $self->scheme ); - $uri->host( $self->scheme eq 'file' ? '' : $self->host ); - $uri->userinfo("anonymous:$FROM_EMAIL") if $self->scheme ne 'file'; + ### setup the uri object + my $uri = URI->new( File::Spec::Unix->catfile( + $self->path, $self->file + ) ); - ### set up the useragent object - my $ua = LWP::UserAgent->new(); - $ua->timeout( $TIMEOUT ) if $TIMEOUT; - $ua->agent( $USER_AGENT ); - $ua->from( $FROM_EMAIL ); - $ua->env_proxy; + ### special rules apply for file:// uris ### + $uri->scheme( $self->scheme ); + $uri->host( $self->scheme eq 'file' ? '' : $self->host ); + $uri->userinfo("anonymous:$FROM_EMAIL") if $self->scheme ne 'file'; - my $res = $ua->mirror($uri, $to) or return; + ### set up the useragent object + my $ua = LWP::UserAgent->new(); + $ua->timeout( $TIMEOUT ) if $TIMEOUT; + $ua->agent( $USER_AGENT ); + $ua->from( $FROM_EMAIL ); + $ua->env_proxy; - ### uptodate or fetched ok ### - if ( $res->code == 304 or $res->code == 200 ) { - return $to; + my $res = $ua->mirror($uri, $to) or return; - } else { - return $self->_error(loc("Fetch failed! HTTP response: %1 %2 [%3]", - $res->code, HTTP::Status::status_message($res->code), - $res->status_line)); - } + ### uptodate or fetched ok ### + if ( $res->code == 304 or $res->code == 200 ) { + return $to; } else { - $METHOD_FAIL->{'lwp'} = 1; - return; + return $self->_error(loc("Fetch failed! HTTP response: %1 %2 [%3]", + $res->code, HTTP::Status::status_message($res->code), + $res->status_line)); } + } ### HTTP::Tiny fetching ### @@ -613,28 +616,26 @@ sub _httptiny_fetch { }; - if( can_load(modules => $use_list) ) { + unless( can_load(modules => $use_list) ) { + $METHOD_FAIL->{'httptiny'} = 1; + return; + } - my $uri = $self->uri; + my $uri = $self->uri; - my $http = HTTP::Tiny->new( ( $TIMEOUT ? ( timeout => $TIMEOUT ) : () ) ); + my $http = HTTP::Tiny->new( ( $TIMEOUT ? ( timeout => $TIMEOUT ) : () ) ); - my $rc = $http->mirror( $uri, $to ); + my $rc = $http->mirror( $uri, $to ); - unless ( $rc->{success} ) { + unless ( $rc->{success} ) { - return $self->_error(loc( "Fetch failed! HTTP response: %1 [%2]", - $rc->{status}, $rc->{reason} ) ); + return $self->_error(loc( "Fetch failed! HTTP response: %1 [%2]", + $rc->{status}, $rc->{reason} ) ); - } + } - return $to; + return $to; - } - else { - $METHOD_FAIL->{'httptiny'} = 1; - return; - } } ### HTTP::Lite fetching ### @@ -654,64 +655,63 @@ sub _httplite_fetch { }; - if( can_load(modules => $use_list) ) { + unless( can_load(modules => $use_list) ) { + $METHOD_FAIL->{'httplite'} = 1; + return; + } - my $uri = $self->uri; - my $retries = 0; + my $uri = $self->uri; + my $retries = 0; - RETRIES: while ( $retries++ < 5 ) { + RETRIES: while ( $retries++ < 5 ) { - my $http = HTTP::Lite->new(); - # Naughty naughty but there isn't any accessor/setter - $http->{timeout} = $TIMEOUT if $TIMEOUT; - $http->http11_mode(1); + my $http = HTTP::Lite->new(); + # Naughty naughty but there isn't any accessor/setter + $http->{timeout} = $TIMEOUT if $TIMEOUT; + $http->http11_mode(1); - my $fh = FileHandle->new; + my $fh = FileHandle->new; - unless ( $fh->open($to,'>') ) { - return $self->_error(loc( - "Could not open '%1' for writing: %2",$to,$!)); - } + unless ( $fh->open($to,'>') ) { + return $self->_error(loc( + "Could not open '%1' for writing: %2",$to,$!)); + } - $fh->autoflush(1); + $fh->autoflush(1); - binmode $fh; + binmode $fh; - my $rc = $http->request( $uri, sub { my ($self,$dref,$cbargs) = @_; local $\; print {$cbargs} $$dref }, $fh ); + my $rc = $http->request( $uri, sub { my ($self,$dref,$cbargs) = @_; local $\; print {$cbargs} $$dref }, $fh ); - close $fh; + close $fh; - if ( $rc == 301 || $rc == 302 ) { - my $loc; - HEADERS: for ($http->headers_array) { - /Location: (\S+)/ and $loc = $1, last HEADERS; - } - #$loc or last; # Think we should squeal here. - if ($loc =~ m!^/!) { - $uri =~ s{^(\w+?://[^/]+)/.*$}{$1}; - $uri .= $loc; - } - else { - $uri = $loc; - } - next RETRIES; + if ( $rc == 301 || $rc == 302 ) { + my $loc; + HEADERS: for ($http->headers_array) { + /Location: (\S+)/ and $loc = $1, last HEADERS; } - elsif ( $rc == 200 ) { - return $to; + #$loc or last; # Think we should squeal here. + if ($loc =~ m!^/!) { + $uri =~ s{^(\w+?://[^/]+)/.*$}{$1}; + $uri .= $loc; } else { - return $self->_error(loc("Fetch failed! HTTP response: %1 [%2]", - $rc, $http->status_message)); + $uri = $loc; } + next RETRIES; + } + elsif ( $rc == 200 ) { + return $to; + } + else { + return $self->_error(loc("Fetch failed! HTTP response: %1 [%2]", + $rc, $http->status_message)); + } - } # Loop for 5 retries. + } # Loop for 5 retries. - return $self->_error("Fetch failed! Gave up after 5 tries"); + return $self->_error("Fetch failed! Gave up after 5 tries"); - } else { - $METHOD_FAIL->{'httplite'} = 1; - return; - } } ### Simple IO::Socket::INET fetching ### @@ -730,74 +730,73 @@ sub _iosock_fetch { 'IO::Select' => '0.0', }; - if( can_load(modules => $use_list) ) { - my $sock = IO::Socket::INET->new( - PeerHost => $self->host, - ( $self->host =~ /:/ ? () : ( PeerPort => 80 ) ), - ); + unless( can_load(modules => $use_list) ) { + $METHOD_FAIL->{'iosock'} = 1; + return; + } - unless ( $sock ) { - return $self->_error(loc("Could not open socket to '%1', '%2'",$self->host,$!)); - } + my $sock = IO::Socket::INET->new( + PeerHost => $self->host, + ( $self->host =~ /:/ ? () : ( PeerPort => 80 ) ), + ); - my $fh = FileHandle->new; + unless ( $sock ) { + return $self->_error(loc("Could not open socket to '%1', '%2'",$self->host,$!)); + } - # Check open() + my $fh = FileHandle->new; - unless ( $fh->open($to,'>') ) { - return $self->_error(loc( - "Could not open '%1' for writing: %2",$to,$!)); - } + # Check open() - $fh->autoflush(1); - binmode $fh; + unless ( $fh->open($to,'>') ) { + return $self->_error(loc( + "Could not open '%1' for writing: %2",$to,$!)); + } - my $path = File::Spec::Unix->catfile( $self->path, $self->file ); - my $req = "GET $path HTTP/1.0\x0d\x0aHost: " . $self->host . "\x0d\x0a\x0d\x0a"; - $sock->send( $req ); + $fh->autoflush(1); + binmode $fh; - my $select = IO::Select->new( $sock ); + my $path = File::Spec::Unix->catfile( $self->path, $self->file ); + my $req = "GET $path HTTP/1.0\x0d\x0aHost: " . $self->host . "\x0d\x0a\x0d\x0a"; + $sock->send( $req ); - my $resp = ''; - my $normal = 0; - while ( $select->can_read( $TIMEOUT || 60 ) ) { - my $ret = $sock->sysread( $resp, 4096, length($resp) ); - if ( !defined $ret or $ret == 0 ) { - $select->remove( $sock ); - $normal++; - } - } - close $sock; + my $select = IO::Select->new( $sock ); - unless ( $normal ) { - return $self->_error(loc("Socket timed out after '%1' seconds", ( $TIMEOUT || 60 ))); - } + my $resp = ''; + my $normal = 0; + while ( $select->can_read( $TIMEOUT || 60 ) ) { + my $ret = $sock->sysread( $resp, 4096, length($resp) ); + if ( !defined $ret or $ret == 0 ) { + $select->remove( $sock ); + $normal++; + } + } + close $sock; - # Check the "response" - # Strip preceding blank lines apparently they are allowed (RFC 2616 4.1) - $resp =~ s/^(\x0d?\x0a)+//; - # Check it is an HTTP response - unless ( $resp =~ m!^HTTP/(\d+)\.(\d+)!i ) { - return $self->_error(loc("Did not get a HTTP response from '%1'",$self->host)); - } + unless ( $normal ) { + return $self->_error(loc("Socket timed out after '%1' seconds", ( $TIMEOUT || 60 ))); + } - # Check for OK - my ($code) = $resp =~ m!^HTTP/\d+\.\d+\s+(\d+)!i; - unless ( $code eq '200' ) { - return $self->_error(loc("Got a '%1' from '%2' expected '200'",$code,$self->host)); - } + # Check the "response" + # Strip preceding blank lines apparently they are allowed (RFC 2616 4.1) + $resp =~ s/^(\x0d?\x0a)+//; + # Check it is an HTTP response + unless ( $resp =~ m!^HTTP/(\d+)\.(\d+)!i ) { + return $self->_error(loc("Did not get a HTTP response from '%1'",$self->host)); + } - { - local $\; - print $fh +($resp =~ m/\x0d\x0a\x0d\x0a(.*)$/s )[0]; - } - close $fh; - return $to; + # Check for OK + my ($code) = $resp =~ m!^HTTP/\d+\.\d+\s+(\d+)!i; + unless ( $code eq '200' ) { + return $self->_error(loc("Got a '%1' from '%2' expected '200'",$code,$self->host)); + } - } else { - $METHOD_FAIL->{'iosock'} = 1; - return; + { + local $\; + print $fh +($resp =~ m/\x0d\x0a\x0d\x0a(.*)$/s )[0]; } + close $fh; + return $to; } ### Net::FTP fetching @@ -814,44 +813,43 @@ sub _netftp_fetch { ### required modules ### my $use_list = { 'Net::FTP' => 0 }; - if( can_load( modules => $use_list ) ) { + unless( can_load( modules => $use_list ) ) { + $METHOD_FAIL->{'netftp'} = 1; + return; + } - ### make connection ### - my $ftp; - my @options = ($self->host); - push(@options, Timeout => $TIMEOUT) if $TIMEOUT; - unless( $ftp = Net::FTP->new( @options ) ) { - return $self->_error(loc("Ftp creation failed: %1",$@)); - } + ### make connection ### + my $ftp; + my @options = ($self->host); + push(@options, Timeout => $TIMEOUT) if $TIMEOUT; + unless( $ftp = Net::FTP->new( @options ) ) { + return $self->_error(loc("Ftp creation failed: %1",$@)); + } - ### login ### - unless( $ftp->login( anonymous => $FROM_EMAIL ) ) { - return $self->_error(loc("Could not login to '%1'",$self->host)); - } + ### login ### + unless( $ftp->login( anonymous => $FROM_EMAIL ) ) { + return $self->_error(loc("Could not login to '%1'",$self->host)); + } - ### set binary mode, just in case ### - $ftp->binary; + ### set binary mode, just in case ### + $ftp->binary; - ### create the remote path - ### remember remote paths are unix paths! [#11483] - my $remote = File::Spec::Unix->catfile( $self->path, $self->file ); + ### create the remote path + ### remember remote paths are unix paths! [#11483] + my $remote = File::Spec::Unix->catfile( $self->path, $self->file ); - ### fetch the file ### - my $target; - unless( $target = $ftp->get( $remote, $to ) ) { - return $self->_error(loc("Could not fetch '%1' from '%2'", - $remote, $self->host)); - } + ### fetch the file ### + my $target; + unless( $target = $ftp->get( $remote, $to ) ) { + return $self->_error(loc("Could not fetch '%1' from '%2'", + $remote, $self->host)); + } - ### log out ### - $ftp->quit; + ### log out ### + $ftp->quit; - return $target; + return $target; - } else { - $METHOD_FAIL->{'netftp'} = 1; - return; - } } ### /bin/wget fetch ### @@ -865,47 +863,46 @@ sub _wget_fetch { }; check( $tmpl, \%hash ) or return; + my $wget; ### see if we have a wget binary ### - if( my $wget = can_run('wget') ) { + unless( $wget = can_run('wget') ) { + $METHOD_FAIL->{'wget'} = 1; + return; + } - ### no verboseness, thanks ### - my $cmd = [ $wget, '--quiet' ]; + ### no verboseness, thanks ### + my $cmd = [ $wget, '--quiet' ]; - ### if a timeout is set, add it ### - push(@$cmd, '--timeout=' . $TIMEOUT) if $TIMEOUT; + ### if a timeout is set, add it ### + push(@$cmd, '--timeout=' . $TIMEOUT) if $TIMEOUT; - ### run passive if specified ### - push @$cmd, '--passive-ftp' if $FTP_PASSIVE; + ### run passive if specified ### + push @$cmd, '--passive-ftp' if $FTP_PASSIVE; - ### set the output document, add the uri ### - push @$cmd, '--output-document', $to, $self->uri; + ### set the output document, add the uri ### + push @$cmd, '--output-document', $to, $self->uri; - ### with IPC::Cmd > 0.41, this is fixed in teh library, - ### and there's no need for special casing any more. - ### DO NOT quote things for IPC::Run, it breaks stuff. - # $IPC::Cmd::USE_IPC_RUN - # ? ($to, $self->uri) - # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE); + ### with IPC::Cmd > 0.41, this is fixed in teh library, + ### and there's no need for special casing any more. + ### DO NOT quote things for IPC::Run, it breaks stuff. + # $IPC::Cmd::USE_IPC_RUN + # ? ($to, $self->uri) + # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE); - ### shell out ### - my $captured; - unless(run( command => $cmd, - buffer => \$captured, - verbose => $DEBUG - )) { - ### wget creates the output document always, even if the fetch - ### fails.. so unlink it in that case - 1 while unlink $to; - - return $self->_error(loc( "Command failed: %1", $captured || '' )); - } + ### shell out ### + my $captured; + unless(run( command => $cmd, + buffer => \$captured, + verbose => $DEBUG + )) { + ### wget creates the output document always, even if the fetch + ### fails.. so unlink it in that case + 1 while unlink $to; - return $to; - - } else { - $METHOD_FAIL->{'wget'} = 1; - return; + return $self->_error(loc( "Command failed: %1", $captured || '' )); } + + return $to; } ### /bin/lftp fetch ### @@ -919,67 +916,66 @@ sub _lftp_fetch { }; check( $tmpl, \%hash ) or return; - ### see if we have a wget binary ### - if( my $lftp = can_run('lftp') ) { - - ### no verboseness, thanks ### - my $cmd = [ $lftp, '-f' ]; + ### see if we have a lftp binary ### + my $lftp; + unless( $lftp = can_run('lftp') ) { + $METHOD_FAIL->{'lftp'} = 1; + return; + } - my $fh = File::Temp->new; + ### no verboseness, thanks ### + my $cmd = [ $lftp, '-f' ]; - my $str; + my $fh = File::Temp->new; - ### if a timeout is set, add it ### - $str .= "set net:timeout $TIMEOUT;\n" if $TIMEOUT; + my $str; - ### run passive if specified ### - $str .= "set ftp:passive-mode 1;\n" if $FTP_PASSIVE; + ### if a timeout is set, add it ### + $str .= "set net:timeout $TIMEOUT;\n" if $TIMEOUT; - ### set the output document, add the uri ### - ### quote the URI, because lftp supports certain shell - ### expansions, most notably & for backgrounding. - ### ' quote does nto work, must be " - $str .= q[get ']. $self->uri .q[' -o ]. $to . $/; + ### run passive if specified ### + $str .= "set ftp:passive-mode 1;\n" if $FTP_PASSIVE; - if( $DEBUG ) { - my $pp_str = join ' ', split $/, $str; - print "# lftp command: $pp_str\n"; - } + ### set the output document, add the uri ### + ### quote the URI, because lftp supports certain shell + ### expansions, most notably & for backgrounding. + ### ' quote does nto work, must be " + $str .= q[get ']. $self->uri .q[' -o ]. $to . $/; - ### write straight to the file. - $fh->autoflush(1); - print $fh $str; + if( $DEBUG ) { + my $pp_str = join ' ', split $/, $str; + print "# lftp command: $pp_str\n"; + } - ### the command needs to be 1 string to be executed - push @$cmd, $fh->filename; + ### write straight to the file. + $fh->autoflush(1); + print $fh $str; - ### with IPC::Cmd > 0.41, this is fixed in teh library, - ### and there's no need for special casing any more. - ### DO NOT quote things for IPC::Run, it breaks stuff. - # $IPC::Cmd::USE_IPC_RUN - # ? ($to, $self->uri) - # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE); + ### the command needs to be 1 string to be executed + push @$cmd, $fh->filename; + ### with IPC::Cmd > 0.41, this is fixed in teh library, + ### and there's no need for special casing any more. + ### DO NOT quote things for IPC::Run, it breaks stuff. + # $IPC::Cmd::USE_IPC_RUN + # ? ($to, $self->uri) + # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE); - ### shell out ### - my $captured; - unless(run( command => $cmd, - buffer => \$captured, - verbose => $DEBUG - )) { - ### wget creates the output document always, even if the fetch - ### fails.. so unlink it in that case - 1 while unlink $to; - - return $self->_error(loc( "Command failed: %1", $captured || '' )); - } - return $to; + ### shell out ### + my $captured; + unless(run( command => $cmd, + buffer => \$captured, + verbose => $DEBUG + )) { + ### wget creates the output document always, even if the fetch + ### fails.. so unlink it in that case + 1 while unlink $to; - } else { - $METHOD_FAIL->{'lftp'} = 1; - return; + return $self->_error(loc( "Command failed: %1", $captured || '' )); } + + return $to; } @@ -996,32 +992,35 @@ sub _ftp_fetch { check( $tmpl, \%hash ) or return; ### see if we have a ftp binary ### - if( my $ftp = can_run('ftp') ) { + my $ftp; + unless( $ftp = can_run('ftp') ) { + $METHOD_FAIL->{'ftp'} = 1; + return; + } - my $fh = FileHandle->new; + my $fh = FileHandle->new; - local $SIG{CHLD} = 'IGNORE'; + local $SIG{CHLD} = 'IGNORE'; - unless ($fh->open("|$ftp -n")) { - return $self->_error(loc("%1 creation failed: %2", $ftp, $!)); - } + unless ($fh->open("$ftp -n", '|-')) { + return $self->_error(loc("%1 creation failed: %2", $ftp, $!)); + } - my @dialog = ( - "lcd " . dirname($to), - "open " . $self->host, - "user anonymous $FROM_EMAIL", - "cd /", - "cd " . $self->path, - "binary", - "get " . $self->file . " " . $self->output_file, - "quit", - ); + my @dialog = ( + "lcd " . dirname($to), + "open " . $self->host, + "user anonymous $FROM_EMAIL", + "cd /", + "cd " . $self->path, + "binary", + "get " . $self->file . " " . $self->output_file, + "quit", + ); - foreach (@dialog) { $fh->print($_, "\n") } - $fh->close or return; + foreach (@dialog) { $fh->print($_, "\n") } + $fh->close or return; - return $to; - } + return $to; } ### lynx is stupid - it decompresses any .gz file it finds to be text @@ -1037,94 +1036,93 @@ sub _lynx_fetch { check( $tmpl, \%hash ) or return; ### see if we have a lynx binary ### - if( my $lynx = can_run('lynx') ) { - - unless( IPC::Cmd->can_capture_buffer ) { - $METHOD_FAIL->{'lynx'} = 1; - - return $self->_error(loc( - "Can not capture buffers. Can not use '%1' to fetch files", - 'lynx' )); - } - - ### check if the HTTP resource exists ### - if ($self->uri =~ /^https?:\/\//i) { - my $cmd = [ - $lynx, - '-head', - '-source', - "-auth=anonymous:$FROM_EMAIL", - ]; - - push @$cmd, "-connect_timeout=$TIMEOUT" if $TIMEOUT; - - push @$cmd, $self->uri; - - ### shell out ### - my $head; - unless(run( command => $cmd, - buffer => \$head, - verbose => $DEBUG ) - ) { - return $self->_error(loc("Command failed: %1", $head || '')); - } + my $lynx; + unless ( $lynx = can_run('lynx') ){ + $METHOD_FAIL->{'lynx'} = 1; + return; + } - unless($head =~ /^HTTP\/\d+\.\d+ 200\b/) { - return $self->_error(loc("Command failed: %1", $head || '')); - } - } + unless( IPC::Cmd->can_capture_buffer ) { + $METHOD_FAIL->{'lynx'} = 1; - ### write to the output file ourselves, since lynx ass_u_mes to much - my $local = FileHandle->new(">$to") - or return $self->_error(loc( - "Could not open '%1' for writing: %2",$to,$!)); + return $self->_error(loc( + "Can not capture buffers. Can not use '%1' to fetch files", + 'lynx' )); + } - ### dump to stdout ### + ### check if the HTTP resource exists ### + if ($self->uri =~ /^https?:\/\//i) { my $cmd = [ $lynx, + '-head', '-source', "-auth=anonymous:$FROM_EMAIL", ]; push @$cmd, "-connect_timeout=$TIMEOUT" if $TIMEOUT; - ### DO NOT quote things for IPC::Run, it breaks stuff. push @$cmd, $self->uri; - ### with IPC::Cmd > 0.41, this is fixed in teh library, - ### and there's no need for special casing any more. - ### DO NOT quote things for IPC::Run, it breaks stuff. - # $IPC::Cmd::USE_IPC_RUN - # ? $self->uri - # : QUOTE. $self->uri .QUOTE; - - ### shell out ### - my $captured; + my $head; unless(run( command => $cmd, - buffer => \$captured, + buffer => \$head, verbose => $DEBUG ) ) { - return $self->_error(loc("Command failed: %1", $captured || '')); + return $self->_error(loc("Command failed: %1", $head || '')); } - ### print to local file ### - ### XXX on a 404 with a special error page, $captured will actually - ### hold the contents of that page, and make it *appear* like the - ### request was a success, when really it wasn't :( - ### there doesn't seem to be an option for lynx to change the exit - ### code based on a 4XX status or so. - ### the closest we can come is using --error_file and parsing that, - ### which is very unreliable ;( - $local->print( $captured ); - $local->close or return; - - return $to; + unless($head =~ /^HTTP\/\d+\.\d+ 200\b/) { + return $self->_error(loc("Command failed: %1", $head || '')); + } + } - } else { - $METHOD_FAIL->{'lynx'} = 1; - return; + ### write to the output file ourselves, since lynx ass_u_mes to much + my $local = FileHandle->new( $to, 'w' ) + or return $self->_error(loc( + "Could not open '%1' for writing: %2",$to,$!)); + + ### dump to stdout ### + my $cmd = [ + $lynx, + '-source', + "-auth=anonymous:$FROM_EMAIL", + ]; + + push @$cmd, "-connect_timeout=$TIMEOUT" if $TIMEOUT; + + ### DO NOT quote things for IPC::Run, it breaks stuff. + push @$cmd, $self->uri; + + ### with IPC::Cmd > 0.41, this is fixed in teh library, + ### and there's no need for special casing any more. + ### DO NOT quote things for IPC::Run, it breaks stuff. + # $IPC::Cmd::USE_IPC_RUN + # ? $self->uri + # : QUOTE. $self->uri .QUOTE; + + + ### shell out ### + my $captured; + unless(run( command => $cmd, + buffer => \$captured, + verbose => $DEBUG ) + ) { + return $self->_error(loc("Command failed: %1", $captured || '')); } + + ### print to local file ### + ### XXX on a 404 with a special error page, $captured will actually + ### hold the contents of that page, and make it *appear* like the + ### request was a success, when really it wasn't :( + ### there doesn't seem to be an option for lynx to change the exit + ### code based on a 4XX status or so. + ### the closest we can come is using --error_file and parsing that, + ### which is very unreliable ;( + $local->print( $captured ); + $local->close or return; + + return $to; } ### use /bin/ncftp to fetch files @@ -1143,38 +1141,38 @@ sub _ncftp_fetch { return if $FTP_PASSIVE; ### see if we have a ncftp binary ### - if( my $ncftp = can_run('ncftp') ) { - - my $cmd = [ - $ncftp, - '-V', # do not be verbose - '-p', $FROM_EMAIL, # email as password - $self->host, # hostname - dirname($to), # local dir for the file - # remote path to the file - ### DO NOT quote things for IPC::Run, it breaks stuff. - $IPC::Cmd::USE_IPC_RUN - ? File::Spec::Unix->catdir( $self->path, $self->file ) - : QUOTE. File::Spec::Unix->catdir( - $self->path, $self->file ) .QUOTE - - ]; - - ### shell out ### - my $captured; - unless(run( command => $cmd, - buffer => \$captured, - verbose => $DEBUG ) - ) { - return $self->_error(loc("Command failed: %1", $captured || '')); - } - - return $to; - - } else { + my $ncftp; + unless( $ncftp = can_run('ncftp') ) { $METHOD_FAIL->{'ncftp'} = 1; return; } + + my $cmd = [ + $ncftp, + '-V', # do not be verbose + '-p', $FROM_EMAIL, # email as password + $self->host, # hostname + dirname($to), # local dir for the file + # remote path to the file + ### DO NOT quote things for IPC::Run, it breaks stuff. + $IPC::Cmd::USE_IPC_RUN + ? File::Spec::Unix->catdir( $self->path, $self->file ) + : QUOTE. File::Spec::Unix->catdir( + $self->path, $self->file ) .QUOTE + + ]; + + ### shell out ### + my $captured; + unless(run( command => $cmd, + buffer => \$captured, + verbose => $DEBUG ) + ) { + return $self->_error(loc("Command failed: %1", $captured || '')); + } + + return $to; + } ### use /bin/curl to fetch files @@ -1187,48 +1185,47 @@ sub _curl_fetch { to => { required => 1, store => \$to } }; check( $tmpl, \%hash ) or return; + my $curl; + unless ( $curl = can_run('curl') ) { + $METHOD_FAIL->{'curl'} = 1; + return; + } - if (my $curl = can_run('curl')) { - - ### these long opts are self explanatory - I like that -jmb - my $cmd = [ $curl, '-q' ]; + ### these long opts are self explanatory - I like that -jmb + my $cmd = [ $curl, '-q' ]; - push(@$cmd, '--connect-timeout', $TIMEOUT) if $TIMEOUT; + push(@$cmd, '--connect-timeout', $TIMEOUT) if $TIMEOUT; - push(@$cmd, '--silent') unless $DEBUG; + push(@$cmd, '--silent') unless $DEBUG; - ### curl does the right thing with passive, regardless ### - if ($self->scheme eq 'ftp') { - push(@$cmd, '--user', "anonymous:$FROM_EMAIL"); - } + ### curl does the right thing with passive, regardless ### + if ($self->scheme eq 'ftp') { + push(@$cmd, '--user', "anonymous:$FROM_EMAIL"); + } - ### curl doesn't follow 302 (temporarily moved) etc automatically - ### so we add --location to enable that. - push @$cmd, '--fail', '--location', '--output', $to, $self->uri; + ### curl doesn't follow 302 (temporarily moved) etc automatically + ### so we add --location to enable that. + push @$cmd, '--fail', '--location', '--output', $to, $self->uri; - ### with IPC::Cmd > 0.41, this is fixed in teh library, - ### and there's no need for special casing any more. - ### DO NOT quote things for IPC::Run, it breaks stuff. - # $IPC::Cmd::USE_IPC_RUN - # ? ($to, $self->uri) - # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE); + ### with IPC::Cmd > 0.41, this is fixed in teh library, + ### and there's no need for special casing any more. + ### DO NOT quote things for IPC::Run, it breaks stuff. + # $IPC::Cmd::USE_IPC_RUN + # ? ($to, $self->uri) + # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE); - my $captured; - unless(run( command => $cmd, - buffer => \$captured, - verbose => $DEBUG ) - ) { + my $captured; + unless(run( command => $cmd, + buffer => \$captured, + verbose => $DEBUG ) + ) { - return $self->_error(loc("Command failed: %1", $captured || '')); - } + return $self->_error(loc("Command failed: %1", $captured || '')); + } - return $to; + return $to; - } else { - $METHOD_FAIL->{'curl'} = 1; - return; - } } ### /usr/bin/fetch fetch! ### @@ -1242,48 +1239,47 @@ sub _fetch_fetch { }; check( $tmpl, \%hash ) or return; - ### see if we have a wget binary ### - if( HAS_FETCH and my $fetch = can_run('fetch') ) { - - ### no verboseness, thanks ### - my $cmd = [ $fetch, '-q' ]; - - ### if a timeout is set, add it ### - push(@$cmd, '-T', $TIMEOUT) if $TIMEOUT; - - ### run passive if specified ### - #push @$cmd, '-p' if $FTP_PASSIVE; - local $ENV{'FTP_PASSIVE_MODE'} = 1 if $FTP_PASSIVE; - - ### set the output document, add the uri ### - push @$cmd, '-o', $to, $self->uri; - - ### with IPC::Cmd > 0.41, this is fixed in teh library, - ### and there's no need for special casing any more. - ### DO NOT quote things for IPC::Run, it breaks stuff. - # $IPC::Cmd::USE_IPC_RUN - # ? ($to, $self->uri) - # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE); - - ### shell out ### - my $captured; - unless(run( command => $cmd, - buffer => \$captured, - verbose => $DEBUG - )) { - ### wget creates the output document always, even if the fetch - ### fails.. so unlink it in that case - 1 while unlink $to; - - return $self->_error(loc( "Command failed: %1", $captured || '' )); - } - - return $to; - - } else { - $METHOD_FAIL->{'wget'} = 1; + ### see if we have a fetch binary ### + my $fetch; + unless( HAS_FETCH and $fetch = can_run('fetch') ) { + $METHOD_FAIL->{'fetch'} = 1; return; } + + ### no verboseness, thanks ### + my $cmd = [ $fetch, '-q' ]; + + ### if a timeout is set, add it ### + push(@$cmd, '-T', $TIMEOUT) if $TIMEOUT; + + ### run passive if specified ### + #push @$cmd, '-p' if $FTP_PASSIVE; + local $ENV{'FTP_PASSIVE_MODE'} = 1 if $FTP_PASSIVE; + + ### set the output document, add the uri ### + push @$cmd, '-o', $to, $self->uri; + + ### with IPC::Cmd > 0.41, this is fixed in teh library, + ### and there's no need for special casing any more. + ### DO NOT quote things for IPC::Run, it breaks stuff. + # $IPC::Cmd::USE_IPC_RUN + # ? ($to, $self->uri) + # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE); + + ### shell out ### + my $captured; + unless(run( command => $cmd, + buffer => \$captured, + verbose => $DEBUG + )) { + ### wget creates the output document always, even if the fetch + ### fails.. so unlink it in that case + 1 while unlink $to; + + return $self->_error(loc( "Command failed: %1", $captured || '' )); + } + + return $to; } ### use File::Copy for fetching file:// urls ### @@ -1369,42 +1365,41 @@ sub _rsync_fetch { to => { required => 1, store => \$to } }; check( $tmpl, \%hash ) or return; + my $rsync; + unless ( $rsync = can_run('rsync') ) { + $METHOD_FAIL->{'rsync'} = 1; + return; + } - if (my $rsync = can_run('rsync')) { - - my $cmd = [ $rsync ]; + my $cmd = [ $rsync ]; - ### XXX: rsync has no I/O timeouts at all, by default - push(@$cmd, '--timeout=' . $TIMEOUT) if $TIMEOUT; + ### XXX: rsync has no I/O timeouts at all, by default + push(@$cmd, '--timeout=' . $TIMEOUT) if $TIMEOUT; - push(@$cmd, '--quiet') unless $DEBUG; + push(@$cmd, '--quiet') unless $DEBUG; - ### DO NOT quote things for IPC::Run, it breaks stuff. - push @$cmd, $self->uri, $to; + ### DO NOT quote things for IPC::Run, it breaks stuff. + push @$cmd, $self->uri, $to; - ### with IPC::Cmd > 0.41, this is fixed in teh library, - ### and there's no need for special casing any more. - ### DO NOT quote things for IPC::Run, it breaks stuff. - # $IPC::Cmd::USE_IPC_RUN - # ? ($to, $self->uri) - # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE); + ### with IPC::Cmd > 0.41, this is fixed in teh library, + ### and there's no need for special casing any more. + ### DO NOT quote things for IPC::Run, it breaks stuff. + # $IPC::Cmd::USE_IPC_RUN + # ? ($to, $self->uri) + # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE); - my $captured; - unless(run( command => $cmd, - buffer => \$captured, - verbose => $DEBUG ) - ) { + my $captured; + unless(run( command => $cmd, + buffer => \$captured, + verbose => $DEBUG ) + ) { - return $self->_error(loc("Command %1 failed: %2", - "@$cmd" || '', $captured || '')); - } + return $self->_error(loc("Command %1 failed: %2", + "@$cmd" || '', $captured || '')); + } - return $to; + return $to; - } else { - $METHOD_FAIL->{'rsync'} = 1; - return; - } } ################################# diff --git a/inc/bundle/File/Spec.pm b/inc/bundle/File/Spec.pm index bb973f1f..6062c015 100644 --- a/inc/bundle/File/Spec.pm +++ b/inc/bundle/File/Spec.pm @@ -3,8 +3,8 @@ package File::Spec; use strict; use vars qw(@ISA $VERSION); -$VERSION = '3.33'; -$VERSION = eval $VERSION; +$VERSION = '3.40'; +$VERSION =~ tr/_//; my %module = (MacOS => 'Mac', MSWin32 => 'Win32', @@ -197,12 +197,14 @@ join is the same as catfile. X X Splits a path in to volume, directory, and filename portions. On systems -with no concept of volume, returns '' for volume. +with no concept of volume, returns '' for volume. - ($volume,$directories,$file) = File::Spec->splitpath( $path ); - ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file ); + ($volume,$directories,$file) = + File::Spec->splitpath( $path ); + ($volume,$directories,$file) = + File::Spec->splitpath( $path, $no_file ); -For systems with no syntax differentiating filenames from directories, +For systems with no syntax differentiating filenames from directories, assumes that the last file is a path unless C<$no_file> is true or a trailing separator or F or F is present. On Unix, this means that C<$no_file> true makes this return ( '', $path, '' ). @@ -219,7 +221,7 @@ The opposite of L. @dirs = File::Spec->splitdir( $directories ); -C<$directories> must be only the directory portion of the path on systems +C<$directories> must be only the directory portion of the path on systems that have the concept of a volume or that have path syntax that differentiates files from directories. @@ -255,7 +257,7 @@ paths, and we will instead simply return C<$path>. Note that previous versions of this module ignored the volume of C<$base>, which resulted in garbage results part of the time. -On systems that have a grammar that indicates filenames, this ignores the +On systems that have a grammar that indicates filenames, this ignores the C<$base> filename as well. Otherwise all path components are assumed to be directories. @@ -271,7 +273,7 @@ Based on code written by Shigio Yamaguchi. =item rel2abs() X X X -Converts a relative path to an absolute path. +Converts a relative path to an absolute path. $abs_path = File::Spec->rel2abs( $path ) ; $abs_path = File::Spec->rel2abs( $path, $base ) ; @@ -286,7 +288,7 @@ paths, and we will instead simply return C<$path>. Note that previous versions of this module ignored the volume of C<$base>, which resulted in garbage results part of the time. -On systems that have a grammar that indicates filenames, this ignores the +On systems that have a grammar that indicates filenames, this ignores the C<$base> filename as well. Otherwise all path components are assumed to be directories. @@ -329,7 +331,7 @@ splitpath(), splitdir(), catpath() and catdir() by Barrie Slaymaker. =head1 COPYRIGHT -Copyright (c) 2004-2010 by the Perl 5 Porters. All rights reserved. +Copyright (c) 2004-2013 by the Perl 5 Porters. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/inc/bundle/File/Spec/Cygwin.pm b/inc/bundle/File/Spec/Cygwin.pm index 0709c6fc..b27f7b15 100644 --- a/inc/bundle/File/Spec/Cygwin.pm +++ b/inc/bundle/File/Spec/Cygwin.pm @@ -4,8 +4,8 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.33'; -$VERSION = eval $VERSION; +$VERSION = '3.40'; +$VERSION =~ tr/_//; @ISA = qw(File::Spec::Unix); diff --git a/inc/bundle/File/Spec/Epoc.pm b/inc/bundle/File/Spec/Epoc.pm index a3bb62b8..e7faa160 100644 --- a/inc/bundle/File/Spec/Epoc.pm +++ b/inc/bundle/File/Spec/Epoc.pm @@ -3,8 +3,8 @@ package File::Spec::Epoc; use strict; use vars qw($VERSION @ISA); -$VERSION = '3.33'; -$VERSION = eval $VERSION; +$VERSION = '3.40'; +$VERSION =~ tr/_//; require File::Spec::Unix; @ISA = qw(File::Spec::Unix); diff --git a/inc/bundle/File/Spec/Functions.pm b/inc/bundle/File/Spec/Functions.pm index 2ee8f5d2..f5b9046a 100644 --- a/inc/bundle/File/Spec/Functions.pm +++ b/inc/bundle/File/Spec/Functions.pm @@ -5,8 +5,8 @@ use strict; use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); -$VERSION = '3.33'; -$VERSION = eval $VERSION; +$VERSION = '3.40'; +$VERSION =~ tr/_//; require Exporter; diff --git a/inc/bundle/File/Spec/Mac.pm b/inc/bundle/File/Spec/Mac.pm index fd528adc..7f42171b 100644 --- a/inc/bundle/File/Spec/Mac.pm +++ b/inc/bundle/File/Spec/Mac.pm @@ -4,8 +4,8 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.33'; -$VERSION = eval $VERSION; +$VERSION = '3.40'; +$VERSION =~ tr/_//; @ISA = qw(File::Spec::Unix); @@ -156,13 +156,16 @@ their Unix counterparts: Unix: Unix->catdir("","") = "/" Unix->catdir("",".") = "/" - Unix->catdir("","..") = "/" # can't go beyond root + Unix->catdir("","..") = "/" # can't go + # beyond root Unix->catdir("",".","..","..","a") = "/a" Mac: - Mac->catdir("","") = rootdir() # (e.g. "HD:") + Mac->catdir("","") = rootdir() # (e.g. "HD:") Mac->catdir("",":") = rootdir() - Mac->catdir("","::") = rootdir() # can't go beyond root - Mac->catdir("",":","::","::","a") = rootdir() . "a:" # (e.g. "HD:a:") + Mac->catdir("","::") = rootdir() # can't go + # beyond root + Mac->catdir("",":","::","::","a") = rootdir() . "a:" + # (e.g. "HD:a:") However, this approach is limited to the first arguments following "root" (again, see Ccanonpath()> ). If there are more @@ -400,10 +403,11 @@ the filename '' is always considered to be absolute. Note that with version E.g. - File::Spec->file_name_is_absolute("a"); # false (relative) - File::Spec->file_name_is_absolute(":a:b:"); # false (relative) - File::Spec->file_name_is_absolute("MacintoshHD:"); # true (absolute) - File::Spec->file_name_is_absolute(""); # true (absolute) + File::Spec->file_name_is_absolute("a"); # false (relative) + File::Spec->file_name_is_absolute(":a:b:"); # false (relative) + File::Spec->file_name_is_absolute("MacintoshHD:"); + # true (absolute) + File::Spec->file_name_is_absolute(""); # true (absolute) =cut @@ -440,7 +444,8 @@ sub path { =item splitpath ($volume,$directories,$file) = File::Spec->splitpath( $path ); - ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file ); + ($volume,$directories,$file) = File::Spec->splitpath( $path, + $no_file ); Splits a path into volume, directory, and filename portions. @@ -683,7 +688,7 @@ sub abs2rel { # Now, remove all leading components that are the same my @pathchunks = $self->splitdir( $path_dirs ); my @basechunks = $self->splitdir( $base_dirs ); - + while ( @pathchunks && @basechunks && lc( $pathchunks[0] ) eq lc( $basechunks[0] ) ) { @@ -740,7 +745,7 @@ sub rel2abs { # Split up paths - # igonore $path's volume + # ignore $path's volume my ( $path_dirs, $path_file ) = ($self->splitpath($path))[1,2] ; # ignore $base's file part diff --git a/inc/bundle/File/Spec/OS2.pm b/inc/bundle/File/Spec/OS2.pm index 0a95d511..7f60d689 100644 --- a/inc/bundle/File/Spec/OS2.pm +++ b/inc/bundle/File/Spec/OS2.pm @@ -4,8 +4,8 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.33'; -$VERSION = eval $VERSION; +$VERSION = '3.40'; +$VERSION =~ tr/_//; @ISA = qw(File::Spec::Unix); @@ -74,15 +74,15 @@ sub splitpath { my ($self,$path, $nofile) = @_; my ($volume,$directory,$file) = ('','',''); if ( $nofile ) { - $path =~ - m{^( (?:[a-zA-Z]:|(?:\\\\|//)[^\\/]+[\\/][^\\/]+)? ) + $path =~ + m{^( (?:[a-zA-Z]:|(?:\\\\|//)[^\\/]+[\\/][^\\/]+)? ) (.*) }xs; $volume = $1; $directory = $2; } else { - $path =~ + $path =~ m{^ ( (?: [a-zA-Z]: | (?:\\\\|//)[^\\/]+[\\/][^\\/]+ )? @@ -117,7 +117,7 @@ sub catpath { $volume .= $directory ; - # If the volume is not just A:, make sure the glue separator is + # If the volume is not just A:, make sure the glue separator is # there, reusing whatever separator is first in the $volume if possible. if ( $volume !~ m@^[a-zA-Z]:\Z(?!\n)@s && $volume =~ m@[^\\/]\Z(?!\n)@ && @@ -162,9 +162,9 @@ sub abs2rel { my @pathchunks = $self->splitdir( $path_directories ); my @basechunks = $self->splitdir( $base_directories ); - while ( @pathchunks && - @basechunks && - lc( $pathchunks[0] ) eq lc( $basechunks[0] ) + while ( @pathchunks && + @basechunks && + lc( $pathchunks[0] ) eq lc( $basechunks[0] ) ) { shift @pathchunks ; shift @basechunks ; @@ -175,7 +175,7 @@ sub abs2rel { $base_directories = CORE::join( '/', @basechunks ); # $base_directories now contains the directories the resulting relative - # path must ascend out of before it can descend to $path_directory. So, + # path must ascend out of before it can descend to $path_directory. So, # replace all names with $parentDir #FA Need to replace between backslashes... @@ -191,8 +191,8 @@ sub abs2rel { $path_directories = "$base_directories$path_directories" ; } - return $self->canonpath( - $self->catpath( "", $path_directories, $path_file ) + return $self->canonpath( + $self->catpath( "", $path_directories, $path_file ) ) ; } @@ -218,9 +218,9 @@ sub rel2abs { my ( $base_volume, $base_directories ) = $self->splitpath( $base, 1 ) ; - $path = $self->catpath( - $base_volume, - $self->catdir( $base_directories, $path_directories ), + $path = $self->catpath( + $base_volume, + $self->catdir( $base_directories, $path_directories ), $path_file ) ; } diff --git a/inc/bundle/File/Spec/Unix.pm b/inc/bundle/File/Spec/Unix.pm index 47f8fecf..5217b9af 100644 --- a/inc/bundle/File/Spec/Unix.pm +++ b/inc/bundle/File/Spec/Unix.pm @@ -3,8 +3,8 @@ package File::Spec::Unix; use strict; use vars qw($VERSION); -$VERSION = '3.33'; -$VERSION = eval $VERSION; +$VERSION = '3.40'; +$VERSION =~ tr/_//; =head1 NAME @@ -43,7 +43,7 @@ actually traverse the filesystem cleaning up paths like this. sub canonpath { my ($self,$path) = @_; return unless defined $path; - + # Handle POSIX-style node names beginning with double slash (qnx, nto) # (POSIX says: "a pathname that begins with two successive slashes # may be interpreted in an implementation-defined manner, although @@ -135,7 +135,7 @@ writable: $ENV{TMPDIR} /tmp -Since perl 5.8.0, if running under taint mode, and if $ENV{TMPDIR} +If running under taint mode, and if $ENV{TMPDIR} is tainted, it is not used. =cut @@ -151,6 +151,9 @@ sub _tmpdir { require Scalar::Util; @dirlist = grep { ! Scalar::Util::tainted($_) } @dirlist; } + elsif ($] < 5.007) { # No ${^TAINT} before 5.8 + @dirlist = grep { eval { eval('1'.substr $_,0,0) } } @dirlist; + } } foreach (@dirlist) { next unless defined && -d && -w _; @@ -200,7 +203,7 @@ sub case_tolerant { 0 } Takes as argument a path and returns true if it is an absolute path. -This does not consult the local filesystem on Unix, Win32, OS/2 or Mac +This does not consult the local filesystem on Unix, Win32, OS/2 or Mac OS (Classic). It does consult the working environment for VMS (see L). @@ -238,13 +241,14 @@ sub join { =item splitpath ($volume,$directories,$file) = File::Spec->splitpath( $path ); - ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file ); + ($volume,$directories,$file) = File::Spec->splitpath( $path, + $no_file ); Splits a path into volume, directory, and filename portions. On systems -with no concept of volume, returns '' for volume. +with no concept of volume, returns '' for volume. -For systems with no syntax differentiating filenames from directories, -assumes that the last file is a path unless $no_file is true or a +For systems with no syntax differentiating filenames from directories, +assumes that the last file is a path unless $no_file is true or a trailing separator or /. or /.. is present. On Unix this means that $no_file true makes this return ( '', $path, '' ). @@ -279,7 +283,7 @@ The opposite of L. @dirs = File::Spec->splitdir( $directories ); -$directories must be only the directory portion of the path on systems +$directories must be only the directory portion of the path on systems that have the concept of a volume or that have path syntax that differentiates files from directories. @@ -314,10 +318,10 @@ inserted if needed (though if the directory portion doesn't start with sub catpath { my ($self,$volume,$directory,$file) = @_; - if ( $directory ne '' && - $file ne '' && - substr( $directory, -1 ) ne '/' && - substr( $file, 0, 1 ) ne '/' + if ( $directory ne '' && + $file ne '' && + substr( $directory, -1 ) ne '/' && + substr( $file, 0, 1 ) ne '/' ) { $directory .= "/$file" ; } @@ -341,16 +345,18 @@ relative, then it is converted to absolute form using L. This means that it is taken to be relative to L. -On systems that have a grammar that indicates filenames, this ignores the +On systems that have a grammar that indicates filenames, this ignores the $base filename. Otherwise all path components are assumed to be directories. If $path is relative, it is converted to absolute form using L. This means that it is taken to be relative to L. -No checks against the filesystem are made. On VMS, there is -interaction with the working environment, as logicals and -macros are expanded. +No checks against the filesystem are made, so the result may not be correct if +C<$base> contains symbolic links. (Apply +L beforehand if that +is a concern.) On VMS, there is interaction with the working environment, as +logicals and macros are expanded. Based on code written by Shigio Yamaguchi. @@ -362,13 +368,11 @@ sub abs2rel { ($path, $base) = map $self->canonpath($_), $path, $base; + my $path_directories; + my $base_directories; + if (grep $self->file_name_is_absolute($_), $path, $base) { ($path, $base) = map $self->rel2abs($_), $path, $base; - } - else { - # save a couple of cwd()s if both paths are relative - ($path, $base) = map $self->catdir('/', $_), $path, $base; - } my ($path_volume) = $self->splitpath($path, 1); my ($base_volume) = $self->splitpath($base, 1); @@ -376,8 +380,8 @@ sub abs2rel { # Can't relativize across volumes return $path unless $path_volume eq $base_volume; - my $path_directories = ($self->splitpath($path, 1))[1]; - my $base_directories = ($self->splitpath($base, 1))[1]; + $path_directories = ($self->splitpath($path, 1))[1]; + $base_directories = ($self->splitpath($base, 1))[1]; # For UNC paths, the user might give a volume like //foo/bar that # strictly speaking has no directory portion. Treat it as if it @@ -385,25 +389,51 @@ sub abs2rel { if (!length($base_directories) and $self->file_name_is_absolute($base)) { $base_directories = $self->rootdir; } + } + else { + my $wd= ($self->splitpath($self->_cwd(), 1))[1]; + $path_directories = $self->catdir($wd, $path); + $base_directories = $self->catdir($wd, $base); + } # Now, remove all leading components that are the same my @pathchunks = $self->splitdir( $path_directories ); my @basechunks = $self->splitdir( $base_directories ); if ($base_directories eq $self->rootdir) { + return $self->curdir if $path_directories eq $self->rootdir; shift @pathchunks; return $self->canonpath( $self->catpath('', $self->catdir( @pathchunks ), '') ); } + my @common; while (@pathchunks && @basechunks && $self->_same($pathchunks[0], $basechunks[0])) { - shift @pathchunks ; + push @common, shift @pathchunks ; shift @basechunks ; } return $self->curdir unless @pathchunks || @basechunks; - # $base now contains the directories the resulting relative path - # must ascend out of before it can descend to $path_directory. - my $result_dirs = $self->catdir( ($self->updir) x @basechunks, @pathchunks ); + # @basechunks now contains the directories the resulting relative path + # must ascend out of before it can descend to $path_directory. If there + # are updir components, we must descend into the corresponding directories + # (this only works if they are no symlinks). + my @reverse_base; + while( defined(my $dir= shift @basechunks) ) { + if( $dir ne $self->updir ) { + unshift @reverse_base, $self->updir; + push @common, $dir; + } + elsif( @common ) { + if( @reverse_base && $reverse_base[0] eq $self->updir ) { + shift @reverse_base; + pop @common; + } + else { + unshift @reverse_base, pop @common; + } + } + } + my $result_dirs = $self->catdir( @reverse_base, @pathchunks ); return $self->canonpath( $self->catpath('', $result_dirs, '') ); } @@ -413,7 +443,7 @@ sub _same { =item rel2abs() -Converts a relative path to an absolute path. +Converts a relative path to an absolute path. $abs_path = File::Spec->rel2abs( $path ) ; $abs_path = File::Spec->rel2abs( $path, $base ) ; @@ -469,6 +499,8 @@ Copyright (c) 2004 by the Perl 5 Porters. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. +Please submit bug reports and patches to perlbug@perl.org. + =head1 SEE ALSO L @@ -502,7 +534,7 @@ sub _collapse { length $collapsed[-1] and # and its not the rootdir $collapsed[-1] ne $updir and # nor another updir $collapsed[-1] ne $curdir # nor the curdir - ) + ) { # then pop @collapsed; # collapse } diff --git a/inc/bundle/File/Spec/VMS.pm b/inc/bundle/File/Spec/VMS.pm index 5bee8973..5ac97bd8 100644 --- a/inc/bundle/File/Spec/VMS.pm +++ b/inc/bundle/File/Spec/VMS.pm @@ -4,8 +4,8 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.33'; -$VERSION = eval $VERSION; +$VERSION = '3.40'; +$VERSION =~ tr/_//; @ISA = qw(File::Spec::Unix); @@ -26,16 +26,9 @@ See File::Spec::Unix for a documentation of the methods provided there. This package overrides the implementation of these methods, not the semantics. -The default behavior is to allow either VMS or Unix syntax on input and to -return VMS syntax on output, even when Unix syntax was given on input. - -When used with a Perl of version 5.10 or greater and a CRTL possessing the -relevant capabilities, override behavior depends on the CRTL features -C and C. When the -C feature is enabled and the input parameters are clearly -in Unix syntax, the output will be in Unix syntax. If -C is enabled and the output syntax cannot be -determined from the input syntax, the output will be in Unix syntax. +The default behavior is to allow either VMS or Unix syntax on input and to +return VMS syntax on output unless Unix syntax has been explicity requested +via the C CRTL feature. =over 4 @@ -59,28 +52,15 @@ sub _unix_rpt { $unix_rpt = VMS::Feature::current("filename_unix_report"); } else { my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || ''; - $unix_rpt = $env_unix_rpt =~ /^[ET1]/i; + $unix_rpt = $env_unix_rpt =~ /^[ET1]/i; } return $unix_rpt; } -# Need to look up the EFS character set mode. This may become a dynamic -# mode in the future. -sub _efs { - my $efs; - if ($use_feature) { - $efs = VMS::Feature::current("efs_charset"); - } else { - my $env_efs = $ENV{'DECC$EFS_CHARSET'} || ''; - $efs = $env_efs =~ /^[ET1]/i; - } - return $efs; -} - =item canonpath (override) -Removes redundant portions of file specifications according to the syntax -detected. +Removes redundant portions of file specifications and returns results +in native syntax unless Unix filename reporting has been enabled. =cut @@ -90,37 +70,31 @@ sub canonpath { return undef unless defined $path; - my $efs = $self->_efs; + my $unix_rpt = $self->_unix_rpt; - if ($path =~ m|/|) { # Fake Unix + if ($path =~ m|/|) { my $pathify = $path =~ m|/\Z(?!\n)|; $path = $self->SUPER::canonpath($path); - # Do not convert to VMS when EFS character sets are in use - return $path if $efs; - - if ($pathify) { return vmspath($path); } - else { return vmsify($path); } + return $path if $unix_rpt; + $path = $pathify ? vmspath($path) : vmsify($path); } - else { - -#FIXME - efs parsing has different rules. Characters in a VMS filespec -# are only delimiters if not preceded by '^'; - $path =~ tr/<>/[]/; # < and > ==> [ and ] - $path =~ s/\]\[\./\.\]\[/g; # ][. ==> .][ - $path =~ s/\[000000\.\]\[/\[/g; # [000000.][ ==> [ - $path =~ s/\[000000\./\[/g; # [000000. ==> [ - $path =~ s/\.\]\[000000\]/\]/g; # .][000000] ==> ] - $path =~ s/\.\]\[/\./g; # foo.][bar ==> foo.bar - 1 while ($path =~ s/([\[\.])(-+)\.(-+)([\.\]])/$1$2$3$4/); + $path =~ s/(? ==> [ and ] + $path =~ s/(?/]/; + $path =~ s/(? .][ + $path =~ s/(? [ + $path =~ s/(? [ + $path =~ s/(? ] + $path =~ s/(? foo.bar + 1 while ($path =~ s/(? .--. # [-.-. ==> [--. # .-.-] ==> .--] # [-.-] ==> [--] - 1 while ($path =~ s/([\[\.])[^\]\.]+\.-(-+)([\]\.])/$1$2$3/); + 1 while ($path =~ s/(? [-] # # And then, the remaining cases - $path =~ s/\[\.-/[-/; # [.- ==> [- - $path =~ s/\.[^\]\.]+\.-\./\./g; # .foo.-. ==> . - $path =~ s/\[[^\]\.]+\.-\./\[/g; # [foo.-. ==> [ - $path =~ s/\.[^\]\.]+\.-\]/\]/g; # .foo.-] ==> ] - $path =~ s/\[[^\]\.]+\.-\]/\[000000\]/g;# [foo.-] ==> [000000] - $path =~ s/\[\]// unless $path eq '[]'; # [] ==> - return $path; - } + $path =~ s/(? [- + $path =~ s/(? . + $path =~ s/(? [ + $path =~ s/(? ] + # [foo.-] ==> [000000] + $path =~ s/(? + $path =~ s/(?_efs; my $unix_rpt = $self->_unix_rpt; - my @dirs = grep {defined() && length()} @_; - if ($efs) { - # Legacy mode removes blank entries. - # But that breaks existing generic perl code that - # uses a blank path at the beginning of the array - # to indicate an absolute path. - # So put it back if found. - if (@_) { - if ($_[0] eq '') { - unshift @dirs, ''; - } - } - } my $rslt; if (@dirs) { my $path = (@dirs == 1 ? $dirs[0] : $self->catdir(@dirs)); my ($spath,$sdir) = ($path,$dir); + $spath =~ s/\.dir\Z(?!\n)//i; $sdir =~ s/\.dir\Z(?!\n)//i; - if ($efs) { - # Extended character set in use, go into DWIM mode. - - # Now we need to identify what the directory is in - # of the specification in order to merge them. - my $path_unix = 0; - $path_unix = 1 if ($path =~ m#/#); - $path_unix = 1 if ($path =~ /^\.\.?$/); - my $path_vms = 0; - $path_vms = 1 if ($path =~ m#(?SUPER::catdir($spath, $sdir) } - if ($unix_mode) { - - # Fix up mixed syntax imput as good as possible - GIGO - $path = unixify($path) if $path_vms; - $dir = unixify($dir) if $dir_vms; - - $rslt = $path; - # Append a path delimiter - $rslt .= '/' unless ($rslt =~ m#/$#); - - $rslt .= $dir; - return $self->SUPER::canonpath($rslt); - } else { - - #with <> posible instead of [. - # Normalize the brackets - # Fixme - need to not switch when preceded by ^. - $path =~ s//\]/g; - $dir =~ s//\]/g; - - # Fix up mixed syntax imput as good as possible - GIGO - $path = vmsify($path) if $path_unix; - $dir = vmsify($dir) if $dir_unix; - - #Possible path values: foo: [.foo] [foo] foo, and $(foo) - #or starting with '-', or foo.dir - #If path is foo, it needs to be converted to [.foo] - - # Fix up a bare path name. - unless ($path_vms) { - $path =~ s/\.dir\Z(?!\n)//i; - if (($path ne '') && ($path !~ /^-/)) { - # Non blank and not prefixed with '-', add a dot - $path = '[.' . $path; - } else { - # Just start a directory. - $path = '[' . $path; - } - } else { - $path =~ s/\]$//; - } - - #Possible dir values: [.dir] dir and $(foo) - - # No punctuation may have a trailing .dir - unless ($dir_vms) { - $dir =~ s/\.dir\Z(?!\n)//i; - } else { - - #strip off the brackets - $dir =~ s/^\[//; - $dir =~ s/\]$//; - } - - #strip off the leading dot if present. - $dir =~ s/^\.//; - - # Now put the specifications together. - if ($dir ne '') { - # Add a separator unless this is an absolute path - $path .= '.' if ($path ne '['); - $rslt = $path . $dir . ']'; - } else { - $rslt = $path . ']'; - } - } - - } else { - # Traditional ODS-2 mode. - $spath =~ s/\.dir\Z(?!\n)//i; $sdir =~ s/\.dir\Z(?!\n)//i; - - $sdir = $self->eliminate_macros($sdir) - unless $sdir =~ /^[\w\-]+\Z(?!\n)/s; + $sdir = $self->eliminate_macros($sdir) unless $sdir =~ /^[\w\-]+\Z(?!\n)/s; $rslt = $self->fixpath($self->eliminate_macros($spath)."/$sdir",1); # Special case for VMS absolute directory specs: these will have @@ -284,39 +152,15 @@ sub catdir { # eliminate_macros(), since Unix syntax has no way to express # "absolute from the top of this device's directory tree". if ($spath =~ /^[\[<][^.\-]/s) { $rslt =~ s/^[^\[<]+//s; } - } - } else { - # Single directory, just make sure it is in directory format - # Return an empty string on null input, and pass through macros. - if (not defined $dir or not length $dir) { $rslt = ''; } - elsif ($dir =~ /^\$\([^\)]+\)\Z(?!\n)/s) { - $rslt = $dir; - } else { - my $unix_mode = 0; - - if ($efs) { - my $dir_unix = 0; - $dir_unix = 1 if ($dir =~ m#/#); - $dir_unix = 1 if ($dir =~ /^\.\.?$/); - my $dir_vms = 0; - $dir_vms = 1 if ($dir =~ m#(?canonpath($rslt); @@ -335,141 +179,36 @@ sub catfile { my $file = $self->canonpath($tfile); my @files = grep {defined() && length()} @_; - my $efs = $self->_efs; my $unix_rpt = $self->_unix_rpt; - # Assume VMS mode - my $unix_mode = 0; - my $file_unix = 0; - my $file_vms = 0; - if ($efs) { - - # Now we need to identify format the file is in - # of the specification in order to merge them. - $file_unix = 1 if ($tfile =~ m#/#); - $file_unix = 1 if ($tfile =~ /^\.\.?$/); - $file_vms = 1 if ($tfile =~ m#(?catdir(@files); - } + my $path = (@files == 1 ? $files[0] : $self->catdir(@files)); my $spath = $path; - # Some thing building a VMS path in pieces may try to pass a + # Something building a VMS path in pieces may try to pass a # directory name in filename format, so normalize it. $spath =~ s/\.dir\Z(?!\n)//i; - # if the spath ends with a directory delimiter and the file is bare, - # then just concat them. + # If the spath ends with a directory delimiter and the file is bare, + # then just concatenate them. if ($spath =~ /^(?]+\)\Z(?!\n)/s && basename($file) eq $file) { $rslt = "$spath$file"; } else { - if ($efs) { - - # Now we need to identify what the directory is in - # of the specification in order to merge them. - my $spath_unix = 0; - $spath_unix = 1 if ($spath =~ m#/#); - $spath_unix = 1 if ($spath =~ /^\.\.?$/); - my $spath_vms = 0; - $spath_vms = 1 if ($spath =~ m#(?eliminate_macros($spath); - - - $rslt = vmsify($rslt.((defined $rslt) && - ($rslt ne '') ? '/' : '').unixify($file)); - } + $rslt .= (defined($rslt) && length($rslt) ? '/' : '') . unixify($file); + $rslt = vmsify($rslt) unless $unix_rpt; } } else { # Only passed a single file? - my $xfile = $file; + my $xfile = (defined($file) && length($file)) ? $file : ''; - # Traditional VMS perl expects this conversion. - $xfile = vmsify($file) unless ($efs); - - $rslt = (defined($file) && length($file)) ? $xfile : ''; + $rslt = $unix_rpt ? $file : vmsify($file); } return $self->canonpath($rslt) unless $unix_rpt; - # In Unix report mode, do not strip off redundent path information. + # In Unix report mode, do not strip off redundant path information. return $rslt; } @@ -602,7 +341,8 @@ sub file_name_is_absolute { =item splitpath (override) ($volume,$directories,$file) = File::Spec->splitpath( $path ); - ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file ); + ($volume,$directories,$file) = File::Spec->splitpath( $path, + $no_file ); Passing a true value for C<$no_file> indicates that the path being split only contains directory components, even on systems where you @@ -614,17 +354,7 @@ between directories and files at a glance. sub splitpath { my($self,$path, $nofile) = @_; my($dev,$dir,$file) = ('','',''); - my $efs = $self->_efs; my $vmsify_path = vmsify($path); - if ($efs) { - my $path_vms = 0; - $path_vms = 1 if ($path =~ m#(?SUPER::splitpath($path, $nofile); - } - $vmsify_path = $path; - } if ( $nofile ) { #vmsify('d1/d2/d3') returns '[.d1.d2]d3' @@ -653,25 +383,13 @@ sub splitdir { my @dirs = (); return @dirs if ( (!defined $dirspec) || ('' eq $dirspec) ); - my $efs = $self->_efs; - - my $dir_unix = 0; - $dir_unix = 1 if ($dirspec =~ m#/#); - $dir_unix = 1 if ($dirspec =~ /^\.\.?$/); - - # Unix filespecs in EFS mode handled by Unix routines. - if ($efs && $dir_unix) { - return $self->SUPER::splitdir($dirspec); - } - - # FIX ME, only split for VMS delimiters not prefixed with '^'. - - $dirspec =~ tr/<>/[]/; # < and > ==> [ and ] - $dirspec =~ s/\]\[\./\.\]\[/g; # ][. ==> .][ - $dirspec =~ s/\[000000\.\]\[/\[/g; # [000000.][ ==> [ - $dirspec =~ s/\[000000\./\[/g; # [000000. ==> [ - $dirspec =~ s/\.\]\[000000\]/\]/g; # .][000000] ==> ] - $dirspec =~ s/\.\]\[/\./g; # foo.][bar ==> foo.bar + $dirspec =~ s/(? ==> [ and ] + $dirspec =~ s/(?/]/; + $dirspec =~ s/(? .][ + $dirspec =~ s/(? [ + $dirspec =~ s/(? [ + $dirspec =~ s/(? ] + $dirspec =~ s/(? foo.bar while ($dirspec =~ s/(^|[\[\<\.])\-(\-+)($|[\]\>\.])/$1-.$2$3/g) {} # That loop does the following # with any amount of dashes: @@ -695,155 +413,48 @@ Construct a complete filespec. sub catpath { my($self,$dev,$dir,$file) = @_; - - my $efs = $self->_efs; - my $unix_rpt = $self->_unix_rpt; - - my $unix_mode = 0; - my $dir_unix = 0; - $dir_unix = 1 if ($dir =~ m#/#); - $dir_unix = 1 if ($dir =~ /^\.\.?$/); - my $dir_vms = 0; - $dir_vms = 1 if ($dir =~ m#(?splitpath($dir); $dev = $dir_volume unless length $dev; - $dir = length $dir_file ? $self->catfile($dir_dir, $dir_file) : - $dir_dir; - } - if ($dev =~ m|^/+([^/]+)|) { $dev = "$1:"; } + $dir = length $dir_file ? $self->catfile($dir_dir, $dir_file) : $dir_dir; + + if ($dev =~ m|^(?'); "$dev$dir$file"; } =item abs2rel (override) -Attempt to convert a file specification to a relative specification. -On a system with volumes, like VMS, this may not be possible. +Attempt to convert an absolute file specification to a relative specification. =cut sub abs2rel { my $self = shift; - my($path,$base) = @_; - - my $efs = $self->_efs; - my $unix_rpt = $self->_unix_rpt; - - # We need to identify what the directory is in - # of the specification in order to process them - my $path_unix = 0; - $path_unix = 1 if ($path =~ m#/#); - $path_unix = 1 if ($path =~ /^\.\.?$/); - my $path_vms = 0; - $path_vms = 1 if ($path =~ m#(?_cwd(); - if ($efs) { - $base_unix = 1 if ($base =~ m#/#); - $base_unix = 1 if ($base =~ /^\.\.?$/); - $base = vmspath($base) if $base_unix; - } - } + my($path,$base) = @_; + $base = $self->_cwd() unless defined $base and length $base; for ($path, $base) { $_ = $self->canonpath($_) } # Are we even starting $path on the same (node::)device as $base? Note that - # logical paths or nodename differences may be on the "same device" - # but the comparison that ignores device differences so as to concatenate - # [---] up directory specs is not even a good idea in cases where there is + # logical paths or nodename differences may be on the "same device" + # but the comparison that ignores device differences so as to concatenate + # [---] up directory specs is not even a good idea in cases where there is # a logical path difference between $path and $base nodename and/or device. # Hence we fall back to returning the absolute $path spec # if there is a case blind device (or node) difference of any sort # and we do not even try to call $parse() or consult %ENV for $trnlnm() # (this module needs to run on non VMS platforms after all). - + my ($path_volume, $path_directories, $path_file) = $self->splitpath($path); my ($base_volume, $base_directories, $base_file) = $self->splitpath($base); return $path unless lc($path_volume) eq lc($base_volume); @@ -858,9 +469,9 @@ sub abs2rel { my $basechunks = @basechunks; unshift(@basechunks,'000000') unless $basechunks[0] eq '000000'; - while ( @pathchunks && - @basechunks && - lc( $pathchunks[0] ) eq lc( $basechunks[0] ) + while ( @pathchunks && + @basechunks && + lc( $pathchunks[0] ) eq lc( $basechunks[0] ) ) { shift @pathchunks ; shift @basechunks ; @@ -889,57 +500,12 @@ sub rel2abs { my $self = shift ; my ($path,$base ) = @_; return undef unless defined $path; - - my $efs = $self->_efs; - my $unix_rpt = $self->_unix_rpt; - - # We need to identify what the directory is in - # of the specification in order to process them - my $path_unix = 0; - $path_unix = 1 if ($path =~ m#/#); - $path_unix = 1 if ($path =~ /^\.\.?$/); - my $path_vms = 0; - $path_vms = 1 if ($path =~ m#(?file_name_is_absolute( $path ) ) { @@ -954,20 +520,6 @@ sub rel2abs { $base = $self->canonpath( $base ) ; } - if ($efs) { - # base may have changed, so need to look up format again. - if ($unix_mode) { - $base_vms = 1 if ($base =~ m#(?splitpath( $path ))[1,2] ; @@ -978,23 +530,12 @@ sub rel2abs { $path_directories = '' if $path_directories eq '[]' || $path_directories eq '<>'; my $sep = '' ; - - if ($efs) { - # Merge the paths assuming that the base is absolute. - $base_directories = $self->catdir('', - $base_directories, - $path_directories); - } else { - # Legacy behavior assumes VMS only paths $sep = '.' if ( $base_directories =~ m{[^.\]>]\Z(?!\n)} && $path_directories =~ m{^[^.\[<]}s ) ; $base_directories = "$base_directories$sep$path_directories"; $base_directories =~ s{\.?[\]>][\[<]\.?}{.}; - } - - $path_file = '' if ($path_file eq '.') && $unix_mode; $path = $self->catpath( $base_volume, $base_directories, $path_file ); } @@ -1008,16 +549,12 @@ sub rel2abs { # copies as of 6.06_03 which are the canonical ones. We leave these # here, in peace, so that File::Spec continues to work with MakeMakers # prior to 6.06_03. -# +# # Please consider these two methods deprecated. Do not patch them, # patch the ones in ExtUtils::MM_VMS instead. # # Update: MakeMaker 6.48 is still using these routines on VMS. # so they need to be kept up to date with ExtUtils::MM_VMS. -# -# The traditional VMS mode using ODS-2 disks depends on these routines -# being here. These routines should not be called in when the -# C or C modes are enabled. sub eliminate_macros { my($self,$path) = @_; @@ -1036,7 +573,7 @@ sub eliminate_macros { my($head,$macro,$tail); # perform m##g in scalar context so it acts as an iterator - while ($npath =~ m#(.*?)\$\((\S+?)\)(.*)#gs) { + while ($npath =~ m#(.*?)\$\((\S+?)\)(.*)#gs) { if (defined $self->{$2}) { ($head,$macro,$tail) = ($1,$2,$3); if (ref $self->{$macro}) { @@ -1084,7 +621,7 @@ sub fixpath { split /\s+/, $path; } - if ($path =~ m#^\$\([^\)]+\)\Z(?!\n)#s || $path =~ m#[/:>\]]#) { + if ($path =~ m#^\$\([^\)]+\)\Z(?!\n)#s || $path =~ m#[/:>\]]#) { if ($force_path or $path =~ /(?:DIR\)|\])\Z(?!\n)/) { $fixedpath = vmspath($self->eliminate_macros($path)); } diff --git a/inc/bundle/File/Spec/Win32.pm b/inc/bundle/File/Spec/Win32.pm index 43f770e4..ae74a265 100644 --- a/inc/bundle/File/Spec/Win32.pm +++ b/inc/bundle/File/Spec/Win32.pm @@ -5,8 +5,8 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.33'; -$VERSION = eval $VERSION; +$VERSION = '3.40'; +$VERSION =~ tr/_//; @ISA = qw(File::Spec::Unix); @@ -172,7 +172,7 @@ sub path { No physical check on the filesystem, but a logical cleanup of a path. On UNIX eliminated successive slashes and successive "/.". -On Win32 makes +On Win32 makes dir1\dir2\dir3\..\..\dir4 -> \dir\dir4 and even dir1\dir2\dir3\...\dir4 -> \dir\dir4 @@ -189,11 +189,12 @@ sub canonpath { =item splitpath ($volume,$directories,$file) = File::Spec->splitpath( $path ); - ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file ); + ($volume,$directories,$file) = File::Spec->splitpath( $path, + $no_file ); -Splits a path into volume, directory, and filename portions. Assumes that +Splits a path into volume, directory, and filename portions. Assumes that the last file is a path unless the path ends in '\\', '\\.', '\\..' -or $no_file is true. On Win32 this means that $no_file true makes this return +or $no_file is true. On Win32 this means that $no_file true makes this return ( $volume, $path, '' ). Separators accepted are \ and /. @@ -209,13 +210,13 @@ sub splitpath { my ($self,$path, $nofile) = @_; my ($volume,$directory,$file) = ('','',''); if ( $nofile ) { - $path =~ + $path =~ m{^ ( $VOL_RX ? ) (.*) }sox; $volume = $1; $directory = $2; } else { - $path =~ + $path =~ m{^ ( $VOL_RX ? ) ( (?:.*[\\/](?:\.\.?\Z(?!\n))?)? ) (.*) @@ -231,15 +232,15 @@ sub splitpath { =item splitdir -The opposite of L. +The opposite of L. @dirs = File::Spec->splitdir( $directories ); -$directories must be only the directory portion of the path on systems +$directories must be only the directory portion of the path on systems that have the concept of a volume or that have path syntax that differentiates files from directories. -Unlike just splitting the directories on the separator, leading empty and +Unlike just splitting the directories on the separator, leading empty and trailing directory entries can be returned, because these are significant on some OSs. So, @@ -263,7 +264,7 @@ sub splitdir { } else { # - # since there was a trailing separator, add a file name to the end, + # since there was a trailing separator, add a file name to the end, # then do the split, then replace it with ''. # my( @directories )= split( m|[\\/]|, "${directories}dummy" ) ; @@ -294,7 +295,7 @@ sub catpath { $volume .= $directory ; - # If the volume is not just A:, make sure the glue separator is + # If the volume is not just A:, make sure the glue separator is # there, reusing whatever separator is first in the $volume if possible. if ( $volume !~ m@^[a-zA-Z]:\Z(?!\n)@s && $volume =~ m@[^\\/]\Z(?!\n)@ && @@ -346,9 +347,9 @@ sub rel2abs { my ( $base_volume, $base_directories ) = $self->splitpath( $base, 1 ) ; - $path = $self->catpath( - $base_volume, - $self->catdir( $base_directories, $path_directories ), + $path = $self->catpath( + $base_volume, + $self->catdir( $base_directories, $path_directories ), $path_file ) ; diff --git a/inc/bundle/HTTP/Tiny.pm b/inc/bundle/HTTP/Tiny.pm index 01f4e92e..333aab56 100644 --- a/inc/bundle/HTTP/Tiny.pm +++ b/inc/bundle/HTTP/Tiny.pm @@ -3,7 +3,7 @@ package HTTP::Tiny; use strict; use warnings; # ABSTRACT: A small, simple, correct HTTP/1.1 client -our $VERSION = '0.022'; # VERSION +our $VERSION = '0.025'; # VERSION use Carp (); @@ -21,13 +21,20 @@ BEGIN { sub new { my($class, %args) = @_; - (my $agent = $class) =~ s{::}{-}g; + + (my $default_agent = $class) =~ s{::}{-}g; + $default_agent .= "/" . ($class->VERSION || 0); + my $self = { - agent => $agent . "/" . ($class->VERSION || 0), + agent => $default_agent, max_redirect => 5, timeout => 60, verify_SSL => $args{verify_SSL} || $args{verify_ssl} || 0, # no verification by default }; + + $args{agent} .= $default_agent + if defined $args{agent} && $args{agent} =~ / $/; + for my $key ( @attributes ) { $self->{$key} = $args{$key} if exists $args{$key} } @@ -423,6 +430,8 @@ sub connect { if ( $scheme eq 'https' ) { die(qq/IO::Socket::SSL 1.56 must be installed for https support\n/) unless eval {require IO::Socket::SSL; IO::Socket::SSL->VERSION(1.56)}; + die(qq/Net::SSLeay 1.49 must be installed for https support\n/) + unless eval {require Net::SSLeay; Net::SSLeay->VERSION(1.49)}; } elsif ( $scheme ne 'http' ) { die(qq/Unsupported URL scheme '$scheme'\n/); @@ -430,7 +439,7 @@ sub connect { $self->{fh} = 'IO::Socket::INET'->new( PeerHost => $host, PeerPort => $port, - $self->{local_address} ? + $self->{local_address} ? ( LocalAddr => $self->{local_address} ) : (), Proto => 'tcp', Type => SOCK_STREAM, @@ -442,7 +451,15 @@ sub connect { if ( $scheme eq 'https') { my $ssl_args = $self->_ssl_args($host); - IO::Socket::SSL->start_SSL($self->{fh}, %$ssl_args); + IO::Socket::SSL->start_SSL( + $self->{fh}, + %$ssl_args, + SSL_create_ctx_callback => sub { + my $ctx = shift; + Net::SSLeay::CTX_set_mode($ctx, Net::SSLeay::MODE_AUTO_RETRY()); + }, + ); + unless ( ref($self->{fh}) eq 'IO::Socket::SSL' ) { my $ssl_err = IO::Socket::SSL->errstr; die(qq/SSL connection failed for $host: $ssl_err\n/); @@ -489,7 +506,14 @@ sub write { die(qq/Socket closed by remote server: $!\n/); } elsif ($! != EINTR) { - die(qq/Could not write to socket: '$!'\n/); + if ($self->{fh}->can('errstr')){ + my $err = $self->{fh}->errstr(); + die (qq/Could not write to SSL socket: '$err'\n /); + } + else { + die(qq/Could not write to socket: '$!'\n/); + } + } } return $off; @@ -517,7 +541,13 @@ sub read { $len -= $r; } elsif ($! != EINTR) { - die(qq/Could not read from socket: '$!'\n/); + if ($self->{fh}->can('errstr')){ + my $err = $self->{fh}->errstr(); + die (qq/Could not read from SSL socket: '$err'\n /); + } + else { + die(qq/Could not read from socket: '$!'\n/); + } } } if ($len && !$allow_partial) { @@ -544,7 +574,13 @@ sub readline { last unless $r; } elsif ($! != EINTR) { - die(qq/Could not read from socket: '$!'\n/); + if ($self->{fh}->can('errstr')){ + my $err = $self->{fh}->errstr(); + die (qq/Could not read from SSL socket: '$err'\n /); + } + else { + die(qq/Could not read from socket: '$!'\n/); + } } } die(qq/Unexpected end of stream while looking for line\n/); @@ -834,6 +870,11 @@ sub can_write { # Try to find a CA bundle to validate the SSL cert, # prefer Mozilla::CA or fallback to a system file sub _find_CA_file { + my $self = shift(); + + return $self->{SSL_options}->{SSL_ca_file} + if $self->{SSL_options}->{SSL_ca_file} and -e $self->{SSL_options}->{SSL_ca_file}; + return Mozilla::CA::SSL_ca_file() if eval { require Mozilla::CA }; @@ -878,9 +919,8 @@ sub _ssl_args { 1; - - __END__ + =pod =head1 NAME @@ -889,7 +929,7 @@ HTTP::Tiny - A small, simple, correct HTTP/1.1 client =head1 VERSION -version 0.022 +version 0.025 =head1 SYNOPSIS @@ -932,7 +972,7 @@ This constructor returns a new HTTP::Tiny object. Valid attributes include: C -A user-agent string (defaults to 'HTTP::Tiny/$VERSION') +A user-agent string (defaults to 'HTTP-Tiny/$VERSION'). If C ends in a space character, the default user-agent string is appended. =item * @@ -1174,9 +1214,10 @@ SSL_options =head1 SSL SUPPORT Direct C connections are supported only if L 1.56 or -greater is installed. An exception will be thrown if a new enough -IO::Socket::SSL is not installed or if the SSL encryption fails. There is no -support for C connections via proxy (i.e. RFC 2817). +greater and L 1.49 or greater are installed. An exception will be +thrown if a new enough versions of these modules not installed or if the SSL +encryption fails. There is no support for C connections via proxy (i.e. +RFC 2817). SSL provides two distinct capabilities: @@ -1336,6 +1377,10 @@ L L +=item * + +L + =back =for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan @@ -1345,7 +1390,7 @@ L =head2 Bugs / Feature Requests Please report any bugs or feature requests through the issue tracker -at L. +at L. You will be notified automatically of any progress on your issue. =head2 Source Code @@ -1353,9 +1398,9 @@ You will be notified automatically of any progress on your issue. This is open source software. The code repository is available for public review and contribution under the terms of the license. -L +L - git clone https://github.com/dagolden/p5-http-tiny.git + git clone git://github.com/dagolden/http-tiny.git =head1 AUTHORS @@ -1383,4 +1428,3 @@ This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut - diff --git a/inc/bundle/Module/CoreList.pm b/inc/bundle/Module/CoreList.pm index f96e4c5b..9eb76a61 100644 --- a/inc/bundle/Module/CoreList.pm +++ b/inc/bundle/Module/CoreList.pm @@ -3,7 +3,7 @@ use strict; use vars qw/$VERSION %released %version %families %upstream %bug_tracker %deprecated/; use Module::CoreList::TieHashDelta; -$VERSION = '2.73'; +$VERSION = '2.80'; my $dumpinc = 0; sub import { @@ -78,6 +78,17 @@ sub is_deprecated { return $deprecated{$perl_version}{$module}; } +sub deprecated_in { + my $module = shift; + $module = shift if eval { $module->isa(__PACKAGE__) } + and scalar @_ and $_[0] =~ m#\A[a-zA-Z_][0-9a-zA-Z_]*(?:(::|')[0-9a-zA-Z_]+)*\z#; + return unless $module; + my @perls = grep { exists $deprecated{$_}{$module} } keys %deprecated; + return unless @perls; + require List::Util; + return List::Util::minstr(@perls); +} + sub removed_from { my @perls = &removed_raw; return shift @perls; @@ -188,6 +199,7 @@ sub changes_between { 5.013011 => '2011-03-20', 5.014000 => '2011-05-14', 5.012004 => '2011-06-20', + 5.012005 => '2012-11-10', 5.014001 => '2011-06-16', 5.015000 => '2011-06-20', 5.015001 => '2011-07-20', @@ -202,11 +214,17 @@ sub changes_between { 5.015009 => '2012-03-20', 5.016000 => '2012-05-20', 5.016001 => '2012-08-08', + 5.016002 => '2012-11-01', 5.017000 => '2012-05-26', 5.017001 => '2012-06-20', 5.017002 => '2012-07-20', 5.017003 => '2012-08-20', 5.017004 => '2012-09-20', + 5.014003 => '2012-10-12', + 5.017005 => '2012-10-20', + 5.017006 => '2012-11-20', + 5.017007 => '2012-12-18', + 5.017008 => '2013-01-20', ); for my $version ( sort { $a <=> $b } keys %released ) { @@ -539,6 +557,7 @@ my %delta = ( 'CPAN::FirstTime' => '1.29 ', 'DB_File' => '1.60', 'Data::Dumper' => '2.09', + 'Errno' => '1.09', 'ExtUtils::Installed' => '0.02', 'ExtUtils::MM_Unix' => '1.12601 ', 'ExtUtils::MakeMaker' => '5.4301', @@ -587,6 +606,7 @@ my %delta = ( 'DB_File' => '1.65', 'Data::Dumper' => '2.101', 'Dumpvalue' => undef, + 'Errno' => '1.111', 'ExtUtils::Install' => '1.28', 'ExtUtils::Liblist' => '1.25', 'ExtUtils::MM_Unix' => '1.12602', @@ -612,7 +632,6 @@ my %delta = ( changed => { 'CPAN::FirstTime' => '1.36 ', 'DB_File' => '1.807', - 'Errno' => '1.111', 'ExtUtils::Install' => '1.28 ', 'ExtUtils::Liblist' => '1.25 ', 'ExtUtils::MM_Unix' => '1.12602 ', @@ -1158,7 +1177,6 @@ my %delta = ( 'warnings::register' => '1.00', }, removed => { - 'Errno' => 1, } }, 5.008 => { @@ -4342,6 +4360,19 @@ my %delta = ( removed => { } }, + 5.012005 => { + delta_from => 5.012004, + changed => { + 'B::Concise' => '0.78_01', + 'Encode' => '2.39_01', + 'File::Glob' => '1.07_01', + 'Module::CoreList' => '2.50_02', + 'Unicode::UCD' => '0.29', + 'charnames' => '1.07_01', + }, + removed => { + } + }, 5.013 => { delta_from => 5.012, changed => { @@ -5565,6 +5596,16 @@ my %delta = ( removed => { } }, + 5.014003 => { + delta_from => 5.014002, + changed => { + 'Digest' => '1.16_01', + 'IPC::Open3' => '1.09_01', + 'Module::CoreList' => '2.49_04', + }, + removed => { + } + }, 5.015 => { delta_from => 5.014001, changed => { @@ -6711,6 +6752,13 @@ my %delta = ( removed => { } }, + 5.016002 => { + delta_from => 5.016001, + changed => { + }, + removed => { + } + }, 5.017 => { delta_from => 5.016, changed => { @@ -7225,6 +7273,343 @@ my %delta = ( removed => { } }, + 5.017005 => { + delta_from => 5.017004, + changed => { + 'AutoLoader' => '5.73', + 'B' => '1.39', + 'B::Deparse' => '1.18', + 'CPANPLUS' => '0.9133', + 'CPANPLUS::Internals' => '0.9133', + 'CPANPLUS::Shell::Default'=> '0.9133', + 'Carp' => '1.27', + 'Carp::Heavy' => '1.27', + 'Data::Dumper' => '2.136', + 'Digest::SHA' => '5.72', + 'ExtUtils::CBuilder' => '0.280209', + 'ExtUtils::CBuilder::Base'=> '0.280209', + 'ExtUtils::CBuilder::Platform::Unix'=> '0.280209', + 'ExtUtils::CBuilder::Platform::VMS'=> '0.280209', + 'ExtUtils::CBuilder::Platform::Windows'=> '0.280209', + 'ExtUtils::CBuilder::Platform::Windows::BCC'=> '0.280209', + 'ExtUtils::CBuilder::Platform::Windows::GCC'=> '0.280209', + 'ExtUtils::CBuilder::Platform::Windows::MSVC'=> '0.280209', + 'ExtUtils::CBuilder::Platform::aix'=> '0.280209', + 'ExtUtils::CBuilder::Platform::cygwin'=> '0.280209', + 'ExtUtils::CBuilder::Platform::darwin'=> '0.280209', + 'ExtUtils::CBuilder::Platform::dec_osf'=> '0.280209', + 'ExtUtils::CBuilder::Platform::os2'=> '0.280209', + 'File::Copy' => '2.25', + 'File::Glob' => '1.18', + 'HTTP::Tiny' => '0.024', + 'Module::CoreList' => '2.75', + 'Module::CoreList::TieHashDelta'=> '2.75', + 'PerlIO::encoding' => '0.16', + 'Unicode::Collate' => '0.90', + 'Unicode::Collate::Locale'=> '0.90', + 'Unicode::Normalize' => '1.15', + 'Win32CORE' => '0.04', + 'XS::APItest' => '0.44', + 'attributes' => '0.21', + 'bigint' => '0.31', + 'bignum' => '0.31', + 'bigrat' => '0.31', + 'feature' => '1.31', + 'threads::shared' => '1.42', + 'warnings' => '1.15', + }, + removed => { + } + }, + 5.017006 => { + delta_from => 5.017005, + changed => { + 'B' => '1.40', + 'B::Concise' => '0.94', + 'B::Deparse' => '1.19', + 'B::Xref' => '1.05', + 'CGI' => '3.63', + 'CGI::Util' => '3.62', + 'CPAN' => '1.99_51', + 'CPANPLUS::Dist::Build' => '0.64', + 'CPANPLUS::Dist::Build::Constants'=> '0.64', + 'Carp' => '1.28', + 'Carp::Heavy' => '1.28', + 'Compress::Raw::Bzip2' => '2.058', + 'Compress::Raw::Zlib' => '2.058', + 'Compress::Zlib' => '2.058', + 'Data::Dumper' => '2.137', + 'Digest::SHA' => '5.73', + 'DynaLoader' => '1.17', + 'Env' => '1.04', + 'Errno' => '1.17', + 'ExtUtils::Manifest' => '1.62', + 'ExtUtils::Typemaps' => '3.18', + 'ExtUtils::Typemaps::Cmd'=> '3.18', + 'ExtUtils::Typemaps::InputMap'=> '3.18', + 'ExtUtils::Typemaps::OutputMap'=> '3.18', + 'ExtUtils::Typemaps::Type'=> '3.18', + 'Fatal' => '2.13', + 'File::Find' => '1.23', + 'Hash::Util' => '0.13', + 'IO::Compress::Adapter::Bzip2'=> '2.058', + 'IO::Compress::Adapter::Deflate'=> '2.058', + 'IO::Compress::Adapter::Identity'=> '2.058', + 'IO::Compress::Base' => '2.058', + 'IO::Compress::Base::Common'=> '2.058', + 'IO::Compress::Bzip2' => '2.058', + 'IO::Compress::Deflate' => '2.058', + 'IO::Compress::Gzip' => '2.058', + 'IO::Compress::Gzip::Constants'=> '2.058', + 'IO::Compress::RawDeflate'=> '2.058', + 'IO::Compress::Zip' => '2.058', + 'IO::Compress::Zip::Constants'=> '2.058', + 'IO::Compress::Zlib::Constants'=> '2.058', + 'IO::Compress::Zlib::Extra'=> '2.058', + 'IO::Uncompress::Adapter::Bunzip2'=> '2.058', + 'IO::Uncompress::Adapter::Identity'=> '2.058', + 'IO::Uncompress::Adapter::Inflate'=> '2.058', + 'IO::Uncompress::AnyInflate'=> '2.058', + 'IO::Uncompress::AnyUncompress'=> '2.058', + 'IO::Uncompress::Base' => '2.058', + 'IO::Uncompress::Bunzip2'=> '2.058', + 'IO::Uncompress::Gunzip'=> '2.058', + 'IO::Uncompress::Inflate'=> '2.058', + 'IO::Uncompress::RawInflate'=> '2.058', + 'IO::Uncompress::Unzip' => '2.058', + 'Module::CoreList' => '2.78', + 'Module::CoreList::TieHashDelta'=> '2.77', + 'Module::Pluggable' => '4.5', + 'Module::Pluggable::Object'=> '4.5', + 'Opcode' => '1.25', + 'Sys::Hostname' => '1.17', + 'Term::UI' => '0.32', + 'Thread::Queue' => '3.01', + 'Tie::Hash::NamedCapture'=> '0.09', + 'Unicode::Collate' => '0.93', + 'Unicode::Collate::CJK::Korean'=> '0.93', + 'Unicode::Collate::Locale'=> '0.93', + 'Unicode::Normalize' => '1.16', + 'Unicode::UCD' => '0.47', + 'XS::APItest' => '0.46', + '_charnames' => '1.33', + 'autodie' => '2.13', + 'autodie::exception' => '2.13', + 'autodie::exception::system'=> '2.13', + 'autodie::hints' => '2.13', + 'charnames' => '1.33', + 're' => '0.23', + }, + removed => { + } + }, + 5.017007 => { + delta_from => 5.017006, + changed => { + 'B' => '1.41', + 'CPANPLUS::Dist::Build' => '0.68', + 'CPANPLUS::Dist::Build::Constants'=> '0.68', + 'Compress::Raw::Bzip2' => '2.059', + 'Compress::Raw::Zlib' => '2.059', + 'Compress::Zlib' => '2.059', + 'Cwd' => '3.39_03', + 'Data::Dumper' => '2.139', + 'Devel::Peek' => '1.11', + 'Digest::SHA' => '5.80', + 'DynaLoader' => '1.18', + 'English' => '1.06', + 'Errno' => '1.18', + 'ExtUtils::Command::MM' => '6.64', + 'ExtUtils::Liblist' => '6.64', + 'ExtUtils::Liblist::Kid'=> '6.64', + 'ExtUtils::MM' => '6.64', + 'ExtUtils::MM_AIX' => '6.64', + 'ExtUtils::MM_Any' => '6.64', + 'ExtUtils::MM_BeOS' => '6.64', + 'ExtUtils::MM_Cygwin' => '6.64', + 'ExtUtils::MM_DOS' => '6.64', + 'ExtUtils::MM_Darwin' => '6.64', + 'ExtUtils::MM_MacOS' => '6.64', + 'ExtUtils::MM_NW5' => '6.64', + 'ExtUtils::MM_OS2' => '6.64', + 'ExtUtils::MM_QNX' => '6.64', + 'ExtUtils::MM_UWIN' => '6.64', + 'ExtUtils::MM_Unix' => '6.64', + 'ExtUtils::MM_VMS' => '6.64', + 'ExtUtils::MM_VOS' => '6.64', + 'ExtUtils::MM_Win32' => '6.64', + 'ExtUtils::MM_Win95' => '6.64', + 'ExtUtils::MY' => '6.64', + 'ExtUtils::MakeMaker' => '6.64', + 'ExtUtils::MakeMaker::Config'=> '6.64', + 'ExtUtils::Mkbootstrap' => '6.64', + 'ExtUtils::Mksymlists' => '6.64', + 'ExtUtils::testlib' => '6.64', + 'File::DosGlob' => '1.09', + 'File::Glob' => '1.19', + 'GDBM_File' => '1.15', + 'IO::Compress::Adapter::Bzip2'=> '2.059', + 'IO::Compress::Adapter::Deflate'=> '2.059', + 'IO::Compress::Adapter::Identity'=> '2.059', + 'IO::Compress::Base' => '2.059', + 'IO::Compress::Base::Common'=> '2.059', + 'IO::Compress::Bzip2' => '2.059', + 'IO::Compress::Deflate' => '2.059', + 'IO::Compress::Gzip' => '2.059', + 'IO::Compress::Gzip::Constants'=> '2.059', + 'IO::Compress::RawDeflate'=> '2.059', + 'IO::Compress::Zip' => '2.059', + 'IO::Compress::Zip::Constants'=> '2.059', + 'IO::Compress::Zlib::Constants'=> '2.059', + 'IO::Compress::Zlib::Extra'=> '2.059', + 'IO::Uncompress::Adapter::Bunzip2'=> '2.059', + 'IO::Uncompress::Adapter::Identity'=> '2.059', + 'IO::Uncompress::Adapter::Inflate'=> '2.059', + 'IO::Uncompress::AnyInflate'=> '2.059', + 'IO::Uncompress::AnyUncompress'=> '2.059', + 'IO::Uncompress::Base' => '2.059', + 'IO::Uncompress::Bunzip2'=> '2.059', + 'IO::Uncompress::Gunzip'=> '2.059', + 'IO::Uncompress::Inflate'=> '2.059', + 'IO::Uncompress::RawInflate'=> '2.059', + 'IO::Uncompress::Unzip' => '2.059', + 'List::Util' => '1.26', + 'List::Util::XS' => '1.26', + 'Locale::Codes' => '3.24', + 'Locale::Codes::Constants'=> '3.24', + 'Locale::Codes::Country'=> '3.24', + 'Locale::Codes::Country_Codes'=> '3.24', + 'Locale::Codes::Country_Retired'=> '3.24', + 'Locale::Codes::Currency'=> '3.24', + 'Locale::Codes::Currency_Codes'=> '3.24', + 'Locale::Codes::Currency_Retired'=> '3.24', + 'Locale::Codes::LangExt'=> '3.24', + 'Locale::Codes::LangExt_Codes'=> '3.24', + 'Locale::Codes::LangExt_Retired'=> '3.24', + 'Locale::Codes::LangFam'=> '3.24', + 'Locale::Codes::LangFam_Codes'=> '3.24', + 'Locale::Codes::LangFam_Retired'=> '3.24', + 'Locale::Codes::LangVar'=> '3.24', + 'Locale::Codes::LangVar_Codes'=> '3.24', + 'Locale::Codes::LangVar_Retired'=> '3.24', + 'Locale::Codes::Language'=> '3.24', + 'Locale::Codes::Language_Codes'=> '3.24', + 'Locale::Codes::Language_Retired'=> '3.24', + 'Locale::Codes::Script' => '3.24', + 'Locale::Codes::Script_Codes'=> '3.24', + 'Locale::Codes::Script_Retired'=> '3.24', + 'Locale::Country' => '3.24', + 'Locale::Currency' => '3.24', + 'Locale::Language' => '3.24', + 'Locale::Maketext' => '1.23', + 'Locale::Script' => '3.24', + 'Module::CoreList' => '2.79', + 'Module::CoreList::TieHashDelta'=> '2.79', + 'POSIX' => '1.32', + 'Scalar::Util' => '1.26', + 'Socket' => '2.006_001', + 'Storable' => '2.40', + 'Term::ReadLine' => '1.11', + 'Unicode::Collate' => '0.96', + 'Unicode::Collate::CJK::Stroke'=> '0.94', + 'Unicode::Collate::CJK::Zhuyin'=> '0.94', + 'Unicode::Collate::Locale'=> '0.96', + 'XS::APItest' => '0.48', + 'XS::Typemap' => '0.09', + '_charnames' => '1.34', + 'charnames' => '1.34', + 'feature' => '1.32', + 'mro' => '1.10', + 'sigtrap' => '1.07', + 'sort' => '2.02', + }, + removed => { + } + }, + 5.017008 => { + delta_from => 5.017007, + changed => { + 'Archive::Extract' => '0.62', + 'B' => '1.42', + 'B::Concise' => '0.95', + 'Compress::Raw::Bzip2' => '2.060', + 'Compress::Raw::Zlib' => '2.060', + 'Compress::Zlib' => '2.060', + 'Cwd' => '3.40', + 'Data::Dumper' => '2.141', + 'Digest::SHA' => '5.81', + 'ExtUtils::Install' => '1.59', + 'File::Fetch' => '0.38', + 'File::Path' => '2.09', + 'File::Spec' => '3.40', + 'File::Spec::Cygwin' => '3.40', + 'File::Spec::Epoc' => '3.40', + 'File::Spec::Functions' => '3.40', + 'File::Spec::Mac' => '3.40', + 'File::Spec::OS2' => '3.40', + 'File::Spec::Unix' => '3.40', + 'File::Spec::VMS' => '3.40', + 'File::Spec::Win32' => '3.40', + 'HTTP::Tiny' => '0.025', + 'Hash::Util' => '0.14', + 'I18N::LangTags' => '0.39', + 'I18N::LangTags::List' => '0.39', + 'I18N::Langinfo' => '0.09', + 'IO' => '1.26', + 'IO::Compress::Adapter::Bzip2'=> '2.060', + 'IO::Compress::Adapter::Deflate'=> '2.060', + 'IO::Compress::Adapter::Identity'=> '2.060', + 'IO::Compress::Base' => '2.060', + 'IO::Compress::Base::Common'=> '2.060', + 'IO::Compress::Bzip2' => '2.060', + 'IO::Compress::Deflate' => '2.060', + 'IO::Compress::Gzip' => '2.060', + 'IO::Compress::Gzip::Constants'=> '2.060', + 'IO::Compress::RawDeflate'=> '2.060', + 'IO::Compress::Zip' => '2.060', + 'IO::Compress::Zip::Constants'=> '2.060', + 'IO::Compress::Zlib::Constants'=> '2.060', + 'IO::Compress::Zlib::Extra'=> '2.060', + 'IO::Uncompress::Adapter::Bunzip2'=> '2.060', + 'IO::Uncompress::Adapter::Identity'=> '2.060', + 'IO::Uncompress::Adapter::Inflate'=> '2.060', + 'IO::Uncompress::AnyInflate'=> '2.060', + 'IO::Uncompress::AnyUncompress'=> '2.060', + 'IO::Uncompress::Base' => '2.060', + 'IO::Uncompress::Bunzip2'=> '2.060', + 'IO::Uncompress::Gunzip'=> '2.060', + 'IO::Uncompress::Inflate'=> '2.060', + 'IO::Uncompress::RawInflate'=> '2.060', + 'IO::Uncompress::Unzip' => '2.060', + 'List::Util' => '1.27', + 'List::Util::XS' => '1.27', + 'Module::CoreList' => '2.80', + 'Module::CoreList::TieHashDelta'=> '2.80', + 'Pod::Html' => '1.17', + 'Pod::LaTeX' => '0.61', + 'Pod::Man' => '2.27', + 'Pod::Text' => '3.17', + 'Pod::Text::Color' => '2.07', + 'Pod::Text::Overstrike' => '2.05', + 'Pod::Text::Termcap' => '2.07', + 'Safe' => '2.34', + 'Scalar::Util' => '1.27', + 'Socket' => '2.009', + 'Term::ANSIColor' => '4.02', + 'Test' => '1.26', + 'Unicode::Collate' => '0.97', + 'XS::APItest' => '0.51', + 'XS::Typemap' => '0.10', + '_charnames' => '1.35', + 'charnames' => '1.35', + 'constant' => '1.25', + 'diagnostics' => '1.31', + 'threads::shared' => '1.43', + 'warnings' => '1.16', + }, + removed => { + } + }, ); for my $version (sort { $a <=> $b } keys %delta) { @@ -7344,6 +7729,12 @@ for my $version (sort { $a <=> $b } keys %delta) { 'Shell' => '1', 'Switch' => '1', }, + 5.012005 => { + 'Class::ISA' => '1', + 'Pod::Plainer' => '1', + 'Shell' => '1', + 'Switch' => '1', + }, 5.014001 => { 'Shell' => '1', }, @@ -7377,6 +7768,8 @@ for my $version (sort { $a <=> $b } keys %delta) { }, 5.016001 => { }, + 5.016002 => { + }, 5.017000 => { }, 5.017001 => { @@ -7387,6 +7780,18 @@ for my $version (sort { $a <=> $b } keys %delta) { }, 5.017004 => { }, + 5.014003 => { + 'Shell' => '1', + }, + 5.017005 => { + }, + 5.017006 => { + }, + 5.017007 => { + }, + 5.017008 => { + 'Pod::LaTeX' => '1', + }, ); %upstream = ( @@ -7900,6 +8305,7 @@ for my $version (sort { $a <=> $b } keys %delta) { 'Unicode::Collate::CJK::Korean'=> 'first-come', 'Unicode::Collate::CJK::Pinyin'=> 'first-come', 'Unicode::Collate::CJK::Stroke'=> 'first-come', + 'Unicode::Collate::CJK::Zhuyin'=> 'first-come', 'Unicode::Collate::Locale'=> 'first-come', 'Unicode::Normalize' => 'first-come', 'Unicode::UCD' => 'blead', @@ -8156,7 +8562,7 @@ for my $version (sort { $a <=> $b } keys %delta) { 'Filter::Simple' => undef, 'Filter::Util::Call' => undef, 'Getopt::Long' => undef, - 'HTTP::Tiny' => 'http://rt.cpan.org/Public/Dist/Display.html?Name=HTTP-Tiny', + 'HTTP::Tiny' => 'https://rt.cpan.org/Public/Dist/Display.html?Name=HTTP-Tiny', 'IO::Compress::Adapter::Bzip2'=> undef, 'IO::Compress::Adapter::Deflate'=> undef, 'IO::Compress::Adapter::Identity'=> undef, @@ -8443,12 +8849,17 @@ for my $version (sort { $a <=> $b } keys %delta) { 'Unicode::Collate::CJK::Korean'=> undef, 'Unicode::Collate::CJK::Pinyin'=> undef, 'Unicode::Collate::CJK::Stroke'=> undef, + 'Unicode::Collate::CJK::Zhuyin'=> undef, 'Unicode::Collate::Locale'=> undef, 'Unicode::Normalize' => undef, 'Unicode::UCD' => undef, + 'VMS::DCLsym' => undef, + 'VMS::Filespec' => undef, + 'VMS::Stdio' => undef, 'Win32' => undef, 'Win32API::File' => undef, 'Win32API::File::ExtUtils::Myconst2perl'=> undef, + 'Win32CORE' => undef, 'XSLoader' => 'https://rt.perl.org/rt3/Search/Results.html?Query=Queue=\'perl5\' AND Content LIKE \'module=XSLoader\' AND (Status=\'open\' OR Status=\'new\' OR Status=\'stalled\')', 'autodie' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=autodie', 'autodie::exception' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=autodie', diff --git a/inc/bundle/Module/CoreList/TieHashDelta.pm b/inc/bundle/Module/CoreList/TieHashDelta.pm index b4bee90f..16ce95d2 100644 --- a/inc/bundle/Module/CoreList/TieHashDelta.pm +++ b/inc/bundle/Module/CoreList/TieHashDelta.pm @@ -3,7 +3,7 @@ package Module::CoreList::TieHashDelta; use strict; use vars qw($VERSION); -$VERSION = "2.73"; +$VERSION = "2.80"; sub TIEHASH { my ($class, $changed, $removed, $parent) = @_; diff --git a/inc/bundle/Module/Pluggable.pm b/inc/bundle/Module/Pluggable.pm index 5ce4ca99..9217af69 100644 --- a/inc/bundle/Module/Pluggable.pm +++ b/inc/bundle/Module/Pluggable.pm @@ -9,7 +9,7 @@ use Module::Pluggable::Object; # Peter Gibbons: I wouldn't say I've been missing it, Bob! -$VERSION = '4.3'; +$VERSION = '4.5'; # core release only! $FORCE_SEARCH_ALL_PATHS = 0; sub import { diff --git a/inc/bundle/Module/Pluggable/Object.pm b/inc/bundle/Module/Pluggable/Object.pm index d5ab8a8e..8e740085 100644 --- a/inc/bundle/Module/Pluggable/Object.pm +++ b/inc/bundle/Module/Pluggable/Object.pm @@ -8,7 +8,7 @@ use Carp qw(croak carp confess); use Devel::InnerPackage; use vars qw($VERSION); -$VERSION = '4.3'; +$VERSION = '4.5'; sub new { diff --git a/inc/bundle/Term/UI.pm b/inc/bundle/Term/UI.pm index 34f13f8d..eb7ec7ea 100644 --- a/inc/bundle/Term/UI.pm +++ b/inc/bundle/Term/UI.pm @@ -11,7 +11,7 @@ use strict; BEGIN { use vars qw[$VERSION $AUTOREPLY $VERBOSE $INVALID]; $VERBOSE = 1; - $VERSION = '0.30'; + $VERSION = '0.32'; $INVALID = loc('Invalid selection, please try again: '); } @@ -266,9 +266,14 @@ sub _tt_readline { history( $print_me ) if $print_me; - ### we might have to add a default value to the prompt, to - ### show the user what will be picked by default: - $prompt .= " [$prompt_add]: " if $prompt_add; + if ($prompt_add) { + ### we might have to add a default value to the prompt, to + ### show the user what will be picked by default: + $prompt .= " [$prompt_add]: " ; + } + else { + $prompt .= " : "; + } ### are we in autoreply mode? diff --git a/lib/CPANPLUS.pm b/lib/CPANPLUS.pm index aa7760d5..f8b3f6e5 100644 --- a/lib/CPANPLUS.pm +++ b/lib/CPANPLUS.pm @@ -13,7 +13,7 @@ BEGIN { use vars qw( @EXPORT @ISA $VERSION ); @EXPORT = qw( shell fetch get install ); @ISA = qw( Exporter ); - $VERSION = "0.9133"; #have to hardcode or cpan.org gets unhappy + $VERSION = "0.9134"; #have to hardcode or cpan.org gets unhappy } ### purely for backward compatibility, so we can call it from the commandline: diff --git a/lib/CPANPLUS/Backend.pm b/lib/CPANPLUS/Backend.pm index 41df24c0..5eece4d8 100644 --- a/lib/CPANPLUS/Backend.pm +++ b/lib/CPANPLUS/Backend.pm @@ -23,7 +23,7 @@ $Params::Check::VERBOSE = 1; use vars qw[@ISA $VERSION]; @ISA = qw[CPANPLUS::Internals]; -$VERSION = '0.9133'; +$VERSION = "0.9134"; ### mark that we're running under CPANPLUS to spawned processes $ENV{'PERL5_CPANPLUS_IS_RUNNING'} = $$; diff --git a/lib/CPANPLUS/Backend/RV.pm b/lib/CPANPLUS/Backend/RV.pm index b8ae9b85..2e577c66 100644 --- a/lib/CPANPLUS/Backend/RV.pm +++ b/lib/CPANPLUS/Backend/RV.pm @@ -2,7 +2,7 @@ package CPANPLUS::Backend::RV; use strict; use vars qw[$STRUCT $VERSION]; -$VERSION = '0.9133'; +$VERSION = "0.9134"; use CPANPLUS::Error; use CPANPLUS::Internals::Constants; diff --git a/lib/CPANPLUS/Config.pm b/lib/CPANPLUS/Config.pm index f70e8f68..5abe765c 100644 --- a/lib/CPANPLUS/Config.pm +++ b/lib/CPANPLUS/Config.pm @@ -20,7 +20,7 @@ use Module::Load::Conditional qw[check_install]; use version; use vars qw[$VERSION]; -$VERSION = '0.9133'; +$VERSION = "0.9134"; =pod diff --git a/lib/CPANPLUS/Config/HomeEnv.pm b/lib/CPANPLUS/Config/HomeEnv.pm index d23130a4..dd166440 100644 --- a/lib/CPANPLUS/Config/HomeEnv.pm +++ b/lib/CPANPLUS/Config/HomeEnv.pm @@ -4,7 +4,7 @@ use strict; use File::Spec; use vars qw($VERSION); -$VERSION = '0.9133'; +$VERSION = "0.9134"; sub setup { my $conf = shift; diff --git a/lib/CPANPLUS/Configure.pm b/lib/CPANPLUS/Configure.pm index 3e9f968d..1d9cc926 100644 --- a/lib/CPANPLUS/Configure.pm +++ b/lib/CPANPLUS/Configure.pm @@ -20,7 +20,7 @@ local $Params::Check::VERBOSE = 1; ### require, avoid circular use ### require CPANPLUS::Internals; -$VERSION = '0.9133'; +$VERSION = "0.9134"; ### can't use O::A as we're using our own AUTOLOAD to get to ### the config options. diff --git a/lib/CPANPLUS/Configure/Setup.pm b/lib/CPANPLUS/Configure/Setup.pm index de2dc722..adebbe2a 100644 --- a/lib/CPANPLUS/Configure/Setup.pm +++ b/lib/CPANPLUS/Configure/Setup.pm @@ -2,7 +2,7 @@ package CPANPLUS::Configure::Setup; use strict; use vars qw[@ISA $VERSION]; -$VERSION = '0.9133'; +$VERSION = "0.9134"; use base qw[CPANPLUS::Internals::Utils]; use base qw[Object::Accessor]; diff --git a/lib/CPANPLUS/Dist.pm b/lib/CPANPLUS/Dist.pm index 102f0f88..48d0baaa 100644 --- a/lib/CPANPLUS/Dist.pm +++ b/lib/CPANPLUS/Dist.pm @@ -15,7 +15,7 @@ use Module::Load::Conditional qw[can_load check_install]; use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; use vars qw[$VERSION]; -$VERSION = '0.9133'; +$VERSION = "0.9134"; use base 'Object::Accessor'; diff --git a/lib/CPANPLUS/Dist/Autobundle.pm b/lib/CPANPLUS/Dist/Autobundle.pm index 292a3593..ca33f24f 100644 --- a/lib/CPANPLUS/Dist/Autobundle.pm +++ b/lib/CPANPLUS/Dist/Autobundle.pm @@ -6,7 +6,7 @@ use CPANPLUS::Error qw[error msg]; use Params::Check qw[check]; use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; use vars qw[$VERSION]; -$VERSION = '0.9133'; +$VERSION = "0.9134"; use base qw[CPANPLUS::Dist::Base]; diff --git a/lib/CPANPLUS/Dist/Base.pm b/lib/CPANPLUS/Dist/Base.pm index 6079fddf..996f213f 100644 --- a/lib/CPANPLUS/Dist/Base.pm +++ b/lib/CPANPLUS/Dist/Base.pm @@ -4,7 +4,7 @@ use strict; use base qw[CPANPLUS::Dist]; use vars qw[$VERSION]; -$VERSION = '0.9133'; +$VERSION = "0.9134"; =head1 NAME diff --git a/lib/CPANPLUS/Dist/MM.pm b/lib/CPANPLUS/Dist/MM.pm index 8c451d64..3380d6a0 100644 --- a/lib/CPANPLUS/Dist/MM.pm +++ b/lib/CPANPLUS/Dist/MM.pm @@ -4,7 +4,7 @@ use strict; use warnings; use vars qw[@ISA $STATUS $VERSION]; use base 'CPANPLUS::Dist::Base'; -$VERSION = '0.9133'; +$VERSION = "0.9134"; use CPANPLUS::Internals::Constants; use CPANPLUS::Internals::Constants::Report; diff --git a/lib/CPANPLUS/Dist/Sample.pm b/lib/CPANPLUS/Dist/Sample.pm index ba4361f5..e298422e 100644 --- a/lib/CPANPLUS/Dist/Sample.pm +++ b/lib/CPANPLUS/Dist/Sample.pm @@ -1,7 +1,7 @@ package CPANPLUS::Dist::Sample; use vars qw[$VERSION]; -$VERSION = '0.9133'; +$VERSION = "0.9134"; =pod diff --git a/lib/CPANPLUS/Error.pm b/lib/CPANPLUS/Error.pm index 54f732f0..96972106 100644 --- a/lib/CPANPLUS/Error.pm +++ b/lib/CPANPLUS/Error.pm @@ -2,7 +2,7 @@ package CPANPLUS::Error; use strict; use vars qw[$VERSION]; -$VERSION = '0.9133'; +$VERSION = "0.9134"; use Log::Message private => 0;; diff --git a/lib/CPANPLUS/Internals.pm b/lib/CPANPLUS/Internals.pm index 32b22c1b..ab175848 100644 --- a/lib/CPANPLUS/Internals.pm +++ b/lib/CPANPLUS/Internals.pm @@ -39,7 +39,7 @@ use vars qw[@ISA $VERSION]; CPANPLUS::Internals::Report ]; -$VERSION = "0.9133"; +$VERSION = "0.9134"; =pod diff --git a/lib/CPANPLUS/Internals/Constants.pm b/lib/CPANPLUS/Internals/Constants.pm index 8b306ae7..a2ec10bf 100644 --- a/lib/CPANPLUS/Internals/Constants.pm +++ b/lib/CPANPLUS/Internals/Constants.pm @@ -13,7 +13,7 @@ use vars qw[$VERSION @ISA @EXPORT]; use Package::Constants; -$VERSION = '0.9133'; +$VERSION = "0.9134"; @ISA = qw[Exporter]; @EXPORT = Package::Constants->list( __PACKAGE__ ); diff --git a/lib/CPANPLUS/Internals/Constants/Report.pm b/lib/CPANPLUS/Internals/Constants/Report.pm index c13ee0ea..82a14f0d 100644 --- a/lib/CPANPLUS/Internals/Constants/Report.pm +++ b/lib/CPANPLUS/Internals/Constants/Report.pm @@ -14,7 +14,7 @@ use Package::Constants; ### for the version require CPANPLUS::Internals; -$VERSION = '0.9133'; +$VERSION = "0.9134"; @ISA = qw[Exporter]; @EXPORT = Package::Constants->list( __PACKAGE__ ); diff --git a/lib/CPANPLUS/Internals/Extract.pm b/lib/CPANPLUS/Internals/Extract.pm index 3c3e4d3d..4b72f724 100644 --- a/lib/CPANPLUS/Internals/Extract.pm +++ b/lib/CPANPLUS/Internals/Extract.pm @@ -14,7 +14,7 @@ use Module::Load::Conditional qw[can_load check_install]; use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; use vars qw[$VERSION]; -$VERSION = '0.9133'; +$VERSION = "0.9134"; local $Params::Check::VERBOSE = 1; diff --git a/lib/CPANPLUS/Internals/Fetch.pm b/lib/CPANPLUS/Internals/Fetch.pm index 5634e36f..039da6ad 100644 --- a/lib/CPANPLUS/Internals/Fetch.pm +++ b/lib/CPANPLUS/Internals/Fetch.pm @@ -13,7 +13,7 @@ use Params::Check qw[check]; use Module::Load::Conditional qw[can_load]; use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; use vars qw[$VERSION]; -$VERSION = '0.9133'; +$VERSION = "0.9134"; $Params::Check::VERBOSE = 1; diff --git a/lib/CPANPLUS/Internals/Report.pm b/lib/CPANPLUS/Internals/Report.pm index a0347a9d..291f2c92 100644 --- a/lib/CPANPLUS/Internals/Report.pm +++ b/lib/CPANPLUS/Internals/Report.pm @@ -14,7 +14,7 @@ use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; use version; use vars qw[$VERSION]; -$VERSION = '0.9133'; +$VERSION = "0.9134"; $Params::Check::VERBOSE = 1; diff --git a/lib/CPANPLUS/Internals/Search.pm b/lib/CPANPLUS/Internals/Search.pm index 6d49dcbd..21d8fe41 100644 --- a/lib/CPANPLUS/Internals/Search.pm +++ b/lib/CPANPLUS/Internals/Search.pm @@ -14,7 +14,7 @@ use Params::Check qw[check allow]; use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; use vars qw[$VERSION]; -$VERSION = '0.9133'; +$VERSION = "0.9134"; $Params::Check::VERBOSE = 1; diff --git a/lib/CPANPLUS/Internals/Source.pm b/lib/CPANPLUS/Internals/Source.pm index 3545f8c2..94752ebf 100644 --- a/lib/CPANPLUS/Internals/Source.pm +++ b/lib/CPANPLUS/Internals/Source.pm @@ -19,7 +19,7 @@ use Module::Load::Conditional qw[can_load]; use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; use vars qw[$VERSION]; -$VERSION = '0.9133'; +$VERSION = "0.9134"; $Params::Check::VERBOSE = 1; diff --git a/lib/CPANPLUS/Internals/Source/Memory.pm b/lib/CPANPLUS/Internals/Source/Memory.pm index c645a305..2d72aee4 100644 --- a/lib/CPANPLUS/Internals/Source/Memory.pm +++ b/lib/CPANPLUS/Internals/Source/Memory.pm @@ -21,7 +21,7 @@ use Module::Load::Conditional qw[can_load]; use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; use vars qw[$VERSION]; -$VERSION = '0.9133'; +$VERSION = "0.9134"; $Params::Check::VERBOSE = 1; diff --git a/lib/CPANPLUS/Internals/Source/SQLite.pm b/lib/CPANPLUS/Internals/Source/SQLite.pm index 512788dc..f6b76d04 100644 --- a/lib/CPANPLUS/Internals/Source/SQLite.pm +++ b/lib/CPANPLUS/Internals/Source/SQLite.pm @@ -17,7 +17,7 @@ use Params::Check qw[allow check]; use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; use vars qw[$VERSION]; -$VERSION = '0.9133'; +$VERSION = "0.9134"; use constant TXN_COMMIT => 1000; diff --git a/lib/CPANPLUS/Internals/Source/SQLite/Tie.pm b/lib/CPANPLUS/Internals/Source/SQLite/Tie.pm index 7c5172ae..461524eb 100644 --- a/lib/CPANPLUS/Internals/Source/SQLite/Tie.pm +++ b/lib/CPANPLUS/Internals/Source/SQLite/Tie.pm @@ -14,7 +14,7 @@ use Module::Load::Conditional qw[can_load]; use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; use vars qw[@ISA $VERSION]; -$VERSION = '0.9133'; +$VERSION = "0.9134"; require Tie::Hash; push @ISA, 'Tie::StdHash'; diff --git a/lib/CPANPLUS/Internals/Utils.pm b/lib/CPANPLUS/Internals/Utils.pm index 794dbb0b..5715a32b 100644 --- a/lib/CPANPLUS/Internals/Utils.pm +++ b/lib/CPANPLUS/Internals/Utils.pm @@ -13,7 +13,7 @@ use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; use version; use vars qw[$VERSION]; -$VERSION = '0.9133'; +$VERSION = "0.9134"; local $Params::Check::VERBOSE = 1; diff --git a/lib/CPANPLUS/Internals/Utils/Autoflush.pm b/lib/CPANPLUS/Internals/Utils/Autoflush.pm index 08877384..a0ed1653 100644 --- a/lib/CPANPLUS/Internals/Utils/Autoflush.pm +++ b/lib/CPANPLUS/Internals/Utils/Autoflush.pm @@ -1,7 +1,7 @@ package CPANPLUS::Internals::Utils::Autoflush; use vars qw[$VERSION]; -$VERSION = '0.9133'; +$VERSION = "0.9134"; BEGIN { $|++ }; diff --git a/lib/CPANPLUS/Module.pm b/lib/CPANPLUS/Module.pm index 468f4c99..61347f40 100644 --- a/lib/CPANPLUS/Module.pm +++ b/lib/CPANPLUS/Module.pm @@ -2,7 +2,7 @@ package CPANPLUS::Module; use strict; use vars qw[@ISA $VERSION]; -$VERSION = '0.9133'; +$VERSION = "0.9134"; use CPANPLUS::Dist; use CPANPLUS::Error; diff --git a/lib/CPANPLUS/Module/Author.pm b/lib/CPANPLUS/Module/Author.pm index 1b309338..a53f839b 100644 --- a/lib/CPANPLUS/Module/Author.pm +++ b/lib/CPANPLUS/Module/Author.pm @@ -7,7 +7,7 @@ use CPANPLUS::Internals::Constants; use Params::Check qw[check]; use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; use vars qw[$VERSION]; -$VERSION = '0.9133'; +$VERSION = "0.9134"; local $Params::Check::VERBOSE = 1; diff --git a/lib/CPANPLUS/Module/Author/Fake.pm b/lib/CPANPLUS/Module/Author/Fake.pm index fe90abdc..18581405 100644 --- a/lib/CPANPLUS/Module/Author/Fake.pm +++ b/lib/CPANPLUS/Module/Author/Fake.pm @@ -9,7 +9,7 @@ use strict; use vars qw[@ISA $VERSION]; use Params::Check qw[check]; -$VERSION = '0.9133'; +$VERSION = "0.9134"; @ISA = qw[CPANPLUS::Module::Author]; diff --git a/lib/CPANPLUS/Module/Checksums.pm b/lib/CPANPLUS/Module/Checksums.pm index a4c73414..863b62a4 100644 --- a/lib/CPANPLUS/Module/Checksums.pm +++ b/lib/CPANPLUS/Module/Checksums.pm @@ -15,7 +15,7 @@ use Module::Load::Conditional qw[can_load]; $Params::Check::VERBOSE = 1; @ISA = qw[ CPANPLUS::Module::Signature ]; -$VERSION = '0.9133'; +$VERSION = "0.9134"; =head1 NAME diff --git a/lib/CPANPLUS/Module/Fake.pm b/lib/CPANPLUS/Module/Fake.pm index ddeb4711..d79f8da2 100644 --- a/lib/CPANPLUS/Module/Fake.pm +++ b/lib/CPANPLUS/Module/Fake.pm @@ -10,7 +10,7 @@ use strict; use vars qw[@ISA $VERSION]; use Params::Check qw[check]; -$VERSION = '0.9133'; +$VERSION = "0.9134"; @ISA = qw[CPANPLUS::Module]; $Params::Check::VERBOSE = 1; diff --git a/lib/CPANPLUS/Module/Signature.pm b/lib/CPANPLUS/Module/Signature.pm index becee464..6b98abfc 100644 --- a/lib/CPANPLUS/Module/Signature.pm +++ b/lib/CPANPLUS/Module/Signature.pm @@ -7,7 +7,7 @@ use CPANPLUS::Error; use Params::Check qw[check]; use Module::Load::Conditional qw[can_load]; use vars qw[$VERSION]; -$VERSION = '0.9133'; +$VERSION = "0.9134"; ### detached sig, not actually used afaik --kane ### #sub get_signature { diff --git a/lib/CPANPLUS/Selfupdate.pm b/lib/CPANPLUS/Selfupdate.pm index 4735e96f..19e70209 100644 --- a/lib/CPANPLUS/Selfupdate.pm +++ b/lib/CPANPLUS/Selfupdate.pm @@ -10,7 +10,7 @@ use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; use CPANPLUS::Internals::Constants; use vars qw[$VERSION]; -$VERSION = '0.9133'; +$VERSION = "0.9134"; $Params::Check::VERBOSE = 1; diff --git a/lib/CPANPLUS/Shell.pm b/lib/CPANPLUS/Shell.pm index 4b67e3b6..4a38bf8f 100644 --- a/lib/CPANPLUS/Shell.pm +++ b/lib/CPANPLUS/Shell.pm @@ -14,7 +14,7 @@ $Params::Check::VERBOSE = 1; use vars qw[@ISA $SHELL $DEFAULT $VERSION]; -$VERSION = '0.9133'; +$VERSION = "0.9134"; $DEFAULT = SHELL_DEFAULT; =pod diff --git a/lib/CPANPLUS/Shell/Classic.pm b/lib/CPANPLUS/Shell/Classic.pm index 7e37f5be..3090a57a 100644 --- a/lib/CPANPLUS/Shell/Classic.pm +++ b/lib/CPANPLUS/Shell/Classic.pm @@ -30,7 +30,7 @@ $Params::Check::ALLOW_UNKNOWN = 1; BEGIN { use vars qw[ $VERSION @ISA ]; @ISA = qw[ CPANPLUS::Shell::_Base::ReadLine ]; - $VERSION = '0.9133'; + $VERSION = "0.9134"; } load CPANPLUS::Shell; diff --git a/lib/CPANPLUS/Shell/Default.pm b/lib/CPANPLUS/Shell/Default.pm index 81bc5046..1d5a134e 100644 --- a/lib/CPANPLUS/Shell/Default.pm +++ b/lib/CPANPLUS/Shell/Default.pm @@ -26,7 +26,7 @@ local $Data::Dumper::Indent = 1; # for dumpering from ! BEGIN { use vars qw[ $VERSION @ISA ]; @ISA = qw[ CPANPLUS::Shell::_Base::ReadLine ]; - $VERSION = "0.9133"; + $VERSION = "0.9134"; } load CPANPLUS::Shell; diff --git a/lib/CPANPLUS/Shell/Default/Plugins/CustomSource.pm b/lib/CPANPLUS/Shell/Default/Plugins/CustomSource.pm index 8300f51b..fefa996b 100644 --- a/lib/CPANPLUS/Shell/Default/Plugins/CustomSource.pm +++ b/lib/CPANPLUS/Shell/Default/Plugins/CustomSource.pm @@ -8,7 +8,7 @@ use Data::Dumper; use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; use vars qw[$VERSION]; -$VERSION = '0.9133'; +$VERSION = "0.9134"; =head1 NAME diff --git a/lib/CPANPLUS/Shell/Default/Plugins/Remote.pm b/lib/CPANPLUS/Shell/Default/Plugins/Remote.pm index b040d3bb..e72364a7 100644 --- a/lib/CPANPLUS/Shell/Default/Plugins/Remote.pm +++ b/lib/CPANPLUS/Shell/Default/Plugins/Remote.pm @@ -8,7 +8,7 @@ use CPANPLUS::Error qw[error msg]; use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; use vars qw[$VERSION]; -$VERSION = '0.9133'; +$VERSION = "0.9134"; =head1 NAME diff --git a/lib/CPANPLUS/Shell/Default/Plugins/Source.pm b/lib/CPANPLUS/Shell/Default/Plugins/Source.pm index e5f63628..e5991886 100644 --- a/lib/CPANPLUS/Shell/Default/Plugins/Source.pm +++ b/lib/CPANPLUS/Shell/Default/Plugins/Source.pm @@ -5,7 +5,7 @@ use CPANPLUS::Error qw[error msg]; use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; use vars qw[$VERSION]; -$VERSION = '0.9133'; +$VERSION = "0.9134"; =head1 NAME