1 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 2 -*-
4 use vars qw($VERSION @ISA $BUGHUNTING);
6 $VERSION = sprintf "%.2f", substr(q$Rev: 281 $,4)/100;
7 # module is internal to CPAN.pm
9 @ISA = qw(CPAN::Debug);
10 $BUGHUNTING = 0; # released code must have turned off
12 # it's ok if file doesn't exist, it just matters if it is .gz or .bz2
14 my($class,$file) = @_;
15 die "new called without arg" unless defined $file;
16 die "file[$file] doesn't match /\\.(bz2|gz|zip)\$/" unless $file =~ /\.(bz2|gz|zip)$/i;
17 my $me = { FILE => $file };
19 } elsif ($file =~ /\.bz2$/i) {
20 unless ($me->{UNGZIPPRG} = $CPAN::Config->{bzip2}) {
22 if ($CPAN::META->has_inst("File::Which")) {
23 $bzip2 = File::Which::which("bzip2");
26 $me->{UNGZIPPRG} = $bzip2;
28 $CPAN::Frontend->mydie(qq{
29 CPAN.pm needs the external program bzip2 in order to handle '$file'.
30 Please install it now and run 'o conf init' to register it as external
36 # yes, we let gzip figure it out in *any* other case
37 $me->{UNGZIPPRG} = $CPAN::Config->{gzip};
44 my $write = $self->{FILE};
45 if ($CPAN::META->has_inst("Compress::Zlib")) {
47 $fhw = FileHandle->new($read)
48 or $CPAN::Frontend->mydie("Could not open $read: $!");
50 my $gz = Compress::Zlib::gzopen($write, "wb")
51 or $CPAN::Frontend->mydie("Cannot gzopen $write: $! (pwd is $cwd)\n");
53 while read($fhw,$buffer,4096) > 0 ;
58 system("$self->{UNGZIPPRG} -c $read > $write")==0;
64 my($self,$write) = @_;
65 my $read = $self->{FILE};
66 if ($CPAN::META->has_inst("Compress::Zlib")) {
68 $fhw = FileHandle->new(">$write")
69 or $CPAN::Frontend->mydie("Could not open >$write: $!");
70 my $gz = Compress::Zlib::gzopen($read, "rb")
71 or $CPAN::Frontend->mydie("Cannot gzopen $read: $!\n");
73 while $gz->gzread($buffer) > 0 ;
74 $CPAN::Frontend->mydie("Error reading from $read: $!\n")
75 if $gz->gzerror != Compress::Zlib::Z_STREAM_END();
80 system("$self->{UNGZIPPRG} -dc $read > $write")==0;
87 my $read = $self->{FILE};
88 # After I had reread the documentation in zlib.h, I discovered that
89 # uncompressed files do not lead to an gzerror (anymore?).
90 if ( $CPAN::META->has_inst("Compress::Zlib") ) {
93 my $gz = Compress::Zlib::gzopen($read, "rb")
94 or $CPAN::Frontend->mydie(sprintf("Cannot gzopen %s: %s\n",
96 $Compress::Zlib::gzerrno));
97 while ($gz->gzread($buffer) > 0 ){
98 $len += length($buffer);
101 my $err = $gz->gzerror;
102 my $success = ! $err || $err == Compress::Zlib::Z_STREAM_END();
103 if ($len == -s $read){
105 CPAN->debug("hit an uncompressed file") if $CPAN::DEBUG;
108 CPAN->debug("err[$err]success[$success]") if $CPAN::DEBUG;
111 return system("$self->{UNGZIPPRG} -dt $read")==0;
117 my($class,$file) = @_;
119 $class->debug("file[$file]");
120 if ($CPAN::META->has_inst("Compress::Zlib")) {
121 my $gz = Compress::Zlib::gzopen($file,"rb") or
122 die "Could not gzopen $file";
123 $ret = bless {GZ => $gz}, $class;
125 my $pipe = "$CPAN::Config->{gzip} -dc $file |";
126 my $fh = FileHandle->new($pipe) or die "Could not pipe[$pipe]: $!";
128 $ret = bless {FH => $fh}, $class;
136 if (exists $self->{GZ}) {
137 my $gz = $self->{GZ};
138 my($line,$bytesread);
139 $bytesread = $gz->gzreadline($line);
140 return undef if $bytesread <= 0;
143 my $fh = $self->{FH};
150 my($self,$ref,$length,$offset) = @_;
151 die "read with offset not implemented" if defined $offset;
152 if (exists $self->{GZ}) {
153 my $gz = $self->{GZ};
154 my $byteread = $gz->gzread($$ref,$length);# 30eaf79e8b446ef52464b5422da328a8
157 my $fh = $self->{FH};
158 return read($fh,$$ref,$length);
165 if (exists $self->{GZ}) {
166 my $gz = $self->{GZ};
167 $gz->gzclose() if defined $gz; # hard to say if it is allowed
168 # to be undef ever. AK, 2000-09
170 my $fh = $self->{FH};
171 $fh->close if defined $fh;
179 my $file = $self->{FILE};
182 if (0) { # makes changing order easier
183 } elsif ($BUGHUNTING){
185 } elsif (MM->maybe_command($self->{UNGZIPPRG})
187 MM->maybe_command($CPAN::Config->{'tar'})) {
188 # should be default until Archive::Tar handles bzip2
191 $CPAN::META->has_inst("Archive::Tar")
193 $CPAN::META->has_inst("Compress::Zlib") ) {
194 if ($file =~ /\.bz2$/) {
195 $CPAN::Frontend->mydie(qq{
196 Archive::Tar lacks support for bz2. Can't continue.
201 $CPAN::Frontend->mydie(qq{
202 CPAN.pm needs either the external programs tar, gzip and bzip2
203 installed. Can't continue.
206 if ($prefer==1) { # 1 => external gzip+tar
208 my $is_compressed = $self->gtest();
209 if ($is_compressed) {
210 $system = "$self->{UNGZIPPRG} -dc " .
211 "< $file | $CPAN::Config->{tar} xvf -";
213 $system = "$CPAN::Config->{tar} xvf $file";
215 if (system($system) != 0) {
216 # people find the most curious tar binaries that cannot handle
218 if ($is_compressed) {
219 (my $ungzf = $file) =~ s/\.gz(?!\n)\Z//;
220 if (CPAN::Tarzip->gunzip($file, $ungzf)) {
221 $CPAN::Frontend->myprint(qq{Uncompressed $file successfully\n});
223 $CPAN::Frontend->mydie(qq{Couldn\'t uncompress $file\n});
227 $system = "$CPAN::Config->{tar} xvf $file";
228 $CPAN::Frontend->myprint(qq{Using Tar:$system:\n});
229 if (system($system)==0) {
230 $CPAN::Frontend->myprint(qq{Untarred $file successfully\n});
232 $CPAN::Frontend->mydie(qq{Couldn\'t untar $file\n});
238 } elsif ($prefer==2) { # 2 => modules
239 my $tar = Archive::Tar->new($file,1);
240 my $af; # archive file
243 # RCS 1.337 had this code, it turned out unacceptable slow but
244 # it revealed a bug in Archive::Tar. Code is only here to hunt
245 # the bug again. It should never be enabled in published code.
246 # GDGraph3d-0.53 was an interesting case according to Larry
248 warn(">>>Bughunting code enabled<<< " x 20);
249 for $af ($tar->list_files) {
250 if ($af =~ m!^(/|\.\./)!) {
251 $CPAN::Frontend->mydie("ALERT: Archive contains ".
252 "illegal member [$af]");
254 $CPAN::Frontend->myprint("$af\n");
255 $tar->extract($af); # slow but effective for finding the bug
256 return if $CPAN::Signal;
259 for $af ($tar->list_files) {
260 if ($af =~ m!^(/|\.\./)!) {
261 $CPAN::Frontend->mydie("ALERT: Archive contains ".
262 "illegal member [$af]");
264 $CPAN::Frontend->myprint("$af\n");
266 return if $CPAN::Signal;
271 Mac::BuildTools::convert_files([$tar->list_files], 1)
280 my $file = $self->{FILE};
281 if ($CPAN::META->has_inst("Archive::Zip")) {
282 # blueprint of the code from Archive::Zip::Tree::extractTree();
283 my $zip = Archive::Zip->new();
285 $status = $zip->read($file);
286 die "Read of file[$file] failed\n" if $status != Archive::Zip::AZ_OK();
287 $CPAN::META->debug("Successfully read file[$file]") if $CPAN::DEBUG;
288 my @members = $zip->members();
289 for my $member ( @members ) {
290 my $af = $member->fileName();
291 if ($af =~ m!^(/|\.\./)!) {
292 $CPAN::Frontend->mydie("ALERT: Archive contains ".
293 "illegal member [$af]");
295 $status = $member->extractToFileNamed( $af );
296 $CPAN::META->debug("af[$af]status[$status]") if $CPAN::DEBUG;
297 die "Extracting of file[$af] from zipfile[$file] failed\n" if
298 $status != Archive::Zip::AZ_OK();
299 return if $CPAN::Signal;
303 my $unzip = $CPAN::Config->{unzip} or
304 $CPAN::Frontend->mydie("Cannot unzip, no unzip program available");
305 my @system = ($unzip, $file);
306 return system(@system) == 0;