[perl5.git] / lib / CPAN / Tarzip.pm

# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
package CPAN::Tarzip;
use strict;
use vars qw($VERSION @ISA $BUGHUNTING);
use CPAN::Debug;
use File::Basename ();
$VERSION = sprintf "%.6f", substr(q$Rev: 2213 $,4)/1000000 + 5.4;
# module is internal to CPAN.pm

@ISA = qw(CPAN::Debug);
$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) = @_;
    $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) {
        unless ($me->{UNGZIPPRG} = $CPAN::Config->{bzip2}) {
            my $bzip2;
            if ($CPAN::META->has_inst("File::Which")) {
                $bzip2 = File::Which::which("bzip2");
            }
            if ($bzip2) {
                $me->{UNGZIPPRG} = $bzip2 || "bzip2";
            } else {
                $CPAN::Frontend->mydie(qq{
CPAN.pm needs the external program bzip2 in order to handle '$file'.
Please install it now and run 'o conf init' to register it as external
program.
});
            }
        }
    } else {
        # yes, we let gzip figure it out in *any* other case
        $me->{UNGZIPPRG} = $CPAN::Config->{gzip} || "gzip";
    }
    bless $me, $class;
}

sub gzip {
    my($self,$read) = @_;
    my $write = $self->{FILE};
    if ($CPAN::META->has_inst("Compress::Zlib")) {
        my($buffer,$fhw);
        $fhw = FileHandle->new($read)
            or $CPAN::Frontend->mydie("Could not open $read: $!");
        my $cwd = `pwd`;
        my $gz = Compress::Zlib::gzopen($write, "wb")
            or $CPAN::Frontend->mydie("Cannot gzopen $write: $! (pwd is $cwd)\n");
        $gz->gzwrite($buffer)
            while read($fhw,$buffer,4096) > 0 ;
        $gz->gzclose() ;
        $fhw->close;
        return 1;
    } else {
        my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
        system(qq{$command -c "$read" > "$write"})==0;
    }
}


sub gunzip {
    my($self,$write) = @_;
    my $read = $self->{FILE};
    if ($CPAN::META->has_inst("Compress::Zlib")) {
        my($buffer,$fhw);
        $fhw = FileHandle->new(">$write")
            or $CPAN::Frontend->mydie("Could not open >$write: $!");
        my $gz = Compress::Zlib::gzopen($read, "rb")
            or $CPAN::Frontend->mydie("Cannot gzopen $read: $!\n");
        $fhw->print($buffer)
        while $gz->gzread($buffer) > 0 ;
        $CPAN::Frontend->mydie("Error reading from $read: $!\n")
            if $gz->gzerror != Compress::Zlib::Z_STREAM_END();
        $gz->gzclose() ;
        $fhw->close;
        return 1;
    } else {
        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") ) {
        my($buffer,$len);
        $len = 0;
        my $gz = Compress::Zlib::gzopen($read, "rb")
            or $CPAN::Frontend->mydie(sprintf("Cannot gzopen %s: %s\n",
                                              $read,
                                              $Compress::Zlib::gzerrno));
        while ($gz->gzread($buffer) > 0 ) {
            $len += length($buffer);
            $buffer = "";
        }
        my $err = $gz->gzerror;
        $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;
    } else {
        my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
        $success = 0==system(qq{$command -qdt "$read"});
    }
    return $self->{GTEST} = $success;
}


sub TIEHANDLE {
    my($class,$file) = @_;
    my $ret;
    $class->debug("file[$file]");
    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
            $CPAN::Frontend->mydie("Could not gzopen $file");
        $self->{GZ} = $gz;
        $class->debug("via Compress::Zlib");
    } else {
        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;
        $self->{FH} = $fh;
        $class->debug("via external gzip");
    }
    $self;
}


sub READLINE {
    my($self) = @_;
    if (exists $self->{GZ}) {
        my $gz = $self->{GZ};
        my($line,$bytesread);
        $bytesread = $gz->gzreadline($line);
        return undef if $bytesread <= 0;
        return $line;
    } else {
        my $fh = $self->{FH};
        return scalar <$fh>;
    }
}


