From: Rafael Garcia-Suarez Date: Mon, 27 Feb 2006 17:00:37 +0000 (+0000) Subject: Upgrade to CPAN 1.87 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=87892b7316b5db4861dda5a8422f3d25156801f5;p=p5sagit%2Fp5-mst-13.2.git Upgrade to CPAN 1.87 p4raw-id: //depot/perl@27346 --- diff --git a/lib/CPAN.pm b/lib/CPAN.pm index 6f1fed6..bb92e5d 100644 --- a/lib/CPAN.pm +++ b/lib/CPAN.pm @@ -1,6 +1,6 @@ # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*- package CPAN; -$VERSION = '1.86'; +$VERSION = '1.87'; $VERSION = eval $VERSION; use strict; @@ -212,7 +212,7 @@ ReadLine support %s my $command = shift @line; eval { CPAN::Shell->$command(@line) }; warn $@ if $@; - if ($command =~ /^(make|test|install|force|notest)$/) { + if ($command =~ /^(make|test|install|force|notest|clean)$/) { CPAN::Shell->failed($CPAN::CurrentCommandId,1); } soft_chdir_with_alternatives(\@cwd); @@ -416,7 +416,7 @@ For this you just need to type }); } } else { - $CPAN::Frontend->mywarn(qq{Unknown shell command '$autoload'. }. + $CPAN::Frontend->mywarn(qq{Unknown shell command '$autoload @_'. }. qq{Type ? for help. }); } @@ -672,8 +672,6 @@ Please make sure the directory exists and is writable. my $fh; unless ($fh = FileHandle->new(">$lockfile")) { if ($! =~ /Permission/) { - my $incc = $INC{'CPAN/Config.pm'}; - my $myincc = File::Spec->catfile($ENV{HOME},'.cpan','CPAN','MyConfig.pm'); $CPAN::Frontend->myprint(qq{ Your configuration suggests that CPAN.pm should use a working @@ -686,10 +684,8 @@ due to permission problems. Please make sure that the configuration variable \$CPAN::Config->{cpan_home} points to a directory where you can write a .lock file. You can set -this variable in either - $incc -or - $myincc +this variable in either a CPAN/MyConfig.pm or a CPAN/Config.pm in your +\@INC path; }); if(!$INC{'CPAN/MyConfig.pm'}) { $CPAN::Frontend->myprint("You don't seem to have a user ". @@ -836,17 +832,28 @@ sub has_usable { 'Net::FTP' => [ sub {require Net::FTP}, sub {require Net::Config}, - ] + ], + 'File::HomeDir' => [ + sub {require File::HomeDir; + unless (File::HomeDir->VERSION >= 0.52){ + for ("Will not use File::HomeDir, need 0.52\n") { + warn $_; + die $_; + } + } + }, + ], }; if ($usable->{$mod}) { - for my $c (0..$#{$usable->{$mod}}) { - my $code = $usable->{$mod}[$c]; - my $ret = eval { &$code() }; - if ($@) { - warn "DEBUG: c[$c]\$\@[$@]ret[$ret]"; - return; + for my $c (0..$#{$usable->{$mod}}) { + my $code = $usable->{$mod}[$c]; + my $ret = eval { &$code() }; + $ret = "" unless defined $ret; + if ($@) { + # warn "DEBUG: c[$c]\$\@[$@]ret[$ret]"; + return; + } } - } } return $HAS_USABLE->{$mod} = 1; } @@ -1558,11 +1565,11 @@ sub reload_this { sub mkmyconfig { my($self, $cpanpm, %args) = @_; require CPAN::FirstTime; - $cpanpm = $INC{'CPAN/MyConfig.pm'} || "$ENV{HOME}/.cpan/CPAN/MyConfig.pm"; + my $home = CPAN::HandleConfig::home; + $cpanpm = $INC{'CPAN/MyConfig.pm'} || + File::Spec->catfile(split /\//, "$home/.cpan/CPAN/MyConfig.pm"); File::Path::mkpath(File::Basename::dirname($cpanpm)) unless -e $cpanpm; - if(!$INC{'CPAN/Config.pm'}) { - eval { require CPAN::Config; }; - } + CPAN::HandleConfig::require_myconfig_or_config; $CPAN::Config ||= {}; $CPAN::Config = { %$CPAN::Config, @@ -1753,30 +1760,31 @@ sub failed { my @failed; DIST: for my $d ($CPAN::META->all_objects("CPAN::Distribution")) { my $failed = ""; - for my $nosayer ( - "writemakefile", - "signature_verify", - "make", - "make_test", - "install", - ) { + NAY: for my $nosayer ( + "writemakefile", + "signature_verify", + "make", + "make_test", + "install", + "make_clean", + ) { next unless exists $d->{$nosayer}; next unless ( $d->{$nosayer}->can("failed") ? $d->{$nosayer}->failed : $d->{$nosayer} =~ /^NO/ ); + next NAY if $only_id && $only_id != ( + $d->{$nosayer}->can("commandid") + ? + $d->{$nosayer}->commandid + : + $CPAN::CurrentCommandId + ); $failed = $nosayer; last; } next DIST unless $failed; - next DIST if $only_id && $only_id != ( - $d->{$failed}->can("commandid") - ? - $d->{$failed}->commandid - : - $CPAN::CurrentCommandId - ); my $id = $d->id; $id =~ s|^./../||; #$print .= sprintf( @@ -3148,7 +3156,8 @@ use strict; # package CPAN::FTP::netrc; sub new { my($class) = @_; - my $file = File::Spec->catfile($ENV{HOME},".netrc"); + my $home = CPAN::HandleConfig::home; + my $file = File::Spec->catfile($home,".netrc"); my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mtime,$ctime,$blksize,$blocks) @@ -3941,7 +3950,9 @@ sub fullname { #-> sub CPAN::InfoObj::dump ; sub dump { my($self) = @_; - require Data::Dumper; + unless ($CPAN::META->has_inst("Data::Dumper")) { + $CPAN::Frontend->mydie("dump command requires Data::Dumper installed"); + } local $Data::Dumper::Sortkeys; $Data::Dumper::Sortkeys = 1; print Data::Dumper::Dumper($self); @@ -4936,14 +4947,17 @@ going awry right now. #-> sub CPAN::Distribution::eq_CHECKSUM ; sub eq_CHECKSUM { my($self,$fh,$expect) = @_; - my $dg = Digest::SHA->new(256); - my($data); - while (read($fh, $data, 4096)){ - $dg->add($data); + if ($CPAN::META->has_inst("Digest::SHA")) { + my $dg = Digest::SHA->new(256); + my($data); + while (read($fh, $data, 4096)){ + $dg->add($data); + } + my $hexdigest = $dg->hexdigest; + # warn "fh[$fh] hex[$hexdigest] aexp[$expectMD5]"; + return $hexdigest eq $expect; } - my $hexdigest = $dg->hexdigest; - # warn "fh[$fh] hex[$hexdigest] aexp[$expectMD5]"; - $hexdigest eq $expect; + return 1; } #-> sub CPAN::Distribution::force ; @@ -5577,16 +5591,16 @@ sub clean { )) { delete $self->{$k}; } - $self->{make_clean} = "YES"; + $self->{make_clean} = CPAN::Distrostatus->new("YES"); } else { # Hmmm, what to do if make clean failed? - $CPAN::Frontend->myprint(qq{ $system -- NOT OK + $self->{make_clean} = CPAN::Distrostatus->new("NO"); + $CPAN::Frontend->myprint(qq{ $system -- NOT OK\n}); -make clean did not succeed, marking directory as unusable for further work. -}); - $self->force("make"); # so that this directory won't be used again + # 2006-02-27: seems silly to me to force a make now + # $self->force("make"); # so that this directory won't be used again } } @@ -5679,7 +5693,7 @@ sub install { ); } - my($stderr) = $^O =~ /Win/i ? "" : " 2>&1 "; + my($stderr) = $^O eq "MSWin32" ? "" : " 2>&1 "; my($pipe) = FileHandle->new("$system $stderr |"); my($makeout) = ""; while (<$pipe>){ @@ -6194,10 +6208,10 @@ during recursive bundle calls: " unless $report_propagated++; } } -#sub CPAN::Bundle::xs_file +# If a bundle contains another that contains an xs_file we have here, +# we just don't bother I suppose +#-> sub CPAN::Bundle::xs_file sub xs_file { - # If a bundle contains another that contains an xs_file we have - # here, we just don't bother I suppose return 0; } @@ -6330,6 +6344,48 @@ sub as_glimpse { join "", @m; } +#-> sub CPAN::Module::dslip_status +sub dslip_status { + my($self) = @_; + my($stat); + @{$stat->{D}}{qw,i c a b R M S,} = qw,idea + pre-alpha alpha beta released + mature standard,; + @{$stat->{S}}{qw,m d u n a,} = qw,mailing-list + developer comp.lang.perl.* + none abandoned,; + @{$stat->{L}}{qw,p c + o h,} = qw,perl C C++ other hybrid,; + @{$stat->{I}}{qw,f r O p h n,} = qw,functions + references+ties + object-oriented pragma + hybrid none,; + @{$stat->{P}}{qw,p g l b a o d r n,} = qw,Standard-Perl + GPL LGPL + BSD Artistic + open-source + distribution_allowed + restricted_distribution + no_licence,; + for my $x (qw(d s l i p)) { + $stat->{$x}{' '} = 'unknown'; + $stat->{$x}{'?'} = 'unknown'; + } + my $ro = $self->ro; + return +{} unless $ro && $ro->{statd}; + return { + D => $ro->{statd}, + S => $ro->{stats}, + L => $ro->{statl}, + I => $ro->{stati}, + P => $ro->{statp}, + DV => $stat->{D}{$ro->{statd}}, + SV => $stat->{S}{$ro->{stats}}, + LV => $stat->{L}{$ro->{statl}}, + IV => $stat->{I}{$ro->{stati}}, + PV => $stat->{P}{$ro->{statp}}, + }; +} + #-> sub CPAN::Module::as_string ; sub as_string { my($self) = @_; @@ -6372,32 +6428,13 @@ sub as_string { } } } - my $sprintf3 = " %-12s %1s%1s%1s%1s (%s,%s,%s,%s)\n"; - my(%statd,%stats,%statl,%stati); - @statd{qw,? i c a b R M S,} = qw,unknown idea - pre-alpha alpha beta released mature standard,; - @stats{qw,? m d u n a,} = qw,unknown mailing-list - developer comp.lang.perl.* none abandoned,; - @statl{qw,? p c + o h,} = qw,unknown perl C C++ other hybrid,; - @stati{qw,? f r O h,} = qw,unknown functions - references+ties object-oriented hybrid,; - $statd{' '} = 'unknown'; - $stats{' '} = 'unknown'; - $statl{' '} = 'unknown'; - $stati{' '} = 'unknown'; - my $ro = $self->ro; + my $sprintf3 = " %-12s %1s%1s%1s%1s%1s (%s,%s,%s,%s,%s)\n"; + my $dslip = $self->dslip_status; push @m, sprintf( - $sprintf3, - 'DSLI_STATUS', - $ro->{statd}, - $ro->{stats}, - $ro->{statl}, - $ro->{stati}, - $statd{$ro->{statd}}, - $stats{$ro->{stats}}, - $statl{$ro->{statl}}, - $stati{$ro->{stati}} - ) if $ro && $ro->{statd}; + $sprintf3, + 'DSLIP_STATUS', + @{$dslip}{qw(D S L I P DV SV LV IV PV)}, + ); my $local_file = $self->inst_file; unless ($self->{MANPAGE}) { if ($local_file) { @@ -7399,6 +7436,60 @@ or 00modlist.long.txt.gz) Returns the CPAN::Distribution object that contains the current version of this module. +=item CPAN::Module::dslip_status() + +Returns a hash reference. The keys of the hash are the letters C, +C, C, C, and

