| Subject: | Archive::Tar::write with filehandle as first argument treats filehandle as a filename |
Jos,
Thanks for all the work you've been doing with Archive::Tar over the
past couple of years. This module is looking a lot better these days!
I was noticing odd behavior on a Debian development system where I'm
using Archive::Tar, and I think I've narrowed it down to calls to
::write() where the first argument is a filehandle rather than a
filename. Basically on the upgrade from Debian's stable (ancient
Archive::Tar) to unstable (Archive::Tar 1.03) this functionality appears
to have broken.
I went ahead and pulled the most recent version (1.05) from CPAN,
reviewed the relevant subs (::write and ::_get_handle), and noticing no
difference ran a few tests. Here's a script log:
----------------------------------------------------------------------
Script started on Mon Oct 6 16:14:42 2003
~$ tar xvfz Archive-Tar-1.05.tar.gz
Archive-Tar-1.05/
Archive-Tar-1.05/lib/
Archive-Tar-1.05/lib/Archive/
Archive-Tar-1.05/lib/Archive/Tar/
Archive-Tar-1.05/lib/Archive/Tar/Constant.pm
Archive-Tar-1.05/lib/Archive/Tar/File.pm
Archive-Tar-1.05/lib/Archive/Tar.pm
Archive-Tar-1.05/Makefile.PL
Archive-Tar-1.05/MANIFEST
Archive-Tar-1.05/README
Archive-Tar-1.05/t/
Archive-Tar-1.05/t/01_use.t
Archive-Tar-1.05/t/02_methods.t
Archive-Tar-1.05/t/src/
Archive-Tar-1.05/t/src/long/
Archive-Tar-1.05/t/src/long/b
Archive-Tar-1.05/t/src/long/bar.tar
Archive-Tar-1.05/t/src/long/foo.tgz
Archive-Tar-1.05/t/src/short/
Archive-Tar-1.05/t/src/short/b
Archive-Tar-1.05/t/src/short/bar.tar
Archive-Tar-1.05/t/src/short/foo.tgz
~$ cd Archive-Tar-1.05
~/Archive-Tar-1.05$ perl Makefile.PL
Checking if your kit is complete...
Looks good
Writing Makefile for Archive::Tar
~/Archive-Tar-1.05$ make
cp lib/Archive/Tar/Constant.pm blib/lib/Archive/Tar/Constant.pm
cp lib/Archive/Tar.pm blib/lib/Archive/Tar.pm
cp lib/Archive/Tar/File.pm blib/lib/Archive/Tar/File.pm
Manifying blib/man3/Archive::Tar.3pm
Manifying blib/man3/Archive::Tar::File.3pm
~/Archive-Tar-1.05$ make test
PERL_DL_NONLAZY=1 /usr/bin/perl "-MExtUtils::Command::MM" "-e" "test_harness(0, 'blib/lib', 'blib/arch')" t/*.t
t/01_use........
t/01_use........ok 1/2
t/01_use........ok 2/2
t/01_use........ok
t/02_methods....
t/02_methods....ok 1/0
[...]
t/02_methods....ok 68/0
t/02_methods....ok 69/0
t/02_methods....ok
All tests successful.
Files=2, Tests=71, 0 wallclock secs ( 0.36 cusr + 0.01 csys = 0.37 CPU)
~/Archive-Tar-1.05$ PERL5LIB=./lib perl -MArchive::Tar -e 'print $Archive::Tar::VERSION."\n";'
1.05
~/Archive-Tar-1.05$ PERL5LIB=./lib perl -MArchive::Tar -MFile::Temp -e '$tar = new Archive::Tar(); ($handle, $filename) = File::Temp::tempfile(); print $filename."\n"; $tar->write($handle, "/home/rick/Archive-Tar-1.05.tar.gz") or print "failed!"; close($handle);'
/tmp/hentr8SRng
~/Archive-Tar-1.05$ ls -al /tmp/hentr8SRng
-rw------- 1 rick rick 0 Oct 6 16:16 /tmp/hentr8SRng
Script done on Mon Oct 6 16:17:02 2003
----------------------------------------------------------------------
I can often find a file named 'GLOB(######)' lying about where
Archive::Tar has actually stored its results (having used the string
flattening of the IO::File reference as a filename to open()), though
for this particular case I didn't find one. Looking at the code in
question in Archive::Tar I see the following:
sub _get_handle {
my $self = shift;
my $file = shift; return unless defined $file;
my $gzip = shift || 0;
my $mode = shift || READ_ONLY->($gzip); # default to read only
my $fh;
### only default to ZLIB if we're not trying to /write/ to a handle ###
if( ZLIB and $gzip || MODE_READ->( $mode ) ) {
### IO::Zlib will Do The Right Thing, even when passed a plain file ###
$fh = new IO::Zlib;
} else {
if( $gzip ) {
$self->_error( qq[Compression not available - Install IO::Zlib!] );
return;
} else {
$fh = new IO::File;
}
}
unless( $fh->open( $file, $mode ) ) {
$self->_error( qq[Could not create filehandle for '$file': $!!] );
return;
}
return $fh;
}
sub write {
my $self = shift;
my $file = shift || '';
my $gzip = shift || 0;
my $prefix = shift || '';
### only need a handle if we have a file to print to ###
my $handle = $file
? ( $self->_get_handle($file, $gzip, WRITE_ONLY->($gzip) )
or return )
: '';
[...]
if( $file ) {
unless( $self->_write_to_handle( $handle, $longlink, $prefix ) ) {
$self->_error( qq[Could not write 'LongLink' entry for oversize file '] . $entry->name ."'" );
return;
}
} else {
[...]
if( $file ) {
unless( $self->_write_to_handle( $handle, $entry, $prefix ) ) {
$self->_error( qq[Could not write entry '] . $entry->name . qq[' to archive] );
return;
}
[...]
if( $file ) {
print $handle TAR_END x 2 or (
$self->_error( qq[Could not write tar end markers] ),
return
);
} else {
Which looks like there's no provision for actually detecting whether
$file is a filehandle (a simple "ref($file)" would suffice). The
$fh->open() in ::_get_handle would need to be skipped in such a case (at
least).
I think this would suffice as a patch (modulo coding style):
----------------------------------------------------------------------
diff -u -r Archive-Tar-1.05/lib/Archive/Tar.pm Archive-Tar-1.05-patched/lib/Archive/Tar.pm
--- Archive-Tar-1.05/lib/Archive/Tar.pm 2003-08-22 18:35:10.000000000 -0500
+++ Archive-Tar-1.05-patched/lib/Archive/Tar.pm 2003-10-06 16:41:46.000000000 -0500
@@ -159,6 +159,7 @@
sub _get_handle {
my $self = shift;
my $file = shift; return unless defined $file;
+ return $file if ref($file);
my $gzip = shift || 0;
my $mode = shift || READ_ONLY->($gzip); # default to read only
----------------------------------------------------------------------
Testing this patch on my problem Debian system fixes the problem. It
should suffice to use IO::File() to generate the filehandle for unit
testing -- I used File::Temp since it's what I'm using in my library
code.
Here's my 'perl -V':
Summary of my perl5 (revision 5.0 version 8 subversion 0) configuration:
Platform:
osname=linux, osvers=2.4.20-xfs+ti1211, archname=i386-linux-thread-multi
uname='linux kosh 2.4.20-xfs+ti1211 #1 sat nov 30 19:19:08 est 2002 i686 gnulinux '
config_args='-Dusethreads -Duselargefiles -Dccflags=-DDEBIAN -Dcccdlflags=-fPIC -Darchname=i386-linux -Dprefix=/usr -Dprivlib=/usr/share/perl/5.8.0 -Darchlib=/usr/lib/perl/5.8.0 -Dvendorpref
ix=/usr -Dvendorlib=/usr/share/perl5 -Dvendorarch=/usr/lib/perl5 -Dsiteprefix=/usr/local -Dsitelib=/usr/local/share/perl/5.8.0 -Dsitearch=/usr/local/lib/perl/5.8.0 -Dman1dir=/usr/share/man/man1
-Dman3dir=/usr/share/man/man3 -Dman1ext=1 -Dman3ext=3perl -Dpager=/usr/bin/sensible-pager -Uafs -Ud_csh -Uusesfio -Uusenm -Duseshrplib -Dlibperl=libperl.so.5.8.0 -Dd_dosuid -des'
hint=recommended, useposix=true, d_sigaction=define
usethreads=define use5005threads=undef useithreads=define usemultiplicity=define
useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
use64bitint=undef use64bitall=undef uselongdouble=undef
usemymalloc=n, bincompat5005=undef
Compiler:
cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fno-strict-aliasing -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
optimize='-O3',
cppflags='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fno-strict-aliasing'
ccversion='', gccversion='3.3 (Debian)', gccosandvers=''
intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
alignbytes=4, prototype=define
Linker and Libraries:
ld='cc', ldflags =' -L/usr/local/lib'
libpth=/usr/local/lib /lib /usr/lib
libs=-lgdbm -ldb -ldl -lm -lpthread -lc -lcrypt
perllibs=-ldl -lm -lpthread -lc -lcrypt
libc=/lib/libc-2.3.1.so, so=so, useshrplib=true, libperl=libperl.so.5.8.0
gnulibc_version='2.3.1'
Dynamic Linking:
dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-rdynamic'
cccdlflags='-fPIC', lddlflags='-shared -L/usr/local/lib'
Characteristics of this binary (from libperl):
Compile-time options: MULTIPLICITY USE_ITHREADS USE_LARGE_FILES PERL_IMPLICIT_CONTEXT
Built under linux
Compiled at Jun 5 2003 23:33:07
@INC:
/etc/perl
/usr/local/lib/perl/5.8.0
/usr/local/share/perl/5.8.0
/usr/lib/perl5
/usr/share/perl5
/usr/lib/perl/5.8.0
/usr/share/perl/5.8.0
/usr/local/lib/site_perl
.
Thanks,
Rick
--
http://www.rickbradley.com MUPRN: 315
| very last sheet. There
random email haiku | was no end to the places
| "shmily" would pop up.
diff -u -r Archive-Tar-1.05/lib/Archive/Tar.pm Archive-Tar-1.05-patched/lib/Archive/Tar.pm
--- Archive-Tar-1.05/lib/Archive/Tar.pm 2003-08-22 18:35:10.000000000 -0500
+++ Archive-Tar-1.05-patched/lib/Archive/Tar.pm 2003-10-06 16:41:46.000000000 -0500
@@ -159,6 +159,7 @@
sub _get_handle {
my $self = shift;
my $file = shift; return unless defined $file;
+ return $file if ref($file);
my $gzip = shift || 0;
my $mode = shift || READ_ONLY->($gzip); # default to read only