diff options
Diffstat (limited to 'Packdrakeng.pm')
| -rw-r--r-- | Packdrakeng.pm | 853 |
1 files changed, 853 insertions, 0 deletions
diff --git a/Packdrakeng.pm b/Packdrakeng.pm new file mode 100644 index 0000000..cad49da --- /dev/null +++ b/Packdrakeng.pm @@ -0,0 +1,853 @@ +##- Nanar <nanardon@mandrake.org> +##- +##- This program is free software; you can redistribute it and/or modify +##- it under the terms of the GNU General Public License as published by +##- the Free Software Foundation; either version 2, or (at your option) +##- any later version. +##- +##- This program is distributed in the hope that it will be useful, +##- but WITHOUT ANY WARRANTY; without even the implied warranty of +##- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +##- GNU General Public License for more details. +##- +##- You should have received a copy of the GNU General Public License +##- along with this program; if not, write to the Free Software +##- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +##- $Id$ + +package packdrakeng; + +use strict; +use warnings; +use POSIX; +use File::Path; +use File::Temp qw(tempfile); +use Compress::Zlib; +use vars qw($VERSION); + +my $debug = 1; +$VERSION = 0.10; + +my ($toc_header, $toc_footer) = + ('cz[0', '0]cz'); +my $gzip_header = pack("C" . Compress::Zlib::MIN_HDR_SIZE, + Compress::Zlib::MAGIC1, Compress::Zlib::MAGIC2, + Compress::Zlib::Z_DEFLATED(), 0,0,0,0,0,0, Compress::Zlib::OSCODE); +my $gzip_header_len = length($gzip_header); + + +sub _new { + my ($class, %options) = @_; + + my $pack = { + filename => $options{archive}, + + compress_method => $options{compress}, + uncompress_method => $options{uncompress}, + force_extern => $options{extern} || 0, # Don't use perl-zlib + use_extern => 1, # default behaviour, informative only + + level => $options{comp_level} || 6, # compression level, aka -X gzip or bzip option + + bloc_size => $options{bloc_size} || 400 * 1024, # A compressed bloc will contain 400k of compressed data + bufsize => $options{bufsize} || 65536, # Arbitrary buffer size to read files + + # Internal data + handle => undef, # Archive handle + + # Toc information + files => {}, # filename => { off, size, coff, csize } + dir => {}, # dir => no matter what value + 'symlink' => {}, # file => link + + coff => 0, # end of current compressed data + + # Compression sub + subcompress => \&extern_compress, + subuncompress => \&extern_uncompress, + direct_write => 0, # Define if wrapper write directly in archive and not into temp file + + # Data we need keep in memory to achieve the storage + current_bloc_files => {}, # Files in pending compressed bloc + current_bloc_csize => 0, # Actual size in pending compressed bloc + current_bloc_coff => 0, # The bloc bloc location (offset) + current_bloc_off => 0, # Actual uncompressed file offset within the pending bloc + + cstream_data => undef, # Wrapper data we need to keep in memory (compression) + ustream_data => undef, # Wrapper data we need to keep in memory (uncompression) + + # log and verbose function: + log => $options{quiet} ? sub {} : sub { my @w = @_; $w[0] .= "\n"; printf STDERR @w }, + debug => $options{debug} ? sub { my @w =@_; $w[0] = "Debug: $w[0]\n"; printf STDERR @w } : sub {}, + }; + + bless($pack, $class) +} + +sub new { + my ($class, %options) = @_; + my $pack = _new($class, %options); + sysopen($pack->{handle}, $pack->{filename}, O_WRONLY | O_TRUNC | O_CREAT) or return undef; + $pack->choose_compression_method(); + $pack->{need_build_toc} = 1; + $pack->{log}->("Creating new archive with '%s' / '%s'%s.", + $pack->{compress_method}, $pack->{uncompress_method}, + $pack->{use_extern} ? "" : " (internal compression)"); + $pack +} + +sub open { + my ($class, %options) = @_; + my $pack = _new($class, %options); + sysopen($pack->{handle}, $pack->{filename}, O_RDONLY) or return undef; + $pack->read_toc(); + $pack->{log}->("Opening archive with '%s' / '%s'%s.", + $pack->{compress_method}, $pack->{uncompress_method}, + $pack->{use_extern} ? "" : " (internal compression)"); + $pack +} + +# look $pack->{(un)compressed_method} and setup functions/commands to use +# Have some facility about detecting we want gzip/bzip +sub choose_compression_method { + my ($pack) = @_; + + (!defined($pack->{compress_method}) && !defined($pack->{uncompress_method})) + and $pack->{compress_method} = "gzip"; + my $test_method = $pack->{compress_method} || $pack->{uncompress_method}; + + $test_method =~ m/^bzip2|^bunzip2/ and do { + $pack->{compress_method} ||= "bzip2"; + }; + $test_method =~ m/^gzip|^gunzip/ and do { + $pack->{compress_method} ||= "gzip"; + if (!$pack->{force_extern}) { + $pack->{subcompress} = \&gzip_compress; + $pack->{subuncompress} = \&gzip_uncompress; + $pack->{use_extern} = 0; + $pack->{direct_write} = 1; + } + }; + $pack->{uncompress_method} ||= "$pack->{compress_method} -d"; + $pack->{compress_method} = "$pack->{compress_method} -$pack->{level}"; +} + +sub DESTROY { + my ($pack) = @_; + $pack->build_toc(); + close($pack->{handle}) if ($pack->{handle}); +} + +# Flush current compressed bloc +# Write +sub build_toc { + my ($pack) = @_; + $pack->{need_build_toc} or return 1; + $pack->end_bloc(); + my ($toc_length, $cf, $cd, $cl) = (0, 0, 0, 0); + + sysseek($pack->{handle}, $pack->{coff}, 0) == $pack->{coff} or return 0; + + foreach my $entry (keys %{$pack->{'dir'}}) { + $cd++; + $toc_length += syswrite($pack->{handle}, $entry . "\n"); + } + foreach my $entry (keys %{$pack->{'symlink'}}) { + $cl++; + $toc_length += syswrite($pack->{handle}, sprintf("%s\n%s\n", $entry, $pack->{'symlink'}{$entry})); + } + foreach my $entry (sort keys %{$pack->{files}}) { + $cf++; + $toc_length += syswrite($pack->{handle}, $entry ."\n"); + } + foreach my $file (sort keys %{$pack->{files}}) { + my $entry = $pack->{files}{$file}; + syswrite($pack->{handle}, pack('NNNN', $entry->{coff}, $entry->{csize}, $entry->{off}, $entry->{size})) or return 0; + } + syswrite($pack->{handle}, pack("a4NNNNa40a4", + $toc_header, + $cd, $cl, $cf, + $toc_length, + $pack->{uncompress_method}, + $toc_footer)) or return 0; + 1 +} + +sub read_toc { + my ($pack) = @_; + sysseek($pack->{handle}, -64, 2) ; #or return 0; + sysread($pack->{handle}, my $buf, 64);# == 64 or return 0; + my ($header, $toc_d_count, $toc_l_count, $toc_f_count, $toc_str_size, $uncompress, $trailer) = + unpack("a4NNNNZ40a4", $buf); + $header eq $toc_header && $trailer eq $toc_footer or do { + warn "Error reading toc: wrong header/trailer"; + return 0; + }; + + $pack->{uncompress_method} ||= $uncompress; + $pack->choose_compression_method(); + + #printf STDERR "Toc size: %d + 16 * %d\n", $toc_str_size, $toc_f_count; + sysseek($pack->{handle}, -64 - ($toc_str_size + 16 * $toc_f_count) ,2); + sysread($pack->{handle}, my $fileslist, $toc_str_size); + my @filenames = split("\n", $fileslist); + sysread($pack->{handle}, my $sizes_offsets, 16 * $toc_f_count); + my @size_offset = unpack("N" . 4*$toc_f_count, $sizes_offsets); + + foreach (1 .. $toc_d_count) { + $pack->{dir}{shift(@filenames)} = 1; + } + foreach (1 .. $toc_l_count) { + my $n = shift(@filenames); + $pack->{'symlink'}{$n} = shift(@filenames); + } + + foreach (1 .. $toc_f_count) { + my $f = shift(@filenames); + $pack->{files}{$f}{coff} = shift(@size_offset); + $pack->{files}{$f}{csize} = shift(@size_offset); + $pack->{files}{$f}{off} = shift(@size_offset); + $pack->{files}{$f}{size} = shift(@size_offset); + # looking for offset for this archive + $pack->{files}{$f}{coff} + $pack->{files}{$f}{csize} > $pack->{coff} and + $pack->{coff} = $pack->{files}{$f}{coff} + $pack->{files}{$f}{csize}; + } + 1 +} + +# Goto to the end of written compressed data +sub end_seek { + my ($pack) = @_; + my $seekvalue = $pack->{direct_write} ? $pack->{coff} + $pack->{current_bloc_csize} : $pack->{coff}; + sysseek($pack->{handle}, $seekvalue, 0) == $seekvalue +} + +#- To terminate a compressed bloc, flush the pending compressed data, +#- fill toc data still unknown +sub end_bloc { + my ($pack) = @_; + $pack->end_seek() or return 0; + my $m = $pack->{subcompress}; + my (undef, $csize) = $pack->$m(undef); + $pack->{current_bloc_csize} += $csize; + foreach (keys %{$pack->{current_bloc_files}}) { + $pack->{files}{$_} = $pack->{current_bloc_files}{$_}; + $pack->{files}{$_}{csize} = $pack->{current_bloc_csize}; + } + $pack->{coff} += $pack->{current_bloc_csize}; + $pack->{current_bloc_coff} += $pack->{current_bloc_csize}; + $pack->{current_bloc_csize} = 0; + $pack->{current_bloc_files} = {}; + $pack->{current_bloc_off} = 0; + +} + +####################### +# Compression wrapper # +####################### + +sub extern_compress { + my ($pack, $sourcefh) = @_; + my ($insize, $outsize, $filesize) = (0, 0, 0); # aka uncompressed / compressed data length + my ($hin, $hout); # handle for open2 + + if (defined($pack->{cstream_data})) { + ($hin, $hout) = ($pack->{cstream_data}{hin}, $pack->{cstream_data}{hout}); + $filesize = (stat($pack->{cstream_data}{file_bloc}))[7]; + } + if (defined($sourcefh)) { + if (!defined($pack->{cstream_data})) { + ($hin, $pack->{cstream_data}{file_bloc}) = tempfile(); + CORE::open($hout, "|$pack->{compress_method} > $pack->{cstream_data}{file_bloc}") or do { + warn "Unable to start $pack->{compress_method}"; + return 0, 0; + }; + ($pack->{cstream_data}{hin}, $pack->{cstream_data}{hout}) = ($hin, $hout); + binmode $hin; binmode $hout; + $| =1; + } + # until we have data to push or data to read + while (my $length = sysread($sourcefh, my $data, $pack->{bufsize})) { + # pushing data to compressor + (my $l = syswrite($hout, $data)) == $length or do { + warn "can't push all data to compressor"; + }; + $insize += $l; + $outsize = (stat($pack->{cstream_data}{file_bloc}))[7]; + } + } elsif (defined($pack->{cstream_data})) { + # If $sourcefh is not set, this mean we want a flush(), for end_bloc() + close($hout); + unlink($pack->{cstream_data}{file_bloc}); + while (my $lenght = sysread($hin, my $data, $pack->{bufsize})) { + (my $l = syswrite($pack->{handle}, $data)) == $lenght or do { + warn "Can't write all data in archive"; + }; + $outsize += $l; + } + close($hin); + $pack->{cstream_data} = undef; + } + ($insize, $outsize - $filesize) +} + +sub extern_uncompress { + my ($pack, $destfh, $fileinfo) = @_; + + # We have to first extract the bloc to a temp file, burk ! + my ($tempfh, $tempname) = tempfile(); + + my $cread = 0; + while ($cread < $fileinfo->{csize}) { + my $cl = sysread($pack->{handle}, my $data, + $cread + $pack->{bufsize} > $fileinfo->{csize} ? + $fileinfo->{csize} - $cread : + $pack->{bufsize}) or do { + warn("Enexpected end of file"); + close($tempfh); + unlink($tempname); + return -1; + }; + $cread += $cl; + syswrite($tempfh, $data) == length($data) or do { + warn "Can't write all data into temp file"; + close($tempfh); + unlink($tempname); + return -1; + }; + } + close($tempfh); + + CORE::open(my $hc, "$pack->{uncompress_method} < '$tempname' |") or do { + warn "Can't start $pack->{uncompress_method} to uncompress data"; + unlink($tempname); + return -1; + }; + + my $byteswritten = 0; + my $read = 0; + + while ($byteswritten < $fileinfo->{size}) { + my $length = sysread($hc, my $data, $pack->{bufsize}) or do { + warn "unexpected end of stream"; + close($hc); + return -1; + }; + + + if ($read < $fileinfo->{off} && $read + $length > $fileinfo->{off}) { + $data = substr($data, $fileinfo->{off} - $read); + } + $read += $length; + if ($read <= $fileinfo->{off}) { next } + + my $bw = $byteswritten + length($data) > $fileinfo->{size} ? $fileinfo->{size} - $byteswritten : length($data); + syswrite($destfh, $data, $bw) == $bw or do { + warn "Can't write data into dest"; + return -1; + }; + $byteswritten += $bw; + } + + close($hc); + unlink($tempname); # deleting temp file + $byteswritten + +} + +sub gzip_compress { + my ($pack, $sourcefh) = @_; + my ($insize, $outsize) = (0, 0); # aka uncompressed / compressed data length + + # If $sourcefh is not set, this mean we want a flush(), for end_bloc() + # EOF, flush compress stream, adding crc + if (!defined($sourcefh)) { + if (defined($pack->{cstream_data}{object})) { + my ($cbuf, $status) = $pack->{cstream_data}{object}->flush(); + $outsize += syswrite($pack->{handle}, $cbuf); + $outsize += syswrite($pack->{handle}, pack("V V", $pack->{cstream_data}{crc}, $pack->{cstream_data}{object}->total_in())); + } + $pack->{cstream_data} = undef; + return(undef, $outsize); + } + + if (!defined $pack->{cstream_data}{object}) { + # Writing gzip header file + $outsize += syswrite($pack->{handle}, $gzip_header); + $pack->{cstream_data}{object} = deflateInit( + -Level => $pack->{level}, + # Zlib do not create gzip header, except with this flag + -WindowBits => - MAX_WBITS(), + ); + } + + binmode $sourcefh; + + while (my $lenght = sysread($sourcefh, my $buf, $pack->{bufsize})) { + $pack->{cstream_data}{crc} = crc32($buf, $pack->{cstream_data}{crc}); + my ($cbuf, $status) = $pack->{cstream_data}{object}->deflate($buf); + $outsize += syswrite($pack->{handle}, $cbuf); + $insize += $lenght; + } + + ($insize, $outsize) +} + +sub gzip_uncompress { + my ($pack, $destfh, $fileinfo) = @_; + my $x = inflateInit( + -WindowBits => - MAX_WBITS(), + ); + my $cread = 0; # Compressed data read + { + my $buf; + # get magic + if (sysread($pack->{handle}, $buf, 2) == 2) { + my @magic = unpack("C*", $buf); + $magic[0] == Compress::Zlib::MAGIC1 && $magic[1] == Compress::Zlib::MAGIC2 or do { + warn("Wrong magic header found"); + return -1; + }; + } else { + warn("Unexpect end of file while reading magic"); + return -1; + } + my ($method, $flags); + if (sysread($pack->{handle}, $buf, 2) == 2) { + ($method, $flags) = unpack("C2", $buf); + } else { + warn("Unexpect end of file while reading flags"); + return -1; + } + + if (sysread($pack->{handle}, $buf, 6) != 6) { + warn("Unexpect end of file while reading gzip header"); + return -1; + } + + $cread += 12; #Gzip header fixed size is already read + if ($flags & 0x04) { + if (sysread($pack->{handle}, $buf, 2) == 2) { + my $len = unpack("I", $buf); + $cread += $len; + if (sysread($pack->{handle}, $buf, $len) != $len) { + warn("Unexpect end of file while reading gzip header"); + return -1; + } + } else { + warn("Unexpect end of file while reading gzip header"); + return -1; + } + } + } + my $byteswritten = 0; + my $read = 0; # uncompressed data read + while ($byteswritten < $fileinfo->{size}) { + my $cl=sysread($pack->{handle}, my $buf, + $cread + $pack->{bufsize} > $fileinfo->{csize} ? + $fileinfo->{csize} - $cread : + $pack->{bufsize}) or do { + warn("Enexpected end of file"); + return -1; + }; + $cread += $cl; + my ($out, $status) = $x->inflate(\$buf); + $status == Z_OK || $status == Z_STREAM_END or do { + warn("Unable to uncompress data"); + return -1; + }; + my $l = length($out) or next; + if ($read < $fileinfo->{off} && $read + $l > $fileinfo->{off}) { + $out = substr($out, $fileinfo->{off} - $read); + } + $read += $l; + if ($read <= $fileinfo->{off}) { next } + + my $bw = $byteswritten + length($out) > $fileinfo->{size} ? $fileinfo->{size} - $byteswritten : length($out); + syswrite($destfh, $out, $bw) == $bw or do { + warn "Can't write data into dest"; + return -1; + }; + $byteswritten += $bw; + + } + $byteswritten +} + +################### +# Debug functions # +################### + +# This function extract in $dest the whole bloc containing $file, can be usefull for debugging +sub extract_bloc { + my ($pack, $dest, $file) = @_; + + sysopen(my $handle, $dest, O_WRONLY | O_TRUNC | O_CREAT) or do { + warn "Can't open $dest"; + return -1; + }; + + sysseek($pack->{handle}, $pack->{files}{$file}->{coff}, 0) == $pack->{files}{$file}->{coff} or do { + warn("Can't seek to offset $pack->{files}{$file}->{coff}"); + close($handle); + return -1; + }; + + { + my $l; + $l = sysread($pack->{handle}, my $buf, $pack->{files}{$file}->{csize}) == $pack->{files}{$file}->{csize} or warn "Read only $l / $pack->{files}{$file}->{csize} bytes"; + syswrite($handle, $buf); + } + + foreach (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}}) { + $pack->{files}{$_}{coff} == $pack->{files}{$file}->{coff} or next; + } + + close($handle); + +} + +################################## +# Really working functions # +# Aka function poeple should use # +################################## + +sub add_virtual { + my ($pack, $type, $filename, $data) = @_; + $type eq 'l' and do { + $pack->{'symlink'}{$filename} = $data; + $pack->{need_build_toc} = 1; + return 1; + }; + $type eq 'd' and do { + $pack->{dir}{$filename}++; + $pack->{need_build_toc} = 1; + return 1; + }; + $type eq 'f' and do { + # Be sure we are at the end, allow extract + add in only one instance + $pack->end_seek() or do { + warn("Can't seek to offset $pack->{coff}"); + next; + }; + + my $m = $pack->{subcompress}; + my ($size, $csize) = $pack->$m($data); + $pack->{current_bloc_files}{$filename} = { + size => $size, + off => $pack->{current_bloc_off}, + coff => $pack->{current_bloc_coff}, + csize => -1, # Still unknown, will be fill by end_bloc + }; # Storing in toc structure availlable info + + # Updating internal info about current bloc + $pack->{current_bloc_off} += $size; + $pack->{current_bloc_csize} += $csize; + $pack->{need_build_toc} = 1; + if ($pack->{bloc_size} > 0 && $pack->{current_bloc_csize} >= $pack->{bloc_size}) { + $pack->end_bloc(); + } + return 1; + }; + 0 +} + +sub add { + my ($pack, $prefix, @files) = @_; + $prefix ||= ""; $prefix =~ s://+:/:; + foreach my $file (@files) { + $file =~ s://+:/:; + my $srcfile = $prefix ? "$prefix/$file" : $file; + + -l $file and do { + $pack->add_virtual('l', $file, readlink($srcfile)); + next; + }; + -d $file and do { # dir simple case + $pack->add_virtual('d', $file); + next; + }; + -f $file and do { + sysopen(my $htocompress, $srcfile, O_RDONLY) or next; + $pack->add_virtual('f', $file, $htocompress); + close($htocompress); + next; + }; + } + 1 +} + +sub extract_virtual { + my ($pack, $destfh, $filename) = @_; + defined($pack->{files}{$filename}) or return -1; + sysseek($pack->{handle}, $pack->{files}{$filename}->{coff}, 0) == $pack->{files}{$filename}->{coff} or do { + warn("Can't seek to offset $pack->{files}{$filename}->{coff}"); + return -1; + }; + my $m = $pack->{subuncompress}; + $pack->$m($destfh, $pack->{files}{$filename}); +} + +sub extract { + my ($pack, $dir, @file) = @_; + foreach my $f (@file) { + my $dest = $dir ? "$dir/$f" : "$f"; + my ($dir) = $dest =~ m!(.*)/.*!; + if (exists($pack->{dir}{$f})) { + -d $dest || mkpath($dest) + or warn "Unable to create dir $dest"; + next; + } elsif (exists($pack->{'symlink'}{$f})) { + -d $dir || mkpath($dir) or do { + warn "Unable to create dir $dir"; + }; + symlink($dest, $pack->{'symlink'}{$f}) + or warn "Unable to extract symlink $f"; + next; + } elsif (exists($pack->{files}{$f})) { + -d $dir || mkpath($dir) or do { + warn "Unable to create dir $dir"; + }; + sysopen(my $destfh, $dest, O_CREAT | O_TRUNC | O_WRONLY) + or do { + warn "Unable to extract $dest"; + next; + }; + my $written = $pack->extract_virtual($destfh, $f); + $written == -1 and warn "Unable to extract file $f"; + close($destfh); + next; + } else { + warn "Can't find $f in archive"; + } + } + 1 +} + +# Return \@dir, \@files, \@symlink list +sub getcontent { + my ($pack) = @_; + return([ keys(%{$pack->{dir}})], [ keys(%{$pack->{files}}) ], [ keys(%{$pack->{'symlink'}}) ]); +} + +sub list { + my ($pack) = @_; + foreach my $file (keys %{$pack->{dir}}) { + printf "d %13c %s\n", ' ', $file; + } + foreach my $file (keys %{$pack->{'symlink'}}) { + printf "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 %12d %s\n", $pack->{files}{$file}{size}, $file; + } +} + +# Print toc info +sub dump { + my ($pack) = @_; + foreach my $file (keys %{$pack->{dir}}) { + printf "d %13c %s\n", ' ', $file; + } + foreach my $file (keys %{$pack->{'symlink'}}) { + printf "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; + } +} + +1 + +__END__ + +=head1 NAME + +packdrakeng - Simple Archive Extractor/Builder + +=head1 SYNOPSIS + + use packdrakeng; + + # creating an archive + $pack = packdrakeng->new(archive => "myarchive.cz"); + # Adding few files + $pack->add("/path/", "file1", "file2"); + # Adding an unamed file + open($handle, "file"); + $pack->add_virtual("filename", $handle); + close($handle); + + $pack = undef; + + # extracting an archive + $pack = packdrakeng->open(archive => "myarchive.cz"); + # listing files + $pack->list(); + # extracting few files + $pack->extract("/path/", "file1", "file2"); + # extracting data into a file handle + open($handle, "file"); + $pack->extract_virtual($handle, "filename"); + close($handle); + +=head1 DESCRIPTION + +C<packdrakeng> is a simple indexed archive builder and extractor using +standard compression method. + +This module is a rewrite from scratch of original packdrake, used format is +fully compatible with old packdrake. + +=head1 IMPLEMENTATION + +Compressed data are stored by bloc: + + UncompresseddatA1UncompresseddatA2 UncompresseddatA3UncompresseddatA4 + |--- size 1 ---||--- size 2 ---| |--- size 3 ---||--- size 4 ---| + |<-offset1 |<-offset2 |<-offset3 |<-offset4 + +give: + + CompresseD1CompresseD2 CompresseD3CompresseD4 + |--- c. size 1, 2 ---| |--- c. size 3, 4 ---| + |<-c. offset 1, 2 |<-c. offset 3, 4 + +A new bloc is started when its size exceed the C<bloc_size> value. + +Compressed data are followed by the toc, ie a simple list of packed files. +Each file name is terminated by the "\n" character: + +dir1 +dir2 +... +dirN +symlink1 +point_file1 +symlink2 +point_file2 +... +... +symlinkN +point_fileN +file1 +file2 +... +fileN + +Follow the files sizes, 4 values for each files are stored: +offset into archive of compressed bloc, size of compressed bloc, +offset into bloc of the file and the file's size. + +Finally the archive contain a trailer, of 64 bytes length, about the +toc and the archive itself: +'cz[0', strings 4 bytes +number of directory, 4 bytes +number of symlinks, 4 bytes +number of files, 4 bytes +the toc size, 4 bytes +the uncompressed command, strings of 40 bytes length +'0]cz', strings 4 bytes + +=head1 FUNCTIONS + +=over + +=item B<new(%options)> + +Create a new archive. +Options: + +=over 4 + +=item archive + +The file name of the archive. If the file don't exists, it is create, else it is owerwritten. +see C<open>. + +=item compress + +The application to use to compress, if unset, gzip is used. + +=item uncompress + +The application to use to extract data from archive. This option is useless if +you're opening an existing archive (except you want to force it). +If unset, this value is based on compress command followed by '-d' argument. + +=item extern + +If you're using gzip, by default packdrakeng use perl-zlib to limit system +coast. This options force packdrakeng to use the extern gzip command. This +has no with other compress programs until internal functions are not implement +yet. + +=item comp_level + +The compression level passed as argument to the compress program. By default +this is set to 6. + +=item bloc_size + +The limit size from which we start a new compressed bloc. The default value is +400KB. Setting it to 0 to be sure a new bloc will be started for each packed +files, -1 to never start a new bloc. Be aware a big size of bloc will slower +the file extraction. + +=item quiet + +Do not ouput anythings, shut up. + +=item debug + +Print debug messages + +=back + +=item B<open(%options)> + +Open an existing archive for extracting or adding files. + +The uncompressed command is found into the archive, the compressed command is +found from it. + +In case you add files, an new compressed bloc will be started regardless the +latest bloc is smaller than the bloc_size. All compression options can't be +find in the archive, so new preference will be applied. + +Options are same than the C<new()> function. + +=head1 AUTHOR + +Olivier Thauvin <nanardon@mandrake.org> + +=head1 LICENSE + +This program is free software; you can redistribute it and/or +modify it under the terms of GNU General Public License as +published by the Free Software Foundation; either version 2 of +the License, or (at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +If you do not have a copy of the GNU General Public License write to +the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, +MA 02139, USA. + +=cut |