Permalink
Browse files

Added GNU tar check is_gnu() and tar_gnu_read_options to specify options

like --numeric-owner.
  • Loading branch information...
1 parent a2cc104 commit 71e90a6daa4e06d79cbd617ff5c3ae6537fa712d @mschilli committed Feb 2, 2010
Showing with 88 additions and 13 deletions.
  1. +4 −0 .gitignore
  2. +4 −0 Changes
  3. +1 −0 MANIFEST.SKIP
  4. +28 −2 README
  5. +36 −10 lib/Archive/Tar/Wrapper.pm
  6. +15 −1 t/001Basic.t
View
@@ -0,0 +1,4 @@
+MANIFEST.bak
+Makefile
+blib
+pm_to_blib
View
@@ -1,6 +1,10 @@
######################################################################
Revision history for Perl extension Archive::Tar::Wrapper
+0.13 2010/02/01
+ (ms) Added GNU tar check is_gnu()
+ (ms) Added tar_gnu_read_options to specify options like --numeric-owner
+
0.12 2008/07/03
(ms) Applied modified patch by Daniel Barthel to enable more
files added to a tarball than there are allowed on the command
View
@@ -6,3 +6,4 @@ CVS
docs
MANIFEST.bak
adm/release
+.git
View
@@ -1,5 +1,5 @@
######################################################################
- Archive::Tar::Wrapper 0.11
+ Archive::Tar::Wrapper 0.13
######################################################################
NAME
@@ -75,7 +75,12 @@ METHODS
);
will use "tar xfp archive.tgz" to extract the tarball instead of
- just "tar xf archive.tgz".
+ just "tar xf archive.tgz". Gnu tar supports even more options, these
+ can be passed in via
+
+ my $arch = Archive::Tar::Wrapper->new(
+ tar_gnu_read_options => ["--numeric-owner"],
+ );
By default, the "list_*()" functions will return only file entries.
Directories will be suppressed. To have "list_*()" return
@@ -85,6 +90,23 @@ METHODS
dirs => 1
);
+ If more files are added to a tarball than the command line can
+ handle, "Archive::Tar::Wrapper" will switch from using the command
+
+ tar cfv tarfile file1 file2 file3 ...
+
+ to
+
+ tar cfv tarfile -T filelist
+
+ where "filelist" is a file containing all file to be added. The
+ default for this switch is 512, but it can be changed by setting the
+ parameter "max_cmd_line_args":
+
+ my $arch = Archive::Tar::Wrapper->new(
+ max_cmd_line_args => 1024
+ );
+
$arch->read("archive.tgz")
"read()" opens the given tarball, expands it into a temporary
directory and returns 1 on success und "undef" on failure. The
@@ -176,6 +198,10 @@ METHODS
mass-manipulating unpacked files before wrapping them back up into
the tarball.
+ $arch->is_gnu()
+ Checks if the tar executable is a GNU tar by running 'tar --version'
+ and parsing the output for "GNU".
+
KNOWN LIMITATIONS
* Currently, only "tar" programs supporting the "z" option (for
compressing/decompressing) are supported. Future version will use
@@ -19,20 +19,21 @@ use File::Basename;
use IPC::Run qw(run);
use Cwd;
-our $VERSION = "0.12";
+our $VERSION = "0.13";
###########################################
sub new {
###########################################
my($class, %options) = @_;
my $self = {
- tar => undef,
- tmpdir => undef,
- tar_read_options => '',
- tar_write_options => '',
- dirs => 0,
- max_cmd_line_args => 512,
+ tar => undef,
+ tmpdir => undef,
+ tar_read_options => '',
+ tar_write_options => '',
+ tar_gnu_read_options => [],
+ dirs => 0,
+ max_cmd_line_args => 512,
%options,
};
@@ -75,8 +76,9 @@ sub read {
my $compr_opt = "";
$compr_opt = "z" if $self->is_compressed($tarfile);
- my $cmd = [$self->{tar}, "${compr_opt}xf$self->{tar_read_options}",
- $tarfile, @files];
+ my $cmd = [$self->{tar}, "${compr_opt}x$self->{tar_read_options}",
+ @{$self->{tar_gnu_read_options}},
+ "-f", $tarfile, @files];
DEBUG "Running @$cmd";
@@ -393,6 +395,20 @@ sub bin_find {
return undef;
}
+###########################################
+sub is_gnu {
+###########################################
+ my($self) = @_;
+
+ open PIPE, "$self->{tar} --version |" or
+ return 0;
+
+ my $output = join "\n", <PIPE>;
+ close PIPE;
+
+ return $output =~ /GNU/;
+}
+
1;
__END__
@@ -485,7 +501,12 @@ C<tar_read_options> and C<tar_write_options> parameters. Example:
);
will use C<tar xfp archive.tgz> to extract the tarball instead of just
-C<tar xf archive.tgz>.
+C<tar xf archive.tgz>. Gnu tar supports even more options, these can
+be passed in via
+
+ my $arch = Archive::Tar::Wrapper->new(
+ tar_gnu_read_options => ["--numeric-owner"],
+ );
By default, the C<list_*()> functions will return only file entries.
Directories will be suppressed. To have C<list_*()>
@@ -610,6 +631,11 @@ Return the directory the tarball was unpacked in. This is sometimes useful
to play dirty tricks on C<Archive::Tar::Wrapper> by mass-manipulating
unpacked files before wrapping them back up into the tarball.
+=item B<$arch-E<gt>is_gnu()>
+
+Checks if the tar executable is a GNU tar by running 'tar --version'
+and parsing the output for "GNU".
+
=back
=head1 KNOWN LIMITATIONS
View
@@ -13,7 +13,7 @@ use File::Temp qw(tempfile);
my $TARDIR = "data";
$TARDIR = "t/$TARDIR" unless -d $TARDIR;
-use Test::More tests => 22;
+use Test::More tests => 23;
BEGIN { use_ok('Archive::Tar::Wrapper') };
umask(0);
@@ -117,3 +117,17 @@ $f1 = $a5->locate("bar/bar.dat");
$perm = ((stat($f1))[2] & 07777);
is($perm, 0664, "permtest");
+
+SKIP: {
+ # gnu options
+ my $a6 = Archive::Tar::Wrapper->new(
+ tar_gnu_read_options => ["--numeric-owner"],
+ );
+
+ skip "Only with gnu tar", 1 unless $a6->is_gnu();
+
+ $a6->read("$TARDIR/bar.tar");
+ $f1 = $a6->locate("bar/bar.dat");
+
+ ok(defined $f1, "numeric owner works");
+}

0 comments on commit 71e90a6

Please sign in to comment.