6 our $VERSION = '0.002002';
8 use constant MAGIC
=> "!-1SLOB\x1F";
10 use Carp qw
/croak verbose/;
13 use Compress
::Raw
::Bzip2
;
14 use Compress
::Raw
::Lzma
;
15 use Compress
::Raw
::Zlib
;
17 # MD5 only used for debugging output in tests
18 use Digest
::MD5 qw
/md5_hex/;
24 my ($lzma2, $code, $output);
25 ($lzma2, $code) = Compress
::Raw
::Lzma
::RawDecoder
->new(Filter
=> Lzma
::Filter
::Lzma2
());
26 die "Error creating LZMA2 decoder: $code\n" unless $code == LZMA_OK
;
28 $code = $lzma2->code($input, $output);
29 die "Did not reach end of stream\n" if $code == LZMA_OK
;
30 die "Error decoding LZMA2: $code\n" if $code != LZMA_STREAM_END
;
36 my ($bz2, $code, $output);
37 ($bz2, $code)= Compress
::Raw
::Bunzip2
->new;
38 die "Error creating Bunzip2: $code\n" unless $code == Z_OK
;
40 $code = $bz2->bzinflate($input, $output);
41 die "Did not reach end of stream\n" if $code == BZ_OK
;
42 die "Error decoding Bzip2: $code\n" if $code != BZ_STREAM_END
;
49 my ($zlib, $code, $output);
50 ($zlib, $code) = Compress
::Raw
::Zlib
::Inflate
->new(
51 -WindowBits
=> WANT_GZIP_OR_ZLIB
53 die "Error creating Zlib inflate: $code\n" unless $code == Z_OK
;
55 $code = $zlib->inflate($input, \
$output, 1);
56 die "Did not reach end of stream\n" if $code == Z_OK
;
57 die "Error inflating zlib: $code\n" if $code != Z_STREAM_END
;
63 my ($class, $path) = @_;
65 if (ref $path eq 'IO') {
68 open $fh, '<', $path or croak
"Cannot open \"$path\": $!";
71 my $self = bless {path
=> $path, fh
=> $fh}, $class;
72 $self->{header
} = $self->read_header;
77 my ($self, $len) = @_;
79 my $result = read $self->{fh
}, $data, $len;
80 if (!defined $result) {
81 croak
"Failed to read from $self->{path}: $!"
82 } elsif ($result == $len) {
84 } elsif ($result == 0) {
85 croak
"$self->{path} is at end of file"
86 } elsif ($result < $len) {
87 croak
"Only read $result bytes of $self->{path} before reaching EOF"
92 my ($self, $len_of_format, $format) = @_;
93 unpack $format, $self->read_data($len_of_format);
96 sub read_char
{ shift->read_formatted(1, 'C') }
97 sub read_short
{ shift->read_formatted(2, 'n') }
98 sub read_int
{ shift->read_formatted(4, 'N') }
99 sub read_long
{ shift->read_formatted(8, 'Q>') }
102 my ($self, $encoding) = @_;
103 my $data = $self->read_data($self->read_char);
104 if (length $data == 255) {
105 $data = unpack 'Z*', $data;
107 $encoding //= $self->{encoding
};
108 decode
$encoding, $data;
112 my ($self, $encoding) = @_;
113 my $data = $self->read_data($self->read_short);
114 $encoding //= $self->{encoding
};
115 decode
$encoding, $data;
118 sub read_large_byte_string
{
120 $self->read_data($self->read_short)
125 my $name = $self->read_tiny_text;
126 my $value = $self->read_tiny_text;
132 my $tag_count = $self->read_char;
133 map { $self->read_tag } 1..$tag_count
136 sub read_content_types
{
138 my $content_type_count = $self->read_char;
139 map { $self->read_text } 1..$content_type_count
144 my $count = $self->read_int;
145 my @positions = map { $self->read_long } 1..$count;
146 my $relative_to = $self->ftell;
147 map { $relative_to + $_ } @positions
151 my ($self, $position) = @_;
152 seek $self->{fh
}, $position, 0 or croak
"Failed to seek to byte $position"
157 my $result = tell $self->{fh
};
158 croak
"Failed to tell position in file" if $result == -1;
163 my ($self, $data) = @_;
164 my $compression = $self->{header
}{compression
};
165 if ($ENV{HARNESS_ACTIVE
} && $compression eq 'lzma2') {
166 my $prefix = unpack 'H*', substr $data, 0, 10;
167 my $md5sum = md5_hex
$data;
168 Test
::More
::diag
"Uncompressing data starting '$prefix', md5sum $md5sum";
170 $UNCOMPRESS{$compression}->($data)
175 my $magic = $self->read_data(length MAGIC
);
176 croak
"Not a SLOB dictionary" unless MAGIC
eq $magic;
177 my $uuid = $self->read_data(16);
179 my $encoding = $self->read_tiny_text('UTF-8');
180 $self->{encoding
} = $encoding;
182 my $compression = $self->read_tiny_text;
183 die "Compression '$compression' not yet supported" unless exists $UNCOMPRESS{$compression};
184 my %tags = $self->read_tags;
185 my @content_types = $self->read_content_types;
186 my $blob_count = $self->read_int;
187 my $store_offset = $self->read_long;
188 my $size = $self->read_long;
189 my @refs = $self->read_positions;
191 $self->fseek($store_offset);
192 my @storage_bins = $self->read_positions;
196 encoding
=> $encoding,
197 compression
=> $compression,
199 content_types
=> \
@content_types,
200 blob_count
=> $blob_count,
201 store_offset
=> $store_offset,
204 storage_bins
=> \
@storage_bins,
210 my $key = $self->read_text;
211 my $bin_index = $self->read_int;
212 my $item_index = $self->read_short;
213 my $fragment = $self->read_tiny_text;
216 bin_index
=> $bin_index,
217 item_index
=> $item_index,
218 fragment
=> $fragment,
222 sub read_storage_bin
{
224 my $count = $self->read_int;
225 my @content_types = map { $self->read_char } 1..$count;
226 my $compressed_size = $self->read_int;
227 my $compressed_data = $self->read_data($compressed_size);
228 my $uncompressed_data = $self->uncompress($compressed_data);
230 my @positions = unpack "N$count", $uncompressed_data;
231 my $data = substr $uncompressed_data, $count * 4;
233 positions
=> \
@positions,
238 sub ref_count
{ shift @
{shift->{header
}{refs
}} }
240 sub seek_and_read_ref
{
241 my ($self, $index) = @_;
242 croak
"No ref has index $index" unless exists $self->{header
}{refs
}[$index];
243 $self->fseek($self->{header
}{refs
}[$index]);
247 sub seek_and_read_storage_bin
{
248 my ($self, $index) = @_;
249 croak
"No storage bin has index $index" unless exists $self->{header
}{storage_bins
}[$index];
250 $self->fseek($self->{header
}{storage_bins
}[$index]);
251 $self->read_storage_bin
254 sub get_entry_of_storage_bin
{
255 my ($self, $storage_bin, $index) = @_;
256 my $start_of_data = substr $storage_bin->{data
}, $storage_bin->{positions
}[$index];
257 my $length = unpack 'N', $start_of_data;
258 substr $start_of_data, 4, $length;
261 sub seek_and_read_ref_and_data
{
262 my ($self, $index) = @_;
263 my $ref = $self->seek_and_read_ref($index);
264 my $bin = $self->seek_and_read_storage_bin($ref->{bin_index
});
265 my $data = $self->get_entry_of_storage_bin($bin, $ref->{item_index
});
266 $ref->{data
} = $data;
277 Slob - Read .slob dictionaries (as used by Aard 2)
281 use feature qw/:5.14/;
283 my $slob = Slob->new('path/to/dict.slob');
285 my $nr_of_entries = $slob->ref_count; # if the same content has two
286 # keys pointing to it, this
289 my $second_ref = $slob->seek_and_read_ref(4);
290 say "Entry is for $second_ref->{key}";
291 say "Data is in bin $second_ref->{bin_index} at position $second_ref->{item_index}";
293 my $bin = $slob->seek_and_read_storage_bin($second_ref->{bin_index});
294 say "Bin has ", (scalar @{$bin->{positions}}), " entries";
295 say "Value at position $second_ref->{item_index} is ",
296 $slob->get_entry_of_storage_bin($bin, $second_ref->{item_index});
298 # instead of the above, we can do
299 my $second_ref_and_data = $slob->seek_and_read_ref_and_data(4);
300 say "Entry is for $second_ref_and_data->{key}";
301 say "Value is $second_ref_and_data->{data}";
305 Slob is a compressed read-only format for storing natural language
306 dictionaries. It is used in Aard 2. C<Slob.pm> is a module that reads
307 dictionaries in slob format.
309 The following methods are available:
313 =item Slob->B<new>(I<$path>)
314 =item Slob->B<new>(I<$fh>)
316 Create a new slob reader reading from the given path or filehandle.
318 =item $slob->B<ref_count>
320 The number of refs (keys) in the dictionary.
322 =item $slob->B<seek_and_read_ref>(I<$index>)
324 Read the ref (key) at the given index. Returns a hashref with the
335 The storage bin that contains the value for this key
339 The index in the bin_index storage bin of the value for this key
343 HTML fragment that, when applied to the HTML value, points to the
344 definition of the key.
348 =item $slob->B<seek_and_read_storage_bin>(I<$index>)
350 Read the storage bin with the given index. Returns the storage bin,
351 which can later be given to B<get_entry_of_storage_bin>.
353 =item $slob->B<get_entry_of_storage_bin>(I<$bin>, I<$index>)
355 Given a storage bin (as returned by C<seek_and_read_storage_bin>) and
356 item index, returns the value at the index i nthe storage bin.
358 =item $slob->B<seek_and_read_ref_and_data>($index)
360 Convenience method that returns the key and value at a given index.
361 Returns a hashref like C<seek_and_read_ref> with an extra key,
362 I<data>, which is the value of the key.
368 L<https://github.com/itkach/slob>
372 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
374 =head1 COPYRIGHT AND LICENSE
376 Copyright (C) 2017-2018 by Marius Gavrilescu
378 This library is free software; you can redistribute it and/or modify
379 it under the same terms as Perl itself, either Perl version 5.26.1 or,
380 at your option, any later version of Perl 5 you may have available.