diff options
| -rw-r--r-- | Packdrakeng.pm | 49 | ||||
| -rwxr-xr-x | t/01packdrakeng.t | 11 |
2 files changed, 53 insertions, 7 deletions
diff --git a/Packdrakeng.pm b/Packdrakeng.pm index 5fa03cf..6e13d65 100644 --- a/Packdrakeng.pm +++ b/Packdrakeng.pm @@ -571,8 +571,22 @@ sub getcontent { return([ keys(%{$pack->{dir}})], [ keys(%{$pack->{files}}) ], [ keys(%{$pack->{'symlink'}}) ]); } +sub infofile { + my ($pack, $file) = @_; + if (defined($pack->{files}{$file})) { + return ('f', $pack->{files}{$file}{size}); + } elsif (defined($pack->{'symlink'}{$file})) { + return ('l', $pack->{'symlink'}{$file}); + } elsif (defined($pack->{dir}{$file})) { + return ('d', undef); + } else { + return(undef, undef); + } +} + sub list { - my ($pack) = @_; + my ($pack, $handle) = @_; + $handle ||= *STDOUT; foreach my $file (keys %{$pack->{dir}}) { printf "d %13c %s\n", ' ', $file; } @@ -590,19 +604,20 @@ sub list { # Print toc info sub dumptoc { - my ($pack) = @_; - foreach my $file (keys %{$pack->{dir}}) { - printf "d %13c %s\n", ' ', $file; + my ($pack, $handle) = @_; + $handle ||= *STDOUT; + foreach my $file (keys %{$pack->{dir}}) { + printf $handle "d %13c %s\n", ' ', $file; } foreach my $file (keys %{$pack->{'symlink'}}) { - printf "l %13c %s -> %s\n", ' ', $file, $pack->{'symlink'}{$file}; + printf $handle "l %13c %s -> %s\n", ' ', $file, $pack->{'symlink'}{$file}; } foreach my $file (sort { $pack->{files}{$a}{coff} == $pack->{files}{$b}{coff} ? $pack->{files}{$a}{off} <=> $pack->{files}{$b}{off} : $pack->{files}{$a}{coff} <=> $pack->{files}{$b}{coff} } keys %{$pack->{files}}) { - printf "f %d %d %d %d %s\n", $pack->{files}{$file}{size}, $pack->{files}{$file}{off}, $pack->{files}{$file}{csize}, $pack->{files}{$file}{coff}, $file; + printf $handle "f %d %d %d %d %s\n", $pack->{files}{$file}{size}, $pack->{files}{$file}{off}, $pack->{files}{$file}{csize}, $pack->{files}{$file}{coff}, $file; } } @@ -796,6 +811,28 @@ normal file. Extract @files from the archive into $destdir prefix. +=item B<Packdrakeng->getcontent()> + +Return 3 arrayref about found files into archive, respectively directory list, +files list and symlink list. + +=item B<Packdrakeng->infofile($file)> + +Return the type and information about a file into the archive. + +- return 'f' and the the size of the file for a plain file +- return 'l' and the point file for a link +- return 'd' and undef for a directory +- return undef if the file can't be found into archive. + +=item B<Packdrakeng->infofile($handle)> + +Print to $handle (STDOUT if not specified) the content of the archive. + +=item B<Packdrakeng->dumptoc($handle)> + +Print to $handle (STDOUT if not specified) the table of content of the archive. + =head1 AUTHOR Olivier Thauvin <nanardon@mandrake.org> diff --git a/t/01packdrakeng.t b/t/01packdrakeng.t index 6fbb200..446ff8d 100755 --- a/t/01packdrakeng.t +++ b/t/01packdrakeng.t @@ -3,7 +3,7 @@ # $Id$ use strict; -use Test::More tests => 37; +use Test::More tests => 41; use Digest::MD5; use_ok('Packdrakeng'); @@ -111,6 +111,15 @@ ok($pack->add_virtual('l', "symlink", "dest"), "Adding a symlink"); $pack = undef; ok($pack = Packdrakeng->open(archive => "packtest.cz"), "Opening the archive"); +my ($type, $info); +($type, $info) = $pack->infofile("noexist"); +ok(!defined($type), "get info from an non existed file"); +($type, $info) = $pack->infofile("dir"); +ok($type eq 'd', "Get info from a dir"); +($type, $info) = $pack->infofile("symlink"); +ok($type eq 'l' && $info eq 'dest', "Get info from a dir"); +($type, $info) = $pack->infofile("coin"); +ok($type eq 'f' && $info eq length($coin), "Get info from a file"); ok($pack->extract("test", "dir"), "Extracting dir"); ok(-d "test/dir", "dir successfully restored"); ok($pack->extract("test", "symlink"), "Extracting symlink"); |