use strict;
use vars qw($VERSION @ISA $BUGHUNTING);
use CPAN::Debug;
-$VERSION = sprintf "%.2f", substr(q$Rev: 281 $,4)/100;
+use File::Basename ();
+$VERSION = sprintf "%.6f", substr(q$Rev: 1717 $,4)/1000000 + 5.4;
# module is internal to CPAN.pm
@ISA = qw(CPAN::Debug);
-$BUGHUNTING = 0; # released code must have turned off
+$BUGHUNTING ||= 0; # released code must have turned off
# it's ok if file doesn't exist, it just matters if it is .gz or .bz2
sub new {
my($class,$file) = @_;
- die "new called without arg" unless defined $file;
- die "file[$file] doesn't match /\\.(bz2|gz|zip)\$/" unless $file =~ /\.(bz2|gz|zip)$/i;
+ $CPAN::Frontend->mydie("CPAN::Tarzip->new called without arg") unless defined $file;
+ if (0) {
+ # nonono, we get e.g. 01mailrc.txt uncompressed if only wget is available
+ $CPAN::Frontend->mydie("file[$file] doesn't match /\\.(bz2|gz|zip|tgz)\$/")
+ unless $file =~ /\.(bz2|gz|zip|tgz)$/i;
+ }
my $me = { FILE => $file };
if (0) {
} elsif ($file =~ /\.bz2$/i) {
$bzip2 = File::Which::which("bzip2");
}
if ($bzip2) {
- $me->{UNGZIPPRG} = $bzip2;
+ $me->{UNGZIPPRG} = $bzip2 || "bzip2";
} else {
$CPAN::Frontend->mydie(qq{
CPAN.pm needs the external program bzip2 in order to handle '$file'.
}
} else {
# yes, we let gzip figure it out in *any* other case
- $me->{UNGZIPPRG} = $CPAN::Config->{gzip};
+ $me->{UNGZIPPRG} = $CPAN::Config->{gzip} || "gzip";
}
bless $me, $class;
}
$fhw->close;
return 1;
} else {
- system("$self->{UNGZIPPRG} -c $read > $write")==0;
+ my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
+ system(qq{$command -c "$read" > "$write"})==0;
}
}
$fhw->close;
return 1;
} else {
- system("$self->{UNGZIPPRG} -dc $read > $write")==0;
+ my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
+ system(qq{$command -dc "$read" > "$write"})==0;
}
}
sub gtest {
my($self) = @_;
+ return $self->{GTEST} if exists $self->{GTEST};
+ defined $self->{FILE} or $CPAN::Frontend->mydie("gtest called but no FILE specified");
my $read = $self->{FILE};
+ 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") ) {
$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("$self->{UNGZIPPRG} -dt $read")==0;
+ my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
+ $success = 0==system(qq{$command -qdt "$read"});
}
+ return $self->{GTEST} = $success;
}
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 $CPAN::Frontend->mydie("Could not open file[$file]: $!");
+ binmode $fh;
+ $self->{FH} = $fh;
+ $class->debug("via uncompressed 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;
+ $CPAN::Frontend->mydie("Could not gzopen $file");
+ $self->{GZ} = $gz;
+ $class->debug("via Compress::Zlib");
} else {
- my $pipe = "$CPAN::Config->{gzip} -dc $file |";
- my $fh = FileHandle->new($pipe) or die "Could not pipe[$pipe]: $!";
+ my $gzip = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
+ my $pipe = "$gzip -dc $file |";
+ my $fh = FileHandle->new($pipe) or $CPAN::Frontend->mydie("Could not pipe[$pipe]: $!");
binmode $fh;
- $ret = bless {FH => $fh}, $class;
+ $self->{FH} = $fh;
+ $class->debug("via external gzip");
}
- $ret;
+ $self;
}
sub READ {
my($self,$ref,$length,$offset) = @_;
- die "read with offset not implemented" if defined $offset;
+ $CPAN::Frontend->mydie("read with offset not implemented") if defined $offset;
if (exists $self->{GZ}) {
my $gz = $self->{GZ};
my $byteread = $gz->gzread($$ref,$length);# 30eaf79e8b446ef52464b5422da328a8
$prefer=2;
} elsif (MM->maybe_command($self->{UNGZIPPRG})
&&
- MM->maybe_command($CPAN::Config->{'tar'})) {
+ MM->maybe_command($CPAN::Config->{tar})) {
# should be default until Archive::Tar handles bzip2
$prefer = 1;
} elsif (
- $CPAN::META->has_inst("Archive::Tar")
+ $CPAN::META->has_usable("Archive::Tar")
&&
$CPAN::META->has_inst("Compress::Zlib") ) {
- if ($file =~ /\.bz2$/) {
- $CPAN::Frontend->mydie(qq{
-Archive::Tar lacks support for bz2. Can't continue.
-});
- }
$prefer = 2;
} else {
$CPAN::Frontend->mydie(qq{
if ($prefer==1) { # 1 => external gzip+tar
my($system);
my $is_compressed = $self->gtest();
+ my $tarcommand = CPAN::HandleConfig->safe_quote($CPAN::Config->{tar}) || "tar";
if ($is_compressed) {
- $system = "$self->{UNGZIPPRG} -dc " .
- "< $file | $CPAN::Config->{tar} xvf -";
+ my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
+ $system = qq{$command -dc }.
+ qq{< "$file" | $tarcommand xvf -};
} else {
- $system = "$CPAN::Config->{tar} xvf $file";
+ $system = qq{$tarcommand xvf "$file"};
}
if (system($system) != 0) {
# people find the most curious tar binaries that cannot handle
# pipes
if ($is_compressed) {
(my $ungzf = $file) =~ s/\.gz(?!\n)\Z//;
- if (CPAN::Tarzip->gunzip($file, $ungzf)) {
+ $ungzf = File::Basename::basename($ungzf);
+ my $ct = CPAN::Tarzip->new($file);
+ if ($ct->gunzip($ungzf)) {
$CPAN::Frontend->myprint(qq{Uncompressed $file successfully\n});
} else {
$CPAN::Frontend->mydie(qq{Couldn\'t uncompress $file\n});
}
$file = $ungzf;
}
- $system = "$CPAN::Config->{tar} xvf $file";
+ $system = qq{$tarcommand xvf "$file"};
$CPAN::Frontend->myprint(qq{Using Tar:$system:\n});
if (system($system)==0) {
$CPAN::Frontend->myprint(qq{Untarred $file successfully\n});
return 1;
}
} elsif ($prefer==2) { # 2 => modules
+ unless ($CPAN::META->has_usable("Archive::Tar")) {
+ $CPAN::Frontend->mydie("Archive::Tar not installed, please install it to continue");
+ }
my $tar = Archive::Tar->new($file,1);
my $af; # archive file
my @af;
push @af, $af;
return if $CPAN::Signal;
}
- $tar->extract(@af);
+ $tar->extract(@af) or
+ $CPAN::Frontend->mydie("Could not untar with Archive::Tar.");
}
Mac::BuildTools::convert_files([$tar->list_files], 1)
my $zip = Archive::Zip->new();
my $status;
$status = $zip->read($file);
- die "Read of file[$file] failed\n" if $status != Archive::Zip::AZ_OK();
+ $CPAN::Frontend->mydie("Read of file[$file] failed\n")
+ if $status != Archive::Zip::AZ_OK();
$CPAN::META->debug("Successfully read file[$file]") if $CPAN::DEBUG;
my @members = $zip->members();
for my $member ( @members ) {
}
$status = $member->extractToFileNamed( $af );
$CPAN::META->debug("af[$af]status[$status]") if $CPAN::DEBUG;
- die "Extracting of file[$af] from zipfile[$file] failed\n" if
+ $CPAN::Frontend->mydie("Extracting of file[$af] from zipfile[$file] failed\n") if
$status != Archive::Zip::AZ_OK();
return if $CPAN::Signal;
}
1;
+__END__
+
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=cut
projects / p5sagit/p5-mst-13.2.git / blobdiff