LZMA compression + tests

diff --git a/MANIFEST b/MANIFEST
index 823ea14b2b354a2652b5a591e4dd00d38b333acc..48b0971483f02cd47b8e6c5fd4cc6b9327852703 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3,5 +3,6 @@ Makefile.PL
 MANIFEST
 README
 t/Slob.t
-t/freedict-01.slob
+t/freedict-uncompressed.slob
+t/freedict-lzma2.slob
 lib/Slob.pm

diff --git a/Makefile.PL b/Makefile.PL
index e336e8e68bfcfefb258314137618acfc6d94c447..317d6c4f8a584f3bee000e7add29004e6914acc5 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -13,7 +13,9 @@ WriteMakefile(
        MIN_PERL_VERSION  => '5.14.0',
        LICENSE           => 'perl',
        SIGN              => 1,
-       PREREQ_PM         => {},
+       PREREQ_PM         => {
+               qw/Compress::Raw::Lzma 0/,
+       },
        META_ADD          => {
                dynamic_config => 0,
                resources      => {

diff --git a/README b/README
index 9186721a75243a62ed40349ec4cc3de014f0d523..b3963446a45a6e5afa706c0f325c5fecea2a0776 100644 (file)
--- a/README
+++ b/README
@@ -12,7 +12,9 @@ To install this module type the following:
 
 DEPENDENCIES
 
-This module requires no non-core modules and libraries.
+This module requires these other modules and libraries:
+
+ * Compress::Raw::Lzma
 
 COPYRIGHT AND LICENCE
 

diff --git a/lib/Slob.pm b/lib/Slob.pm
index 4b796cb91c26bd7562ccbb050d5bcbb2c9ba19bc..818ff785ed7fe6fd298fe3a9ff0c7142aa4713f8 100644 (file)
--- a/lib/Slob.pm
+++ b/lib/Slob.pm
@@ -10,12 +10,30 @@ use constant MAGIC => "!-1SLOB\x1F";
 use Carp qw/croak verbose/;
 use Encode;
 
+use Compress::Raw::Lzma;
+
+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" if $code == LZMA_OK;
+               die "Error decoding LZMA2: $code" if $code != LZMA_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 +127,7 @@ sub ftell {
 
 sub uncompress {
        my ($self, $data) = @_;
-       $data
+       $UNCOMPRESS{$self->{header}{compression}}->($data)
 }
 
 sub read_header {
@@ -122,7 +140,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;

diff --git a/t/Slob.t b/t/Slob.t
index 395c59eba88286f79a890d2bf50c614efdccf8bd..ef2aa21bf2bfef5117bc6ab38ad03850b76a05b9 100644 (file)
--- a/t/Slob.t
+++ b/t/Slob.t
@@ -2,30 +2,32 @@
 use strict;
 use warnings;
 
-use Test::More tests => 7;
+use Test::More tests => 13;
 BEGIN { use_ok('Slob') };
 
-my $slob = Slob->new('t/freedict-01.slob');
+for my $path (qw/freedict-uncompressed.slob freedict-lzma2.slob/) {
+       my $slob = Slob->new("t/$path");
 
-my $nr_of_entries = $slob->ref_count;
+       my $nr_of_entries = $slob->ref_count;
 
-my $second_ref = $slob->seek_and_read_ref(4);
-my $bin = $slob->seek_and_read_storage_bin($second_ref->{bin_index});
+       my $second_ref = $slob->seek_and_read_ref(4);
+       my $bin = $slob->seek_and_read_storage_bin($second_ref->{bin_index});
 
-is $second_ref->{key}, 'abacus';
-is $second_ref->{bin_index}, 0;
-is $second_ref->{item_index}, 161;
-my $count = scalar @{$bin->{positions}};
-is $count, 637;
+       is $second_ref->{key}, 'abacus';
+       is $second_ref->{bin_index}, 0;
+       is $second_ref->{item_index}, 161;
+       my $count = scalar @{$bin->{positions}};
+       is $count, 637;
 
-my $expected = <<'EOF';
+       my $expected = <<'EOF';
 <html><head><link href="~/css/default.css" rel="stylesheet" type="text/css"><link href="~/css/night.css" rel="alternate stylesheet" title="Night" type="text/css"></head><script src="~/js/styleswitcher.js"></script><body><div class="form">
           <div class="orth">abacus</div><div class="pron">æbəkəs</div></div><ol class="sense single"><li class="sense">
           <ol class="cit single"><li class="cit trans">
             <ol class="quote single"><li class="quote">Rechenbrett</li></ol><div class="gramGrp">
               <div class="gen">m</div></div></li></ol></li></ol></body></html>
 EOF
-chomp $expected;
-is $slob->get_entry_of_storage_bin($bin, $second_ref->{item_index}), $expected;
+       chomp $expected;
+       is $slob->get_entry_of_storage_bin($bin, $second_ref->{item_index}), $expected;
 
-is $slob->seek_and_read_ref_and_data(4)->{data}, $expected;
+       is $slob->seek_and_read_ref_and_data(4)->{data}, $expected;
+}

diff --git a/t/freedict-01.slob b/t/freedict-01.slob
deleted file mode 100644 (file)
index c836579..0000000
Binary files a/t/freedict-01.slob and /dev/null differ

diff --git a/t/freedict-lzma2.slob b/t/freedict-lzma2.slob
new file mode 100644 (file)
index 0000000..c8d6483
Binary files /dev/null and b/t/freedict-lzma2.slob differ

diff --git a/t/freedict-uncompressed.slob b/t/freedict-uncompressed.slob
new file mode 100644 (file)
index 0000000..c836579
Binary files /dev/null and b/t/freedict-uncompressed.slob differ