| Subject: | Add API to chown a file. |
It would be nice to set the user and group of a file. Attached is a patch
to Archive::Tar and Archive::Tar::File which adds chown and adds some
tests.
Great package! I've learned a little bit of Perl looking at the elegant
code.
| Subject: | at.diff |
diff --git a/lib/Archive/Tar.pm b/lib/Archive/Tar.pm
index 0a35cf7..a9f4e45 100644
--- a/lib/Archive/Tar.pm
+++ b/lib/Archive/Tar.pm
@@ -68,6 +68,8 @@ Archive::Tar - module for manipulations of tar archives
$tar->add_data('file/baz.txt', 'This is the contents now');
$tar->rename('oldname', 'new/file/name');
+ $tar->chown('/', 'root');
+ $tar->chown('/', 'root:root');
$tar->write('files.tar'); # plain tar
$tar->write('files.tgz', COMPRESS_GZIP); # gzip compressed
@@ -1082,6 +1084,26 @@ sub rename {
return $entry->rename( $new );
}
+=head2 $tar->chown( $file, $uname [, $gname] )
+
+Change owner $file to $uname and $gname.
+
+Returns true on success and false on failure.
+
+=cut
+
+sub chown {
+ my $self = shift;
+ my $file = shift; return unless defined $file;
+ my $uname = shift; return unless defined $uname;
+ my @args = ($uname);
+ push(@args, shift);
+
+ my $entry = $self->_find_entry( $file ) or return;
+ my $x = $entry->chown( @args );
+ return $x;
+}
+
=head2 $tar->remove (@filenamelist)
Removes any entries with names matching any of the given filenames
diff --git a/lib/Archive/Tar/.gitignore b/lib/Archive/Tar/.gitignore
new file mode 100644
index 0000000..aeaec0f
--- /dev/null
+++ b/lib/Archive/Tar/.gitignore
@@ -0,0 +1 @@
+/*~
diff --git a/lib/Archive/Tar/File.pm b/lib/Archive/Tar/File.pm
index 8604ab8..b8f99e0 100644
--- a/lib/Archive/Tar/File.pm
+++ b/lib/Archive/Tar/File.pm
@@ -587,6 +587,32 @@ sub rename {
return 1;
}
+=head2 $bool = $file->chown( $user [, $group])
+
+Change owner of $file to $user. If a $group is given that is changed
+as well. You can also pass a single parameter with a colon separating the
+use and group as in 'root:wheel'.
+
+Returns true on success and false on failure.
+
+=cut
+
+sub chown {
+ my $self = shift;
+ my $uname = shift;
+ return unless defined $uname;
+ my $gname;
+ if (-1 != index($uname, ':')) {
+ ($uname, $gname) = split(/:/, $uname);
+ } else {
+ $gname = shift if @_ > 0;
+ }
+
+ $self->uname( $uname );
+ $self->gname( $gname ) if $gname;
+ return 1;
+}
+
=head1 Convenience methods
To quickly check the type of a C<Archive::Tar::File> object, you can
diff --git a/t/03_file.t b/t/03_file.t
index 33c1cf2..f01f6c9 100644
--- a/t/03_file.t
+++ b/t/03_file.t
@@ -1,5 +1,5 @@
### This program tests Archive::Tar::File ###
-
+use lib '../lib';
use Test::More 'no_plan';
use strict;
@@ -100,6 +100,11 @@ for my $f ( @test_files ) {
ok( $obj->get_content eq $contents, " get_content ok" );
ok( $obj->rename( $rename_path ), " rename ok" );
+ ok( $obj->chown( 'root' ), " chown 1 arg ok" );
+ is( $obj->uname, 'root', " chown to root ok" );
+ ok( $obj->chown( 'rocky', 'perl'), " chown 2 args ok" );
+ is( $obj->uname, 'rocky', " chown to rocky ok" );
+ is( $obj->gname, 'perl', " chown to rocky:perl ok" );
is( $obj->name, $rename_file, " name '$file' ok" );
is( $obj->prefix, $rename_dir, " prefix '$dir' ok" );
ok( $obj->rename( $unix_path ), " rename ok" );
diff --git a/t/04_resolved_issues.t b/t/04_resolved_issues.t
index 8e3cdba..1109fcb 100644
--- a/t/04_resolved_issues.t
+++ b/t/04_resolved_issues.t
@@ -110,9 +110,15 @@ use_ok( $FileClass );
ok( $tar->add_files( $in_file ),
" Added '$in_file'" );
+ ok( $tar->chown( $in_file, 'root' ),
+ " chown to root" );
+
+ ok( $tar->chown( $in_file, 'root', 'root' ),
+ " chown to root:root" );
+
ok( $tar->rename( $in_file, $out_file ),
" Renamed to '$out_file'" );
-
+
### first, test with strict extract permissions on
{ local $Archive::Tar::INSECURE_EXTRACT_MODE = 0;