X-Git-Url: http://git.ieval.ro/?a=blobdiff_plain;f=lib%2FSlob.pm;h=3e9697fff3c7c2faea0550ea579f1f4bc6848a33;hb=1ca60f5557ed528aa1cdd7c50737c5d51b94682a;hp=4b796cb91c26bd7562ccbb050d5bcbb2c9ba19bc;hpb=632d3de34ccfdc6438583d38e8a70fdbf02a5154;p=slob.git diff --git a/lib/Slob.pm b/lib/Slob.pm index 4b796cb..3e9697f 100644 --- a/lib/Slob.pm +++ b/lib/Slob.pm @@ -3,19 +3,67 @@ package Slob; use 5.014000; use strict; use warnings; -our $VERSION = '0.000_001'; +our $VERSION = '0.001'; use constant MAGIC => "!-1SLOB\x1F"; use Carp qw/croak verbose/; use Encode; +use Compress::Raw::Bzip2; +use Compress::Raw::Lzma; +use Compress::Raw::Zlib; + +our %UNCOMPRESS = ( + '' => sub { $_[0] }, + 'lzma2' => sub { + my ($input) = @_; + my ($lzma2, $code, $output); + ($lzma2, $code) = Compress::Raw::Lzma::RawDecoder->new(Filter => Lzma::Filter::Lzma2()); + die "Error creating LZMA2 decoder: $code\n" unless $code == LZMA_OK; + + $code = $lzma2->code($input, $output); + die "Did not reach end of stream\n" if $code == LZMA_OK; + die "Error decoding LZMA2: $code\n" if $code != LZMA_STREAM_END; + $output + }, + + 'bz2' => sub { + my ($input) = @_; + my ($bz2, $code, $output); + ($bz2, $code)= Compress::Raw::Bunzip2->new; + die "Error creating Bunzip2: $code\n" unless $code == Z_OK; + + $code = $bz2->bzinflate($input, $output); + die "Did not reach end of stream\n" if $code == BZ_OK; + die "Error decoding Bzip2: $code\n" if $code != BZ_STREAM_END; + + $output + }, + + 'zlib' => sub { + my ($input) = @_; + my ($zlib, $code, $output); + ($zlib, $code) = Compress::Raw::Zlib::Inflate->new( + -WindowBits => WANT_GZIP_OR_ZLIB + ); + die "Error creating Zlib inflate: $code\n" unless $code == Z_OK; + + $code = $zlib->inflate($input, \$output, 1); + die "Did not reach end of stream\n" if $code == Z_OK; + die "Error inflating zlib: $code\n" if $code != Z_STREAM_END; + $output + } +); + sub new { my ($class, $path) = @_; - my $fh = - ref $path eq 'IO' - ? $path - : open my $fh, '<', $path or croak "Cannot open \"$path\": $!"; + my $fh; + if (ref $path eq 'IO') { + $fh = $path + } else { + open $fh, '<', $path or croak "Cannot open \"$path\": $!" + } my $self = bless {path => $path, fh => $fh}, $class; $self->{header} = $self->read_header; $self @@ -109,7 +157,7 @@ sub ftell { sub uncompress { my ($self, $data) = @_; - $data + $UNCOMPRESS{$self->{header}{compression}}->($data) } sub read_header { @@ -122,7 +170,7 @@ sub read_header { $self->{encoding} = $encoding; my $compression = $self->read_tiny_text; - die "Compression not yet supported" if $compression; + die "Compression '$compression' not yet supported" unless exists $UNCOMPRESS{$compression}; my %tags = $self->read_tags; my @content_types = $self->read_content_types; my $blob_count = $self->read_int;