sub READ {
    my($self,$ref,$length,$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
        return $byteread;
    } else {
        my $fh = $self->{FH};
        return read($fh,$$ref,$length);
    }
}


sub DESTROY {
    my($self) = @_;
    if (exists $self->{GZ}) {
        my $gz = $self->{GZ};
        $gz->gzclose() if defined $gz; # hard to say if it is allowed
                                       # to be undef ever. AK, 2000-09
    } else {
        my $fh = $self->{FH};
        $fh->close if defined $fh;
    }
    undef $self;
}


sub untar {
    my($self) = @_;
    my $file = $self->{FILE};
    my($prefer) = 0;

    if (0) { # makes changing order easier
    } elsif ($BUGHUNTING) {
        $prefer=2;
    } elsif (MM->maybe_command($self->{UNGZIPPRG})
             &&
             MM->maybe_command($CPAN::Config->{tar})) {
        # should be default until Archive::Tar handles bzip2
        $prefer = 1;
    } elsif (
             $CPAN::META->has_usable("Archive::Tar")
             &&
             $CPAN::META->has_inst("Compress::Zlib") ) {
        $prefer = 2;
    } else {
        $CPAN::Frontend->mydie(qq{
CPAN.pm needs either the external programs tar, gzip and bzip2
installed. Can't continue.
});
    }
    my $tar_verb = "v";
    if (defined $CPAN::Config->{tar_verbosity}) {
        $tar_verb = $CPAN::Config->{tar_verbosity} eq "none" ? "" :
            $CPAN::Config->{tar_verbosity};
    }
    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) {
            my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
            $system = qq{$command -dc }.
                qq{< "$file" | $tarcommand x${tar_verb}f -};
        } else {
            $system = qq{$tarcommand x${tar_verb}f "$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//;
                $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 = qq{$tarcommand x${tar_verb}f "$file"};
            $CPAN::Frontend->myprint(qq{Using Tar:$system:\n});
            if (system($system)==0) {
                $CPAN::Frontend->myprint(qq{Untarred $file successfully\n});
            } else {
                $CPAN::Frontend->mydie(qq{Couldn\'t untar $file\n});
            }
            return 1;
        } else {
            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;
        if ($BUGHUNTING) {
            # RCS 1.337 had this code, it turned out unacceptable slow but
            # it revealed a bug in Archive::Tar. Code is only here to hunt
            # the bug again. It should never be enabled in published code.
            # GDGraph3d-0.53 was an interesting case according to Larry
            # Virden.
            warn(">>>Bughunting code enabled<<< " x 20);
            for $af ($tar->list_files) {
                if ($af =~ m!^(/|\.\./)!) {
                    $CPAN::Frontend->mydie("ALERT: Archive contains ".
                                           "illegal member [$af]");
                }
                $CPAN::Frontend->myprint("$af\n");
                $tar->extract($af); # slow but effective for finding the bug
                return if $CPAN::Signal;
            }
        } else {
            for $af ($tar->list_files) {
                if ($af =~ m!^(/|\.\./)!) {
                    $CPAN::Frontend->mydie("ALERT: Archive contains ".
                                           "illegal member [$af]");
                }
                if ($tar_verb eq "v" || $tar_verb eq "vv") {
                    $CPAN::Frontend->myprint("$af\n");
                }
                push @af, $af;
                return if $CPAN::Signal;
            }
            $tar->extract(@af) or
                $CPAN::Frontend->mydie("Could not untar with Archive::Tar.");
        }

        Mac::BuildTools::convert_files([$tar->list_files], 1)
            if ($^O eq 'MacOS');

        return 1;
    }
}

sub unzip {
    my($self) = @_;
    my $file = $self->{FILE};
    if ($CPAN::META->has_inst("Archive::Zip")) {
        # blueprint of the code from Archive::Zip::Tree::extractTree();
        my $zip = Archive::Zip->new();
        my $status;
        $status = $zip->read($file);
        $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 ) {
            my $af = $member->fileName();
            if ($af =~ m!^(/|\.\./)!) {
                $CPAN::Frontend->mydie("ALERT: Archive contains ".
                                       "illegal member [$af]");
            }
            $status = $member->extractToFileNamed( $af );
            $CPAN::META->debug("af[$af]status[$status]") if $CPAN::DEBUG;
            $CPAN::Frontend->mydie("Extracting of file[$af] from zipfile[$file] failed\n") if
                $status != Archive::Zip::AZ_OK();
            return if $CPAN::Signal;
        }
        return 1;
    } else {
        my $unzip = $CPAN::Config->{unzip} or
            $CPAN::Frontend->mydie("Cannot unzip, no unzip program available");
        my @system = ($unzip, $file);
        return system(@system) == 0;
    }
}

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
Commit	Line	Data
547d3dfd	1	# -- Mode: cperl; coding: utf-8; cperl-indent-level: 4 --
e82b9348 SP	2	package CPAN::Tarzip;
	3	use strict;
	4	use vars qw($VERSION @ISA $BUGHUNTING);
	5	use CPAN::Debug;
0cf35e6a	6	use File::Basename ();
547d3dfd	7	$VERSION = sprintf "%.6f", substr(q$Rev: 2213 $,4)/1000000 + 5.4;
e82b9348 SP	8	# module is internal to CPAN.pm
	9
	10	@ISA = qw(CPAN::Debug);
2ccf00a7	11	$BUGHUNTING \|\|= 0; # released code must have turned off
e82b9348 SP	12
	13	# it's ok if file doesn't exist, it just matters if it is .gz or .bz2
	14	sub new {
547d3dfd SP	15	my($class,$file) = @_;
	16	$CPAN::Frontend->mydie("CPAN::Tarzip->new called without arg") unless defined $file;
	17	if (0) {
	18	# nonono, we get e.g. 01mailrc.txt uncompressed if only wget is available
	19	$CPAN::Frontend->mydie("file[$file] doesn't match /\\.(bz2\|gz\|zip\|tgz)\$/")
	20	unless $file =~ /\.(bz2\|gz\|zip\|tgz)$/i;
	21	}
	22	my $me = { FILE => $file };
	23	if (0) {
	24	} elsif ($file =~ /\.bz2$/i) {
	25	unless ($me->{UNGZIPPRG} = $CPAN::Config->{bzip2}) {
	26	my $bzip2;
	27	if ($CPAN::META->has_inst("File::Which")) {
	28	$bzip2 = File::Which::which("bzip2");
	29	}
	30	if ($bzip2) {
	31	$me->{UNGZIPPRG} = $bzip2 \|\| "bzip2";
	32	} else {
	33	$CPAN::Frontend->mydie(qq{
e82b9348 SP	34	CPAN.pm needs the external program bzip2 in order to handle '$file'.
	35	Please install it now and run 'o conf init' to register it as external
	36	program.
	37	});
547d3dfd SP	38	}
	39	}
	40	} else {
	41	# yes, we let gzip figure it out in any other case
	42	$me->{UNGZIPPRG} = $CPAN::Config->{gzip} \|\| "gzip";
e82b9348	43	}
547d3dfd	44	bless $me, $class;
e82b9348 SP	45	}
	46
	47	sub gzip {
547d3dfd SP	48	my($self,$read) = @_;
	49	my $write = $self->{FILE};
	50	if ($CPAN::META->has_inst("Compress::Zlib")) {
	51	my($buffer,$fhw);
	52	$fhw = FileHandle->new($read)
	53	or $CPAN::Frontend->mydie("Could not open $read: $!");
	54	my $cwd = `pwd`;
	55	my $gz = Compress::Zlib::gzopen($write, "wb")
	56	or $CPAN::Frontend->mydie("Cannot gzopen $write: $! (pwd is $cwd)\n");
	57	$gz->gzwrite($buffer)
	58	while read($fhw,$buffer,4096) > 0 ;
	59	$gz->gzclose() ;
	60	$fhw->close;
	61	return 1;
	62	} else {
	63	my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
	64	system(qq{$command -c "$read" > "$write"})==0;
	65	}
e82b9348 SP	66	}
	67
	68
	69	sub gunzip {
547d3dfd SP	70	my($self,$write) = @_;
	71	my $read = $self->{FILE};
	72	if ($CPAN::META->has_inst("Compress::Zlib")) {
	73	my($buffer,$fhw);
	74	$fhw = FileHandle->new(">$write")
	75	or $CPAN::Frontend->mydie("Could not open >$write: $!");
	76	my $gz = Compress::Zlib::gzopen($read, "rb")
	77	or $CPAN::Frontend->mydie("Cannot gzopen $read: $!\n");
	78	$fhw->print($buffer)
	79	while $gz->gzread($buffer) > 0 ;
	80	$CPAN::Frontend->mydie("Error reading from $read: $!\n")
	81	if $gz->gzerror != Compress::Zlib::Z_STREAM_END();
	82	$gz->gzclose() ;
	83	$fhw->close;
	84	return 1;
	85	} else {
	86	my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
	87	system(qq{$command -dc "$read" > "$write"})==0;
	88	}
e82b9348 SP	89	}
	90
	91
	92	sub gtest {
547d3dfd SP	93	my($self) = @_;
	94	return $self->{GTEST} if exists $self->{GTEST};
	95	defined $self->{FILE} or $CPAN::Frontend->mydie("gtest called but no FILE specified");
	96	my $read = $self->{FILE};
	97	my $success;
	98	# After I had reread the documentation in zlib.h, I discovered that
	99	# uncompressed files do not lead to an gzerror (anymore?).
	100	if ( $CPAN::META->has_inst("Compress::Zlib") ) {
	101	my($buffer,$len);
	102	$len = 0;
	103	my $gz = Compress::Zlib::gzopen($read, "rb")
	104	or $CPAN::Frontend->mydie(sprintf("Cannot gzopen %s: %s\n",
	105	$read,
	106	$Compress::Zlib::gzerrno));
	107	while ($gz->gzread($buffer) > 0 ) {
	108	$len += length($buffer);
	109	$buffer = "";
	110	}
	111	my $err = $gz->gzerror;
	112	$success = ! $err \|\| $err == Compress::Zlib::Z_STREAM_END();
	113	if ($len == -s $read) {
	114	$success = 0;
	115	CPAN->debug("hit an uncompressed file") if $CPAN::DEBUG;
	116	}
	117	$gz->gzclose();
	118	CPAN->debug("err[$err]success[$success]") if $CPAN::DEBUG;
	119	} else {
	120	my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
	121	$success = 0==system(qq{$command -qdt "$read"});
e82b9348	122	}
547d3dfd	123	return $self->{GTEST} = $success;
e82b9348 SP	124	}
	125
	126
	127	sub TIEHANDLE {
547d3dfd SP	128	my($class,$file) = @_;
	129	my $ret;
	130	$class->debug("file[$file]");
	131	my $self = $class->new($file);
	132	if (0) {
	133	} elsif (!$self->gtest) {
	134	my $fh = FileHandle->new($file)
	135	or $CPAN::Frontend->mydie("Could not open file[$file]: $!");
	136	binmode $fh;
	137	$self->{FH} = $fh;
	138	$class->debug("via uncompressed FH");
	139	} elsif ($CPAN::META->has_inst("Compress::Zlib")) {
	140	my $gz = Compress::Zlib::gzopen($file,"rb") or
	141	$CPAN::Frontend->mydie("Could not gzopen $file");
	142	$self->{GZ} = $gz;
	143	$class->debug("via Compress::Zlib");
	144	} else {
	145	my $gzip = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
	146	my $pipe = "$gzip -dc $file \|";
	147	my $fh = FileHandle->new($pipe) or $CPAN::Frontend->mydie("Could not pipe[$pipe]: $!");
	148	binmode $fh;
	149	$self->{FH} = $fh;
	150	$class->debug("via external gzip");
	151	}
	152	$self;
e82b9348 SP	153	}
	154
	155
	156	sub READLINE {
547d3dfd SP	157	my($self) = @_;
	158	if (exists $self->{GZ}) {
	159	my $gz = $self->{GZ};
	160	my($line,$bytesread);
	161	$bytesread = $gz->gzreadline($line);
	162	return undef if $bytesread <= 0;
	163	return $line;
	164	} else {
	165	my $fh = $self->{FH};
	166	return scalar <$fh>;
	167	}
e82b9348 SP	168	}
	169
	170
	171	sub READ {
547d3dfd SP	172	my($self,$ref,$length,$offset) = @_;
	173	$CPAN::Frontend->mydie("read with offset not implemented") if defined $offset;
	174	if (exists $self->{GZ}) {
	175	my $gz = $self->{GZ};
	176	my $byteread = $gz->gzread($$ref,$length);# 30eaf79e8b446ef52464b5422da328a8
	177	return $byteread;
	178	} else {
	179	my $fh = $self->{FH};
	180	return read($fh,$$ref,$length);
	181	}
e82b9348 SP	182	}
	183
	184
	185	sub DESTROY {
	186	my($self) = @_;
	187	if (exists $self->{GZ}) {
	188	my $gz = $self->{GZ};
	189	$gz->gzclose() if defined $gz; # hard to say if it is allowed
	190	# to be undef ever. AK, 2000-09
	191	} else {
	192	my $fh = $self->{FH};
	193	$fh->close if defined $fh;
	194	}
	195	undef $self;
	196	}
	197
	198
	199	sub untar {
547d3dfd SP	200	my($self) = @_;
	201	my $file = $self->{FILE};
	202	my($prefer) = 0;
e82b9348	203
547d3dfd SP	204	if (0) { # makes changing order easier
	205	} elsif ($BUGHUNTING) {
	206	$prefer=2;
	207	} elsif (MM->maybe_command($self->{UNGZIPPRG})
	208	&&
	209	MM->maybe_command($CPAN::Config->{tar})) {
	210	# should be default until Archive::Tar handles bzip2
	211	$prefer = 1;
	212	} elsif (
	213	$CPAN::META->has_usable("Archive::Tar")
	214	&&
	215	$CPAN::META->has_inst("Compress::Zlib") ) {
	216	$prefer = 2;
	217	} else {
	218	$CPAN::Frontend->mydie(qq{
e82b9348 SP	219	CPAN.pm needs either the external programs tar, gzip and bzip2
	220	installed. Can't continue.
	221	});
e82b9348	222	}
547d3dfd SP	223	my $tar_verb = "v";
	224	if (defined $CPAN::Config->{tar_verbosity}) {
	225	$tar_verb = $CPAN::Config->{tar_verbosity} eq "none" ? "" :
	226	$CPAN::Config->{tar_verbosity};
	227	}
	228	if ($prefer==1) { # 1 => external gzip+tar
	229	my($system);
	230	my $is_compressed = $self->gtest();
	231	my $tarcommand = CPAN::HandleConfig->safe_quote($CPAN::Config->{tar}) \|\| "tar";
	232	if ($is_compressed) {
	233	my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
	234	$system = qq{$command -dc }.
	235	qq{< "$file" \| $tarcommand x${tar_verb}f -};
e82b9348	236	} else {
547d3dfd	237	$system = qq{$tarcommand x${tar_verb}f "$file"};
e82b9348	238	}
547d3dfd SP	239	if (system($system) != 0) {
	240	# people find the most curious tar binaries that cannot handle
	241	# pipes
	242	if ($is_compressed) {
	243	(my $ungzf = $file) =~ s/\.gz(?!\n)\Z//;
	244	$ungzf = File::Basename::basename($ungzf);
	245	my $ct = CPAN::Tarzip->new($file);
	246	if ($ct->gunzip($ungzf)) {
	247	$CPAN::Frontend->myprint(qq{Uncompressed $file successfully\n});
	248	} else {
	249	$CPAN::Frontend->mydie(qq{Couldn\'t uncompress $file\n});
	250	}
	251	$file = $ungzf;
	252	}
	253	$system = qq{$tarcommand x${tar_verb}f "$file"};
	254	$CPAN::Frontend->myprint(qq{Using Tar:$system:\n});
	255	if (system($system)==0) {
	256	$CPAN::Frontend->myprint(qq{Untarred $file successfully\n});
	257	} else {
	258	$CPAN::Frontend->mydie(qq{Couldn\'t untar $file\n});
	259	}
	260	return 1;
	261	} else {
	262	return 1;
e82b9348	263	}
547d3dfd SP	264	} elsif ($prefer==2) { # 2 => modules
	265	unless ($CPAN::META->has_usable("Archive::Tar")) {
	266	$CPAN::Frontend->mydie("Archive::Tar not installed, please install it to continue");
	267	}
	268	my $tar = Archive::Tar->new($file,1);
	269	my $af; # archive file
	270	my @af;
	271	if ($BUGHUNTING) {
	272	# RCS 1.337 had this code, it turned out unacceptable slow but
	273	# it revealed a bug in Archive::Tar. Code is only here to hunt
	274	# the bug again. It should never be enabled in published code.
	275	# GDGraph3d-0.53 was an interesting case according to Larry
	276	# Virden.
	277	warn(">>>Bughunting code enabled<<< " x 20);
	278	for $af ($tar->list_files) {
	279	if ($af =~ m!^(/\|\.\./)!) {
	280	$CPAN::Frontend->mydie("ALERT: Archive contains ".
	281	"illegal member [$af]");
	282	}
	283	$CPAN::Frontend->myprint("$af\n");
	284	$tar->extract($af); # slow but effective for finding the bug
	285	return if $CPAN::Signal;
	286	}
	287	} else {
	288	for $af ($tar->list_files) {
	289	if ($af =~ m!^(/\|\.\./)!) {
	290	$CPAN::Frontend->mydie("ALERT: Archive contains ".
	291	"illegal member [$af]");
	292	}
	293	if ($tar_verb eq "v" \|\| $tar_verb eq "vv") {
	294	$CPAN::Frontend->myprint("$af\n");
	295	}
	296	push @af, $af;
	297	return if $CPAN::Signal;
	298	}
	299	$tar->extract(@af) or
	300	$CPAN::Frontend->mydie("Could not untar with Archive::Tar.");
e82b9348	301	}
e82b9348	302
547d3dfd SP	303	Mac::BuildTools::convert_files([$tar->list_files], 1)
547d3dfd SP	304	if ($^O eq 'MacOS');
e82b9348	305
547d3dfd SP	306	return 1;
547d3dfd SP	307	}
e82b9348 SP	308	}
	309
	310	sub unzip {
547d3dfd SP	311	my($self) = @_;
	312	my $file = $self->{FILE};
	313	if ($CPAN::META->has_inst("Archive::Zip")) {
	314	# blueprint of the code from Archive::Zip::Tree::extractTree();
	315	my $zip = Archive::Zip->new();
	316	my $status;
	317	$status = $zip->read($file);
	318	$CPAN::Frontend->mydie("Read of file[$file] failed\n")
	319	if $status != Archive::Zip::AZ_OK();
	320	$CPAN::META->debug("Successfully read file[$file]") if $CPAN::DEBUG;
	321	my @members = $zip->members();
	322	for my $member ( @members ) {
	323	my $af = $member->fileName();
	324	if ($af =~ m!^(/\|\.\./)!) {
	325	$CPAN::Frontend->mydie("ALERT: Archive contains ".
	326	"illegal member [$af]");
	327	}
	328	$status = $member->extractToFileNamed( $af );
	329	$CPAN::META->debug("af[$af]status[$status]") if $CPAN::DEBUG;
	330	$CPAN::Frontend->mydie("Extracting of file[$af] from zipfile[$file] failed\n") if
	331	$status != Archive::Zip::AZ_OK();
	332	return if $CPAN::Signal;
	333	}
	334	return 1;
	335	} else {
	336	my $unzip = $CPAN::Config->{unzip} or
	337	$CPAN::Frontend->mydie("Cannot unzip, no unzip program available");
	338	my @system = ($unzip, $file);
	339	return system(@system) == 0;
e82b9348	340	}
e82b9348 SP	341	}
	342
	343	1;
	344
26844e27 SP	345	__END__
	346
	347	=head1 LICENSE
	348
	349	This program is free software; you can redistribute it and/or
	350	modify it under the same terms as Perl itself.
	351
	352	=cut