, for development status, support level, +language, interface and public licence respectively. The data for the +DSLIP status are collected by pause.perl.org when authors register +their namespaces. The values of the 5 hash elements are one-character +words whose meaning is described in the table below. There are also 5 +hash elements C, C, C, C, and that carry a more +verbose value of the 5 status variables. + +Where the 'DSLIP' characters have the following meanings: + + D - Development Stage (Note: *NO IMPLIED TIMESCALES*): + i - Idea, listed to gain consensus or as a placeholder + c - under construction but pre-alpha (not yet released) + a/b - Alpha/Beta testing + R - Released + M - Mature (no rigorous definition) + S - Standard, supplied with Perl 5 + + S - Support Level: + m - Mailing-list + d - Developer + u - Usenet newsgroup comp.lang.perl.modules + n - None known, try comp.lang.perl.modules + a - abandoned; volunteers welcome to take over maintainance + + L - Language Used: + p - Perl-only, no compiler needed, should be platform independent + c - C and perl, a C compiler will be needed + h - Hybrid, written in perl with optional C code, no compiler needed + + - C++ and perl, a C++ compiler will be needed + o - perl and another language other than C or C++ + + I - Interface Style + f - plain Functions, no references used + h - hybrid, object and function interfaces available + n - no interface at all (huh?) + r - some use of unblessed References or ties + O - Object oriented using blessed references and/or inheritance + + P - Public License + p - Standard-Perl: user may choose between GPL and Artistic + g - GPL: GNU General Public License + l - LGPL: "GNU Lesser General Public License" (previously known as + "GNU Library General Public License") + b - BSD: The BSD License + a - Artistic license alone + o - open source: appoved by www.opensource.org + d - allows distribution without restrictions + r - restricted distribtion + n - no license at all + =item CPAN::Module::force($method,@args) Forces CPAN to perform a task that normally would have failed. Force @@ -7978,6 +8069,10 @@ including or setting the PERL5LIB environment variable. +While we're speaking about $ENV{HOME}, it might be worth mentioning, +that for Windows we use the File::HomeDir module that provides an +equivalent to the concept of the home directory on Unix. + Another thing you should bear in mind is that the UNINST parameter can be dnagerous when you are installing into a private area because you might accidentally remove modules that other people depend on that are diff --git a/lib/CPAN/FirstTime.pm b/lib/CPAN/FirstTime.pm index 62b8ad1..3d24c9c 100644 --- a/lib/CPAN/FirstTime.pm +++ b/lib/CPAN/FirstTime.pm @@ -2,7 +2,7 @@ package CPAN::Mirrored::By; use strict; use vars qw($VERSION); -$VERSION = sprintf "%.6f", substr(q$Rev: 561 $,4)/1000000 + 5.4; +$VERSION = sprintf "%.6f", substr(q$Rev: 657 $,4)/1000000 + 5.4; sub new { my($self,@arg) = @_; @@ -21,7 +21,7 @@ use File::Basename (); use File::Path (); use File::Spec; use vars qw($VERSION); -$VERSION = sprintf "%.6f", substr(q$Rev: 561 $,4)/1000000 + 5.4; +$VERSION = sprintf "%.6f", substr(q$Rev: 657 $,4)/1000000 + 5.4; =head1 NAME @@ -51,7 +51,8 @@ sub init { unless ($CPAN::VERSION) { require CPAN::Nox; } - eval {require CPAN::Config;}; + require CPAN::HandleConfig; + CPAN::HandleConfig::require_myconfig_or_config(); $CPAN::Config ||= {}; local($/) = "\n"; local($\) = ""; diff --git a/lib/CPAN/HandleConfig.pm b/lib/CPAN/HandleConfig.pm index fdef34b..93e2a9c 100644 --- a/lib/CPAN/HandleConfig.pm +++ b/lib/CPAN/HandleConfig.pm @@ -1,8 +1,8 @@ package CPAN::HandleConfig; use strict; -use vars qw(%can %keys $dot_cpan $VERSION); +use vars qw(%can %keys $VERSION); -$VERSION = sprintf "%.6f", substr(q$Rev: 581 $,4)/1000000 + 5.4; +$VERSION = sprintf "%.6f", substr(q$Rev: 657 $,4)/1000000 + 5.4; %can = ( commit => "Commit changes to disk", @@ -67,8 +67,9 @@ if ($^O eq "MSWin32") { )) { delete $keys{$k}; if (exists $CPAN::Config->{$k}) { - $CPAN::Frontend->mywarn("deleting previously set config variable ". - "'$k' => '$CPAN::Config->{$k}'"); + for ("deleting previously set config variable '$k' => '$CPAN::Config->{$k}'") { + $CPAN::Frontend ? $CPAN::Frontend->mywarn($_) : warn $_; + } delete $CPAN::Config->{$k}; } } @@ -312,20 +313,34 @@ END } else { return } } +sub require_myconfig_or_config () { + return if $INC{"CPAN/MyConfig.pm"}; + local @INC = @INC; + my $home = home(); + unshift @INC, File::Spec->catdir($home,'.cpan'); + eval { require CPAN::MyConfig }; + unless ($INC{"CPAN/MyConfig.pm"}) { # this guy has settled his needs already + eval {require CPAN::Config;}; # not everybody has one + } +} + +sub home () { + my $home; + if ($CPAN::META->has_usable("File::HomeDir")) { + $home = File::HomeDir->my_data; + } else { + $home = $ENV{HOME}; + } + $home; +} + sub load { my($self, %args) = @_; $CPAN::Be_Silent++ if $args{be_silent}; my(@miss); use Carp; - unless ($INC{"CPAN/MyConfig.pm"}) { # this guy has settled his needs already - eval {require CPAN::Config;}; # not everybody has one - } - unless ($dot_cpan++){ - unshift @INC, File::Spec->catdir($ENV{HOME},".cpan"); - eval {require CPAN::MyConfig;}; # override system wide settings - shift @INC; - } + require_myconfig_or_config; return unless @miss = $self->missing_config_data; require CPAN::FirstTime; @@ -348,7 +363,7 @@ sub load { $inc_key = "CPAN/Config.pm"; } unless ($configpm) { - $configpmdir = File::Spec->catdir($ENV{HOME},".cpan","CPAN"); + $configpmdir = File::Spec->catdir(home,".cpan","CPAN"); File::Path::mkpath($configpmdir); $configpmtest = File::Spec->catfile($configpmdir,"MyConfig.pm"); $configpm = _configpmtest($configpmdir,$configpmtest); @@ -471,7 +486,7 @@ package use strict; use vars qw($AUTOLOAD $VERSION); -$VERSION = sprintf "%.2f", substr(q$Rev: 581 $,4)/100; +$VERSION = sprintf "%.2f", substr(q$Rev: 657 $,4)/100; # formerly CPAN::HandleConfig was known as CPAN::Config sub AUTOLOAD { diff --git a/lib/CPAN/SIGNATURE b/lib/CPAN/SIGNATURE index 5ae7a1d..abf2b69 100644 --- a/lib/CPAN/SIGNATURE +++ b/lib/CPAN/SIGNATURE @@ -14,27 +14,27 @@ not run its Makefile.PL or Build.PL. -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 -SHA1 012fe78dd6e0d5f40df4a56a08cc75e9463909dd ChangeLog +SHA1 503d633750c15310bdac5fee77f4c97da1bc71f3 ChangeLog SHA1 9b97524a7a91c815e46b19302a33829d3c26bbbf ChangeLog.old -SHA1 10b5e854abb258433ffd38d942ece71e1dba47d6 Changes +SHA1 5d5c8e773ac9c97b5e7a5c65d9c31abef003b18b Changes SHA1 a029ffa2f2252bb8914eb658666244710994d256 Changes.old -SHA1 454c28a6fb8de61cc9d220b427a88cedded9ff4b MANIFEST -SHA1 a8a3d2f936abf0f2fbda5e5959c10ab09199e6ba MANIFEST.SKIP -SHA1 31bb1d7da7bc01d691168fd5473891c3ccc4da7f META.yml -SHA1 624cb8d0c64c79737a2dac973a500af2311d4ffa Makefile.PL +SHA1 2eea12eec1dfa3b7c5e534d5252b4bb9becfa38f MANIFEST +SHA1 d6facfb968686d74e249cc1e45463e61ff18d026 MANIFEST.SKIP +SHA1 49f392243079d029a76b8fd56525acc0e1361d20 META.yml +SHA1 9f0ad024210c870711c6e52621483a6c735a2fc3 Makefile.PL SHA1 37e858c51409a297ef5d3fb35dc57cd3b57f9a4d PAUSE2003.pub SHA1 af016003ad503ed078c5f8254521d13a3e0c494f PAUSE2005.pub -SHA1 9eb4a605d56bb6659801ca89910c61ab4ee4a25c README -SHA1 f1aed56cb3d8d9010060450a0263ce12a1e0e500 Todo +SHA1 4ec86ae1993d8b497ce8c026530af71290366122 README +SHA1 78a1416b5cb1335b09472bcd17f4967e876e942f Todo SHA1 efbe8e6882a2caa0d741b113959a706830ab5882 inc/Test/Builder.pm SHA1 ae1d68262bedc2475e2c6fd478d99b259b4fb109 inc/Test/More.pm -SHA1 a193be1f90083b068757a80eb3f11c33faae9258 lib/CPAN.pm +SHA1 6c2c007ac4f624f72635ec43ac045f6f031e7cd1 lib/CPAN.pm SHA1 94c4656fdae231c673719978e6e9a460f2dfc794 lib/CPAN/Admin.pm SHA1 8884e4b1932555e7d2f52d1df62097e8c78bb548 lib/CPAN/Debug.pm -SHA1 0961261e5a334fbce8e465d68e3513776ca4ad16 lib/CPAN/FirstTime.pm -SHA1 c3f2256705e2af3f467977515065dc343ddfdd0e lib/CPAN/HandleConfig.pm +SHA1 2b6bc87b7c09fb80d7962847e791cc697f1dc0f1 lib/CPAN/FirstTime.pm +SHA1 5b45acbcdc6da27ae1c1e6160cf78d51849d51ff lib/CPAN/HandleConfig.pm SHA1 f7b20d828c197710b4eac3029a30266242fb782b lib/CPAN/Nox.pm -SHA1 4b6c040b3ce14f660a1b99da34cd020343878796 lib/CPAN/Tarzip.pm +SHA1 9c0d5f217194ac755e97e1f936a878bbc7eaa362 lib/CPAN/Tarzip.pm SHA1 4d60b4782a851767c40dc27825057e584014cfc5 lib/CPAN/Version.pm SHA1 fb08e07d8740ef36e8ab719c6a9b7e89c4fe674a scripts/cpan SHA1 2a3adebb8252dc893681d17460082c2e08aa144a t/00signature.t @@ -43,12 +43,15 @@ SHA1 67e80e1cfc3530932de7743dd0c833b2c387609d t/02nox.t SHA1 b586d8e1a613880bbd2ec68d3abd0ca21e43b0c2 t/03pkgs.t SHA1 ebdb653877d5c5e5a071fe9933b18f018cde3250 t/10version.t SHA1 325d8a2f72d59c4cd2400c72403c05cd614c3abc t/11mirroredby.t -SHA1 3b9f497520b0a56ea5cab94b45a9af9995025e6e t/12cpan.t -SHA1 12a215fbdd0d5142bf1ebbe02d4672765845b28d t/30shell.t +SHA1 96de4b1e41fca2ecf0641d4242020ccd05c4ef47 t/12cpan.t +SHA1 228e825e24b1cf3a3ca3fc24f1ea86de354c2cb6 t/30shell.pod +SHA1 5af241d60e757fbed792079b99eb0e15ac3d6628 t/30shell.t SHA1 6a79f15a10337bd3450604abf39d4462df2a550b t/50pod.t -SHA1 70f0df4041b1c9ae9f30117b0fad9fe5760f17c8 t/CPAN/TestConfig.pm +SHA1 7efe930efd0a07d8101679ed15d4700dcf208137 t/CPAN/CpanTestDummies-1.55.pm +SHA1 2b0622cff92a038c8fbb2b852a55b014d20588f3 t/CPAN/TestConfig.pm SHA1 b4fd27234696da334ac6a1716222c70610a98c3a t/CPAN/authors/01mailrc.txt SHA1 61f6dbc7e5616028952b07a0451e029d41993bb6 t/CPAN/authors/id/A/AN/ANDK/CHECKSUMS +SHA1 d1a101f24d2d0719c9991df28ede729d58005bb4 t/CPAN/authors/id/A/AN/ANDK/CHECKSUMS@588 SHA1 3bafbff953a645fccf54e505a71ef711ba895522 t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Build-1.01.tar.gz SHA1 11f35aa730e452797f5d7371a393e24e40ea8d21 t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-Build-Fails-1.01.tar.gz SHA1 c0587c6180bd979acfa2b2396688208793366ff5 t/CPAN/authors/id/A/AN/ANDK/CPAN-Test-Dummy-Perl5-BuildOrMake-1.01.tar.gz @@ -62,11 +65,10 @@ SHA1 dfc900f5bfbc9683fa91977a1c7198222fbd4452 t/CPAN/authors/id/CHECKSUMS SHA1 468603b8016e599fec432e807890fb55f07483a6 t/CPAN/modules/02packages.details.txt SHA1 9bbcc30e783e5fe67e2aa12d5f1fe113563e345c t/CPAN/modules/03modlist.data SHA1 836b7df7eb49a55bfc2afdb666be6ac72e5658bc t/README.shell.txt -SHA1 7efe930efd0a07d8101679ed15d4700dcf208137 t/dot-cpan/Bundle/CpanTestDummies-1.55.pm -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.2 (GNU/Linux) -iD8DBQFD+X8U7IA58KMXwV0RAqtqAKCif6ygm9/5W6ves5HSFTJNhOsGgQCg9JZc -iScqmUjdguw67lb79NxcCjQ= -=CJK5 +iD8DBQFEAqK+7IA58KMXwV0RAi6oAJ4mPY4qXiPW8Ee3PEbhyHMWyWJWPQCg6Q99 +CZnZg3sLednZofhJcd75dlM= +=wrpR -----END PGP SIGNATURE----- diff --git a/lib/CPAN/Tarzip.pm b/lib/CPAN/Tarzip.pm index 05b207c..d0281d2 100644 --- a/lib/CPAN/Tarzip.pm +++ b/lib/CPAN/Tarzip.pm @@ -4,7 +4,7 @@ use strict; use vars qw($VERSION @ISA $BUGHUNTING); use CPAN::Debug; use File::Basename (); -$VERSION = sprintf "%.6f", substr(q$Rev: 561 $,4)/1000000 + 5.4; +$VERSION = sprintf "%.6f", substr(q$Rev: 659 $,4)/1000000 + 5.4; # module is internal to CPAN.pm @ISA = qw(CPAN::Debug); @@ -89,7 +89,9 @@ sub gunzip { sub gtest { my($self) = @_; - my $read = $self->{FILE}; + return $self->{GTEST} if exists $self->{GTEST}; + my $read = $self->{FILE} or die; + my $success; # After I had reread the documentation in zlib.h, I discovered that # uncompressed files do not lead to an gzerror (anymore?). if ( $CPAN::META->has_inst("Compress::Zlib") ) { @@ -104,17 +106,17 @@ sub gtest { $buffer = ""; } my $err = $gz->gzerror; - my $success = ! $err || $err == Compress::Zlib::Z_STREAM_END(); + $success = ! $err || $err == Compress::Zlib::Z_STREAM_END(); if ($len == -s $read){ $success = 0; CPAN->debug("hit an uncompressed file") if $CPAN::DEBUG; } $gz->gzclose(); CPAN->debug("err[$err]success[$success]") if $CPAN::DEBUG; - return $success; } else { - return system(qq{$self->{UNGZIPPRG} -dt "$read"})==0; + $success = 0==system(qq{$self->{UNGZIPPRG} -qdt "$read"}); } + return $self->{GTEST} = $success; } @@ -122,17 +124,23 @@ sub TIEHANDLE { my($class,$file) = @_; my $ret; $class->debug("file[$file]"); - if ($CPAN::META->has_inst("Compress::Zlib")) { + my $self = $class->new($file); + if (0) { + } elsif (!$self->gtest) { + my $fh = FileHandle->new($file) or die "Could not open file[$file]: $!"; + binmode $fh; + $self->{FH} = $fh; + } elsif ($CPAN::META->has_inst("Compress::Zlib")) { my $gz = Compress::Zlib::gzopen($file,"rb") or die "Could not gzopen $file"; - $ret = bless {GZ => $gz}, $class; + $self->{GZ} = $gz; } else { my $pipe = "$CPAN::Config->{gzip} -dc $file |"; my $fh = FileHandle->new($pipe) or die "Could not pipe[$pipe]: $!"; binmode $fh; - $ret = bless {FH => $fh}, $class; + $self->{FH} = $fh; } - $ret; + $self; }