[p5sagit/p5-mst-13.2.git] / lib / CPAN / Tarzip.pm

# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 2 -*-
package CPAN::Tarzip;
use strict;
use vars qw($VERSION @ISA $BUGHUNTING);
use CPAN::Debug;
use File::Basename ();
$VERSION = sprintf "%.6f", substr(q$Rev: 1525 $,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("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.
});
  }
  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 xvf -};
    } else {
      $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//;
        $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 xvf "$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]");
        }
        $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
e82b9348	1	# -- Mode: cperl; coding: utf-8; cperl-indent-level: 2 --
	2	package CPAN::Tarzip;
	3	use strict;
	4	use vars qw($VERSION @ISA $BUGHUNTING);
	5	use CPAN::Debug;
0cf35e6a	6	use File::Basename ();
f20de9f0	7	$VERSION = sprintf "%.6f", substr(q$Rev: 1525 $,4)/1000000 + 5.4;
e82b9348	8	# module is internal to CPAN.pm
	9
	10	@ISA = qw(CPAN::Debug);
2ccf00a7	11	$BUGHUNTING \|\|= 0; # released code must have turned off
e82b9348	12
	13	# it's ok if file doesn't exist, it just matters if it is .gz or .bz2
	14	sub new {
	15	my($class,$file) = @_;
0cf35e6a	16	$CPAN::Frontend->mydie("new called without arg") unless defined $file;
1a43333d	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	}
e82b9348	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) {
ed84aac9	31	$me->{UNGZIPPRG} = $bzip2 \|\| "bzip2";
e82b9348	32	} else {
	33	$CPAN::Frontend->mydie(qq{
	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	});
	38	}
	39	}
	40	} else {
	41	# yes, we let gzip figure it out in any other case
ed84aac9	42	$me->{UNGZIPPRG} = $CPAN::Config->{gzip} \|\| "gzip";
e82b9348	43	}
	44	bless $me, $class;
	45	}
	46
	47	sub gzip {
	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 {
ed84aac9	63	my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
ed84aac9	64	system(qq{$command -c "$read" > "$write"})==0;
e82b9348	65	}
	66	}
	67
	68
	69	sub gunzip {
	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 {
ed84aac9	86	my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
ed84aac9	87	system(qq{$command -dc "$read" > "$write"})==0;
e82b9348	88	}
	89	}
	90
	91
	92	sub gtest {
	93	my($self) = @_;
87892b73	94	return $self->{GTEST} if exists $self->{GTEST};
be34b10d	95	defined $self->{FILE} or $CPAN::Frontend->mydie("gtest called but no FILE specified");
be34b10d	96	my $read = $self->{FILE};
87892b73	97	my $success;
e82b9348	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;
87892b73	112	$success = ! $err \|\| $err == Compress::Zlib::Z_STREAM_END();
e82b9348	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;
e82b9348	119	} else {
ed84aac9	120	my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
ed84aac9	121	$success = 0==system(qq{$command -qdt "$read"});
e82b9348	122	}
87892b73	123	return $self->{GTEST} = $success;
e82b9348	124	}
	125
	126
	127	sub TIEHANDLE {
	128	my($class,$file) = @_;
	129	my $ret;
	130	$class->debug("file[$file]");
87892b73	131	my $self = $class->new($file);
	132	if (0) {
	133	} elsif (!$self->gtest) {
be34b10d	134	my $fh = FileHandle->new($file)
be34b10d	135	or $CPAN::Frontend->mydie("Could not open file[$file]: $!");
87892b73	136	binmode $fh;
87892b73	137	$self->{FH} = $fh;
7d97ad34	138	$class->debug("via uncompressed FH");
87892b73	139	} elsif ($CPAN::META->has_inst("Compress::Zlib")) {
e82b9348	140	my $gz = Compress::Zlib::gzopen($file,"rb") or
be34b10d	141	$CPAN::Frontend->mydie("Could not gzopen $file");
87892b73	142	$self->{GZ} = $gz;
7d97ad34	143	$class->debug("via Compress::Zlib");
e82b9348	144	} else {
ed84aac9	145	my $gzip = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
ed84aac9	146	my $pipe = "$gzip -dc $file \|";
be34b10d	147	my $fh = FileHandle->new($pipe) or $CPAN::Frontend->mydie("Could not pipe[$pipe]: $!");
e82b9348	148	binmode $fh;
87892b73	149	$self->{FH} = $fh;
7d97ad34	150	$class->debug("via external gzip");
e82b9348	151	}
87892b73	152	$self;
e82b9348	153	}
	154
	155
	156	sub READLINE {
	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	}
	168	}
	169
	170
	171	sub READ {
	172	my($self,$ref,$length,$offset) = @_;
be34b10d	173	$CPAN::Frontend->mydie("read with offset not implemented") if defined $offset;
e82b9348	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	}
	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 {
	200	my($self) = @_;
	201	my $file = $self->{FILE};
	202	my($prefer) = 0;
	203
	204	if (0) { # makes changing order easier
	205	} elsif ($BUGHUNTING){
	206	$prefer=2;
	207	} elsif (MM->maybe_command($self->{UNGZIPPRG})
	208	&&
ed84aac9	209	MM->maybe_command($CPAN::Config->{tar})) {
e82b9348	210	# should be default until Archive::Tar handles bzip2
	211	$prefer = 1;
	212	} elsif (
f20de9f0	213	$CPAN::META->has_usable("Archive::Tar")
e82b9348	214	&&
e82b9348	215	$CPAN::META->has_inst("Compress::Zlib") ) {
e82b9348	216	$prefer = 2;
	217	} else {
	218	$CPAN::Frontend->mydie(qq{
	219	CPAN.pm needs either the external programs tar, gzip and bzip2
	220	installed. Can't continue.
	221	});
	222	}
	223	if ($prefer==1) { # 1 => external gzip+tar
	224	my($system);
	225	my $is_compressed = $self->gtest();
ed84aac9	226	my $tarcommand = CPAN::HandleConfig->safe_quote($CPAN::Config->{tar}) \|\| "tar";
e82b9348	227	if ($is_compressed) {
ed84aac9	228	my $command = CPAN::HandleConfig->safe_quote($self->{UNGZIPPRG});
	229	$system = qq{$command -dc }.
	230	qq{< "$file" \| $tarcommand xvf -};
e82b9348	231	} else {
ed84aac9	232	$system = qq{$tarcommand xvf "$file"};
e82b9348	233	}
	234	if (system($system) != 0) {
	235	# people find the most curious tar binaries that cannot handle
	236	# pipes
	237	if ($is_compressed) {
	238	(my $ungzf = $file) =~ s/\.gz(?!\n)\Z//;
0cf35e6a	239	$ungzf = File::Basename::basename($ungzf);
	240	my $ct = CPAN::Tarzip->new($file);
	241	if ($ct->gunzip($ungzf)) {
e82b9348	242	$CPAN::Frontend->myprint(qq{Uncompressed $file successfully\n});
	243	} else {
	244	$CPAN::Frontend->mydie(qq{Couldn\'t uncompress $file\n});
	245	}
	246	$file = $ungzf;
	247	}
ed84aac9	248	$system = qq{$tarcommand xvf "$file"};
e82b9348	249	$CPAN::Frontend->myprint(qq{Using Tar:$system:\n});
	250	if (system($system)==0) {
	251	$CPAN::Frontend->myprint(qq{Untarred $file successfully\n});
	252	} else {
	253	$CPAN::Frontend->mydie(qq{Couldn\'t untar $file\n});
	254	}
	255	return 1;
	256	} else {
	257	return 1;
	258	}
	259	} elsif ($prefer==2) { # 2 => modules
f20de9f0	260	unless ($CPAN::META->has_usable("Archive::Tar")) {
2ccf00a7	261	$CPAN::Frontend->mydie("Archive::Tar not installed, please install it to continue");
2ccf00a7	262	}
e82b9348	263	my $tar = Archive::Tar->new($file,1);
	264	my $af; # archive file
	265	my @af;
	266	if ($BUGHUNTING) {
	267	# RCS 1.337 had this code, it turned out unacceptable slow but
	268	# it revealed a bug in Archive::Tar. Code is only here to hunt
	269	# the bug again. It should never be enabled in published code.
	270	# GDGraph3d-0.53 was an interesting case according to Larry
	271	# Virden.
	272	warn(">>>Bughunting code enabled<<< " x 20);
	273	for $af ($tar->list_files) {
	274	if ($af =~ m!^(/\|\.\./)!) {
	275	$CPAN::Frontend->mydie("ALERT: Archive contains ".
	276	"illegal member [$af]");
	277	}
	278	$CPAN::Frontend->myprint("$af\n");
	279	$tar->extract($af); # slow but effective for finding the bug
	280	return if $CPAN::Signal;
	281	}
	282	} else {
	283	for $af ($tar->list_files) {
	284	if ($af =~ m!^(/\|\.\./)!) {
	285	$CPAN::Frontend->mydie("ALERT: Archive contains ".
	286	"illegal member [$af]");
	287	}
	288	$CPAN::Frontend->myprint("$af\n");
	289	push @af, $af;
	290	return if $CPAN::Signal;
	291	}
0cf35e6a	292	$tar->extract(@af) or
0cf35e6a	293	$CPAN::Frontend->mydie("Could not untar with Archive::Tar.");
e82b9348	294	}
	295
	296	Mac::BuildTools::convert_files([$tar->list_files], 1)
	297	if ($^O eq 'MacOS');
	298
	299	return 1;
	300	}
	301	}
	302
	303	sub unzip {
	304	my($self) = @_;
	305	my $file = $self->{FILE};
	306	if ($CPAN::META->has_inst("Archive::Zip")) {
	307	# blueprint of the code from Archive::Zip::Tree::extractTree();
	308	my $zip = Archive::Zip->new();
	309	my $status;
	310	$status = $zip->read($file);
be34b10d	311	$CPAN::Frontend->mydie("Read of file[$file] failed\n")
be34b10d	312	if $status != Archive::Zip::AZ_OK();
e82b9348	313	$CPAN::META->debug("Successfully read file[$file]") if $CPAN::DEBUG;
	314	my @members = $zip->members();
	315	for my $member ( @members ) {
	316	my $af = $member->fileName();
	317	if ($af =~ m!^(/\|\.\./)!) {
	318	$CPAN::Frontend->mydie("ALERT: Archive contains ".
	319	"illegal member [$af]");
	320	}
	321	$status = $member->extractToFileNamed( $af );
	322	$CPAN::META->debug("af[$af]status[$status]") if $CPAN::DEBUG;
be34b10d	323	$CPAN::Frontend->mydie("Extracting of file[$af] from zipfile[$file] failed\n") if
e82b9348	324	$status != Archive::Zip::AZ_OK();
	325	return if $CPAN::Signal;
	326	}
	327	return 1;
	328	} else {
	329	my $unzip = $CPAN::Config->{unzip} or
	330	$CPAN::Frontend->mydie("Cannot unzip, no unzip program available");
	331	my @system = ($unzip, $file);
	332	return system(@system) == 0;
	333	}
	334	}
	335
	336	1;
	337
26844e27	338	__END__
	339
	340	=head1 LICENSE
	341
	342	This program is free software; you can redistribute it and/or
	343	modify it under the same terms as Perl itself.
	344
	345	=cut