diff options
Diffstat (limited to 'cpan/Archive-Tar/lib/Archive/Tar')
| -rw-r--r-- | cpan/Archive-Tar/lib/Archive/Tar/Constant.pm | 14 | ||||
| -rw-r--r-- | cpan/Archive-Tar/lib/Archive/Tar/File.pm | 50 |
2 files changed, 45 insertions, 19 deletions
diff --git a/cpan/Archive-Tar/lib/Archive/Tar/Constant.pm b/cpan/Archive-Tar/lib/Archive/Tar/Constant.pm index abeb824a05..7a25f33412 100644 --- a/cpan/Archive-Tar/lib/Archive/Tar/Constant.pm +++ b/cpan/Archive-Tar/lib/Archive/Tar/Constant.pm @@ -2,8 +2,8 @@ package Archive::Tar::Constant; BEGIN { require Exporter; - - $VERSION = '1.76'; + + $VERSION = '1.78'; @ISA = qw[Exporter]; require Time::Local if $^O eq "MacOS"; @@ -56,7 +56,7 @@ use constant PACK => 'a100 a8 a8 a8 a12 a12 A8 a1 a100 a6 a2 a32 a32 a use constant NAME_LENGTH => 100; use constant PREFIX_LENGTH => 155; -use constant TIME_OFFSET => ($^O eq "MacOS") ? Time::Local::timelocal(0,0,0,1,0,70) : 0; +use constant TIME_OFFSET => ($^O eq "MacOS") ? Time::Local::timelocal(0,0,0,1,0,70) : 0; use constant MAGIC => "ustar"; use constant TAR_VERSION => "00"; use constant LONGLINK_NAME => '././@LongLink'; @@ -65,14 +65,14 @@ use constant PAX_HEADER => 'pax_global_header'; ### allow ZLIB to be turned off using ENV: DEBUG only use constant ZLIB => do { !$ENV{'PERL5_AT_NO_ZLIB'} and eval { require IO::Zlib }; - $ENV{'PERL5_AT_NO_ZLIB'} || $@ ? 0 : 1 + $ENV{'PERL5_AT_NO_ZLIB'} || $@ ? 0 : 1 }; - ### allow BZIP to be turned off using ENV: DEBUG only + ### allow BZIP to be turned off using ENV: DEBUG only use constant BZIP => do { !$ENV{'PERL5_AT_NO_BZIP'} and eval { require IO::Uncompress::Bunzip2; require IO::Compress::Bzip2; }; - $ENV{'PERL5_AT_NO_BZIP'} || $@ ? 0 : 1 + $ENV{'PERL5_AT_NO_BZIP'} || $@ ? 0 : 1 }; use constant GZIP_MAGIC_NUM => qr/^(?:\037\213|\037\235)/; @@ -81,6 +81,6 @@ use constant BZIP_MAGIC_NUM => qr/^BZh\d/; use constant CAN_CHOWN => sub { ($> == 0 and $^O ne "MacOS" and $^O ne "MSWin32") }; use constant CAN_READLINK => ($^O ne 'MSWin32' and $^O !~ /RISC(?:[ _])?OS/i and $^O ne 'VMS'); use constant ON_UNIX => ($^O ne 'MSWin32' and $^O ne 'MacOS' and $^O ne 'VMS'); -use constant ON_VMS => $^O eq 'VMS'; +use constant ON_VMS => $^O eq 'VMS'; 1; diff --git a/cpan/Archive-Tar/lib/Archive/Tar/File.pm b/cpan/Archive-Tar/lib/Archive/Tar/File.pm index 8604ab8324..b7000904fa 100644 --- a/cpan/Archive-Tar/lib/Archive/Tar/File.pm +++ b/cpan/Archive-Tar/lib/Archive/Tar/File.pm @@ -13,7 +13,7 @@ use Archive::Tar::Constant; use vars qw[@ISA $VERSION]; #@ISA = qw[Archive::Tar]; -$VERSION = '1.76'; +$VERSION = '1.78'; ### set value to 1 to oct() it during the unpack ### my $tmpl = [ @@ -236,23 +236,23 @@ sub _new_from_chunk { sub _new_from_file { my $class = shift; - my $path = shift; - + my $path = shift; + ### path has to at least exist return unless defined $path; - + my $type = __PACKAGE__->_filetype($path); my $data = ''; - READ: { + READ: { unless ($type == DIR ) { my $fh = IO::File->new; - + unless( $fh->open($path) ) { ### dangling symlinks are fine, stop reading but continue ### creating the object last READ if $type == SYMLINK; - + ### otherwise, return from this function -- ### anything that's *not* a symlink should be ### resolvable @@ -405,7 +405,7 @@ sub _prefix_and_file { sub _filetype { my $self = shift; my $file = shift; - + return unless defined $file; return SYMLINK if (-l $file); # Symlink @@ -442,7 +442,7 @@ sub _downgrade_to_plainfile { =head2 $bool = $file->extract( [ $alternative_name ] ) -Extract this object, optionally to an alternative name. +Extract this object, optionally to an alternative name. See C<< Archive::Tar->extract_file >> for details. @@ -452,9 +452,9 @@ Returns true on success and false on failure. sub extract { my $self = shift; - + local $Carp::CarpLevel += 1; - + return Archive::Tar->_extract_file( $self, @_ ); } @@ -576,7 +576,7 @@ Returns true on success and false on failure. sub rename { my $self = shift; my $path = shift; - + return unless defined $path; my ($prefix,$file) = $self->_prefix_and_file( $path ); @@ -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 |