Archive-Ar-Ng
view release on metacpan or search on metacpan
my $ar = Archive::Ar::Ng->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/Ng.pm view on Meta::CPAN
my $size = $meta->{size};
my $name;
print $fn;
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" );
}
print $tmpfn @body;
if ( defined $meta->{original_fname} ) {
if ( open( my $rfn, '<:encoding(UTF-8)', $meta->{original_fname} ) ) {
while ( my $row = <$rfn> ) {
chomp $row;
print $tmpfn $row . "\n";
}
lib/Archive/Ar/Ng.pm view on Meta::CPAN
if ( $blk_size > 16384 ) {
$blk_size = 16384;
}
$rpos += sysread( $self->{fh}, $rbuf, $blk_size ) or return $self->_error( "$filename: $!" );
syswrite( $fh, $rbuf, $blk_size ) or return $self->_error( "$filename: $!" );
}
undef $rbuf;
##--
close $fh or return $self->_error( "$filename: $!" );
if ( CAN_CHOWN && $self->{opts}->{chown} ) {
chown $meta->{fuid}, $meta->{fgid}, $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 return $self->_error( "$filename: $!" );
return 1;
lib/Archive/Ar/Ng.pm view on Meta::CPAN
my $fpos = 0;
my $type;
my $names;
my $flen = sysseek( $self->{fh}, 0, SEEK_END );
sysseek( $self->{fh}, 0, SEEK_SET );
unless ( $self->myread( $fpos, SARMAG ) eq ARMAG ) {
return $self->_error( "Bad magic number - not an ar archive" );
}
$fpos += SARMAG;
while ( $fpos < $flen ) {
my ( $name, $date, $uid, $gid, $mode, $size, $magic ) = unpack( 'A16A12A6A6A8A10a2', $self->myread( $fpos, 60 ) );
$fpos += 60;
unless ( $magic eq "`\n" ) {
return $self->_error( "Bad file header" );
}
if ( $name =~ m|^/| ) {
$type = GNU;
if ( $name eq '//' ) {
$names = $self->myread( $fpos, $size );
$fpos += $size + ( $size % 2 );
next;
lib/Archive/Ar/Ng.pm view on Meta::CPAN
$name = $self->myread( $fpos, $l );
$fpos += $l;
$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 );
$self->_add_data( $name, $fpos, $date, $uid, $gid, $mode, $size, undef, undef );
$fpos += $size + ( $size % 2 );
}
$self->{type} = $type || COMMON;
return scalar @{$self->{names}};
}
sub _add_data {
my $self = shift;
my $filename = shift;
my $fpos = shift;
my $date = shift;
my $fuid = shift;
my $fgid = shift;
my $mode = shift;
my $size = shift;
my $ofn = shift;
my $content = shift;
if ( exists( $self->{files}->{$filename} ) ) {
return $self->_error( "$filename: entry already exists" );
}
if ( !defined $date || $date == 0 ) {
$date = timelocal( localtime() );
}
$self->{files}->{$filename} = {
name => $filename,
date => $date,
fuid => defined $fuid ? $fuid : 0,
fgid => defined $fgid ? $fgid : 0,
mode => defined $mode ? $mode : 0100644,
size => defined $size ? $size : 0,
fpos => $fpos,
original_fname => $ofn,
data => $content,
};
push @{$self->{names}}, $filename;
return 1;
}
lib/Archive/Ar/Ng.pm view on Meta::CPAN
$fpos += 60;
if ( open my $fd, $path ) {
my @st = stat $fd or return $self->_error( "$path: $!" );
local $/ = undef;
binmode $fd;
my $content = <$fd>;
close $fd;
my $filename = ( File::Spec->splitpath( $path ) )[2];
my @analitycs = stat $filename;
my $uid = int( @st[4] );
my $gid = int( @st[5] );
my $date = @st[9];
my $mode = @st[2];
my $size = @st[7];
$self->_add_data( $filename, $fpos, $date, $uid, $gid, $mode, $size, $path, undef );
} else {
$self->_error( "$path: $!" );
}
}
return scalar @{$self->{names}};
}
sub remove {
my $self = shift;
my $files = ref $_[0] ? shift : \@_;
lib/Archive/Ar/Ng.pm view on Meta::CPAN
my $mode = sprintf( '%o', $meta->{mode} );
my $size = $meta->{size};
my $name;
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" );
}
print $tmpfn @body;
if ( defined $meta->{original_fname} ) {
if ( open( my $rfn, '<:encoding(UTF-8)', $meta->{original_fname} ) ) {
while ( my $row = <$rfn> ) {
chomp $row;
print $tmpfn $row . "\n";
}
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 1.012 second using v1.01-cache-2.11-cpan-ceb78f64989 )