Archive-Ar
view release on metacpan or search on metacpan
my $ar = Archive::Ar->new;
$ar->read('./foo.ar');
$ar->extract;
$ar->add_files('./bar.tar.gz', 'bat.pl')
$ar->add_data('newfile.txt','Some contents');
$ar->chmod('file1', 0644);
$ar->chown('file1', $uid, $gid);
$ar->remove('file1', 'file2');
my $filehash = $ar->get_content('bar.tar.gz');
my $data = $ar->get_data('bar.tar.gz');
my $handle = $ar->get_handle('bar.tar.gz');
my @files = $ar->list_files();
my $archive = $ar->write;
lib/Archive/Ar.pm view on Meta::CPAN
my $filename = shift;
my $target = shift || $filename;
my $meta = $self->{files}->{$filename};
return $self->_error("$filename: not in archive") unless $meta;
open my $fh, '>', $target or return $self->_error("$target: $!");
binmode $fh;
syswrite $fh, $meta->{data} or return $self->_error("$filename: $!");
close $fh or return $self->_error("$filename: $!");
if (CAN_CHOWN && $self->{opts}->{chown}) {
chown $meta->{uid}, $meta->{gid}, $filename or
return $self->_error("$filename: $!");
}
if ($self->{opts}->{chmod}) {
my $mode = $meta->{mode};
unless ($self->{opts}->{same_perms}) {
$mode &= ~(oct(7000) | (umask | 0));
}
chmod $mode, $filename or return $self->_error("$filename: $!");
}
utime $meta->{date}, $meta->{date}, $filename or
lib/Archive/Ar.pm view on Meta::CPAN
return unless $self->{files}->{$filename};
$self->{files}->{$filename}->{mode} =
$mode + 0 eq $mode ? $mode : oct($mode);
return 1;
}
sub chown {
my $self = shift;
my $filename = shift;
my $uid = shift;
my $gid = shift;
return unless $self->{files}->{$filename};
$self->{files}->{$filename}->{uid} = $uid if $uid >= 0;
$self->{files}->{$filename}->{gid} = $gid if defined $gid && $gid >= 0;
return 1;
}
sub remove {
my $self = shift;
my $files = ref $_[0] ? shift : \@_;
my $nfiles_orig = scalar @{$self->{names}};
for my $file (@$files) {
lib/Archive/Ar.pm view on Meta::CPAN
my $content = shift;
my $params = shift || {};
return $self->_error("No filename given") unless $path;
my $filename = (File::Spec->splitpath($path))[2];
$self->_add_data($filename, $content,
$params->{date} || timelocal(localtime()),
$params->{uid} || 0,
$params->{gid} || 0,
$params->{mode} || 0100644) or return;
return $self->{files}->{$filename}->{size};
}
sub write {
my $self = shift;
my $filename = shift;
my $opts = {(%{$self->{opts}}, %{shift || {}})};
my $type = $opts->{type} || $self->{type} || COMMON;
lib/Archive/Ar.pm view on Meta::CPAN
if ($type eq GNU) {
$fn = '' if defined $opts->{symbols} && $fn eq $opts->{symbols};
$name = $fn . '/';
}
else {
$name = $fn;
}
if (length($name) <= 16 || $type eq COMMON) {
push @body, pack('A16A12A6A6A8A10A2', $name,
@$meta{qw/date uid gid/}, $mode, $size, ARFMAG);
}
elsif ($type eq GNU) {
push @body, pack('A1A15A12A6A6A8A10A2', '/', $gnuindex{$fn},
@$meta{qw/date uid gid/}, $mode, $size, ARFMAG);
}
elsif ($type eq BSD) {
$size += length($name);
push @body, pack('A3A13A12A6A6A8A10A2', AR_EFMT1, length($name),
@$meta{qw/date uid gid/}, $mode, $size, ARFMAG),
$name;
}
else {
return $self->_error("$type: unexpected ar type");
}
push @body, $meta->{data};
push @body, "\n" if $size % 2; # padding
}
if ($filename) {
my $fh = $self->_get_handle($filename, '>');
lib/Archive/Ar.pm view on Meta::CPAN
sub _parse {
my $self = shift;
my $data = shift;
unless (substr($data, 0, SARMAG, '') eq ARMAG) {
return $self->_error("Bad magic number - not an ar archive");
}
my $type;
my $names;
while ($data =~ /\S/) {
my ($name, $date, $uid, $gid, $mode, $size, $magic) =
unpack('A16A12A6A6A8A10a2', substr($data, 0, 60, ''));
unless ($magic eq "`\n") {
return $self->_error("Bad file header");
}
if ($name =~ m|^/|) {
$type = GNU;
if ($name eq '//') {
$names = substr($data, 0, $size, '');
substr($data, 0, $size % 2, '');
next;
lib/Archive/Ar.pm view on Meta::CPAN
$name = substr($data, 0, int(substr($name, 3)), '');
$size -= length($name);
}
else {
if ($name =~ m|/$|) {
$type ||= GNU; # only gnu has trailing slashes
chop $name;
}
}
$uid = int($uid);
$gid = int($gid);
$mode = oct($mode);
my $content = substr($data, 0, $size, '');
substr($data, 0, $size % 2, '');
$self->_add_data($name, $content, $date, $uid, $gid, $mode, $size);
}
$self->{type} = $type || COMMON;
return scalar @{$self->{names}};
}
sub _add_data {
my $self = shift;
my $filename = shift;
my $content = shift || '';
my $date = shift;
my $uid = shift;
my $gid = shift;
my $mode = shift;
my $size = shift;
if (exists($self->{files}->{$filename})) {
return $self->_error("$filename: entry already exists");
}
$self->{files}->{$filename} = {
name => $filename,
date => defined $date ? $date : timelocal(localtime()),
uid => defined $uid ? $uid : 0,
gid => defined $gid ? $gid : 0,
mode => defined $mode ? $mode : 0100644,
size => defined $size ? $size : length($content),
data => $content,
};
push @{$self->{names}}, $filename;
return 1;
}
sub _get_handle {
my $self = shift;
lib/Archive/Ar.pm view on Meta::CPAN
my $ar = Archive::Ar->new;
$ar->read('./foo.ar');
$ar->extract;
$ar->add_files('./bar.tar.gz', 'bat.pl')
$ar->add_data('newfile.txt','Some contents');
$ar->chmod('file1', 0644);
$ar->chown('file1', $uid, $gid);
$ar->remove('file1', 'file2');
my $filehash = $ar->get_content('bar.tar.gz');
my $data = $ar->get_data('bar.tar.gz');
my $handle = $ar->get_handle('bar.tar.gz');
my @files = $ar->list_files();
my $archive = $ar->write;
lib/Archive/Ar.pm view on Meta::CPAN
Changes the name of a file in the in-memory archive.
=head2 chmod
$ar->chmod($filename, $mode);
Change the mode of the member to C<$mode>.
=head2 chown
$ar->chown($filename, $uid, $gid);
$ar->chown($filename, $uid);
Change the ownership of the member to user id C<$uid> and (optionally)
group id C<$gid>. Negative id values are ignored.
=head2 remove
$ar->remove(@filenames)
$ar->remove($arrayref)
Removes files from the in-memory archive. Returns the number of files
removed.
=head2 list_files
lib/Archive/Ar.pm view on Meta::CPAN
Returns a list of the names of all the files in the archive.
If called in a scalar context, returns a reference to an array.
=head2 add_files
$ar->add_files(@filenames)
$ar->add_files($arrayref)
Adds files to the archive. The arguments can be paths, but only the
filenames are stored in the archive. Stores the uid, gid, mode, size,
and modification timestamp of the file as returned by C<stat()>.
Returns the number of files successfully added, or undef if failure.
=head2 add_data
$ar->add_data("filename", $data)
$ar->add_data("filename", $data, $options)
Adds a file to the in-memory archive with name $filename and content
$data. File properties can be set with $optional_hashref:
$options = {
'data' => $data,
'uid' => $uid, #defaults to zero
'gid' => $gid, #defaults to zero
'date' => $date, #date in epoch seconds. Defaults to now.
'mode' => $mode, #defaults to 0100644;
}
You cannot add_data over another file however. This returns the file length in
bytes if it is successful, undef otherwise.
=head2 write
$data = $ar->write()
lib/Archive/Ar.pm view on Meta::CPAN
$content = $ar->get_content($filename)
This returns a hash with the file content in it, including the data
that the file would contain. If the file does not exist or no filename
is given, this returns undef. On success, a hash is returned:
$content = {
'name' => $filename,
'date' => $mtime,
'uid' => $uid,
'gid' => $gid,
'mode' => $mode,
'size' => $size,
'data' => $file_contents,
}
=head2 get_data
$data = $ar->get_data("filename")
Returns a scalar containing the file data of the given archive
t/20_add_data.t view on Meta::CPAN
my $ar = Archive::Ar->new;
is $ar->add_data("1", 'one'), 3, 'add_data';
is $ar->add_data("foo.txt", 'bar'), 3, 'add_data';
is $ar->add_data("2", 'two'), 3, 'add_data';
my $data = $ar->get_content('foo.txt');
is $data->{name}, 'foo.txt', 'name';
like $data->{date}, qr{^[1-9]\d*$}, 'date';
is $data->{uid}, 0, 'uid';
is $data->{gid}, 0, 'gid';
is $data->{mode}, 0100644, 'mode';
is $data->{data}, 'bar', 'data';
is $data->{size}, 3, 'size';
is $ar->get_content('goose'), undef, 'not found';
};
subtest 'non default values' => sub {
my $ar = Archive::Ar->new;
is $ar->add_data("1", 'one'), 3, 'add_data';
is $ar->add_data("foo.txt", 'barbaz', {
uid => 101,
gid => 201,
mode => 0644,
}), 6, 'add_data';
is $ar->add_data("2", 'two'), 3, 'add_data';
my $data = $ar->get_content('foo.txt');
is $data->{name}, 'foo.txt', 'name';
like $data->{date}, qr{^[1-9]\d*$}, 'date';
is $data->{uid}, 101, 'uid';
is $data->{gid}, 201, 'gid';
is $data->{mode}, 0644, 'mode';
is $data->{data}, 'barbaz', 'data';
is $data->{size}, 6, 'size';
is $ar->get_content('goose'), undef, 'not found';
};
t/40_mode.t view on Meta::CPAN
print $fh $content;
close $fh;
my $ar = Archive::Ar->new($file);
isa_ok $ar, 'Archive::Ar', 'object';
is_deeply [$ar->list_files], [qw(odd even)], 'list_files';
my $filedata = $ar->get_content('odd');
is $filedata->{name}, 'odd', 'file1, filedata/name';
is $filedata->{uid}, 2202, 'file1, filedata/uid';
is $filedata->{gid}, 2988, 'file1, filedata/gid';
is $filedata->{mode}, 0100644, 'file1, filedata/mode';
is $filedata->{date}, 1255532835, 'file1, filedata/date';
is $filedata->{size}, 11, 'file1, filedata/size';
is $filedata->{data}, "oddcontent\n", 'file1, filedata/data';
$filedata = $ar->get_content('even');
is $filedata->{name}, 'even', 'file2, filedata/name';
is $filedata->{uid}, 2202, 'file2, filedata/uid';
is $filedata->{gid}, 2988, 'file2, filedata/gid';
is $filedata->{mode}, 0100644, 'file2, filedata/mode';
is $filedata->{date}, 1255532831, 'file2, filedata/date';
is $filedata->{size}, 12, 'file2, filedata/size';
is $filedata->{data}, "evencontent\n", 'file2, filedata/data';
my ($nfh, $nfile) = tempfile(UNLINK => 1);
my $size = $ar->write($nfh);
is $size, 152, 'write size';
close $nfh;
( run in 0.584 second using v1.01-cache-2.11-cpan-ceb78f64989 )