File Coverage

blib/lib/Aard.pm

Criterion	Covered	Total	%
statement	80	90	88.8
branch	10	18	55.5
condition			n/a
subroutine	23	33	69.7
pod	20	24	83.3
total	133	165	80.6

package Aard;

use 5.014000;
use strict;
use warnings;
our $VERSION = '0.001';

use IO::Uncompress::Inflate qw/inflate/;
use IO::Uncompress::Bunzip2 qw/bunzip2/;
use List::Util qw/sum/;

use JSON::MaybeXS qw/decode_json/;
use UUID::Tiny qw/uuid_to_string/;

use constant HEADER_SPEC => [
	[signature             => 'Z4' , 4 ],
	[sha1sum               => 'Z40', 40],
	[version               => 'S>' , 2 ],
	[uuid                  => 'Z16', 16],
	[volume                => 'S>' , 2 ],
	[total_volumes         => 'S>' , 2 ],
	[meta_length           => 'L>' , 4 ],
	[index_count           => 'L>' , 4 ],
	[article_offset        => 'L>' , 4 ],
	[index1_item_format    => 'Z4' , 4 ],
	[key_length_format     => 'Z2' , 2 ],
	[article_length_format => 'Z2' , 2 ],
];

my $header_length = sum map { $_->[2] } @{HEADER_SPEC()};

sub decompress {
	my ($input) = @_;
	my $output = $input;
	inflate \$input => \$output;
	bunzip2 \$input => \$output if $input =~ /^BZ/;
	$output
}

sub read_at {
	my ($self, $offset, $length) = @_;
	my $fh = $self->{fh};
	my $part;
	seek $fh, $offset, 0;
	read $fh, $part, $length;
	$part
}

sub index1 {
	my ($self, $index) = @_;
	unless (exists $self->{index1}{$index}) {
		my $part = $self->read_at($self->{index1_offset} + $index * $self->{index_length}, $self->{index_length});
		$self->{index1}{$index} = [unpack $self->{index_format}, $part]
	}
	$self->{index1}{$index}
}

sub fh            { shift->{fh} }
sub sha1sum       { shift->{sha1sum} }
sub uuid          { shift->{uuid} }
sub uuid_string   { uuid_to_string shift->uuid }
sub volume        { shift->{volume} }
sub total_volumes { shift->{total_volumes} }
sub count         { shift->{index_count} }

sub meta                          { shift->{meta} }
sub article_count                 { shift->meta->{article_count} }
sub article_count_is_volume_total { shift->meta->{article_count_is_volume_total} }
sub index_language                { shift->meta->{index_language} }
sub article_language              { shift->meta->{article_language} }
sub title                         { shift->meta->{title} }
sub version                       { shift->meta->{version} }
sub description                   { shift->meta->{description} }
sub copyright                     { shift->meta->{copyright} }
sub license                       { shift->meta->{license} }
sub source                        { shift->meta->{source} }

sub key {
	my ($self, $index) = @_;
	unless (exists $self->{key}{$index}) {
		my $part = $self->read_at($self->{index2_offset} + $self->index1($index)->[0], 2);
		my $len = unpack 'S>', $part;
		read $self->{fh}, $self->{key}{$index}, $len;
	}
	$self->{key}{$index}
}

sub article {
	my ($self, $index) = @_;
	unless (exists $self->{article}{$index}) {
		my $part = $self->read_at($self->{article_offset} + $self->index1($index)->[1], 4);
		my $len = unpack 'L>', $part;
		read $self->{fh}, $part, $len;
		$self->{article}{$index} = decompress $part
	}
	$self->{article}{$index}
}

sub new {
	my ($self, $file) = @_;
	open my $fh, '<', $file or die $!;
	binmode $fh;
	my %header;
	for (@{HEADER_SPEC()}) {
		read $fh, my $part, $_->[2];
		$header{$_->[0]} = unpack $_->[1], $part;
	}

	die 'Not a recognized aarddict dictionary file' if $header{signature} ne 'aard';
	die 'Unknown file format version' if $header{version} != 1;

	read $fh, my $meta, $header{meta_length};
	$meta = decode_json decompress $meta;

	my %obj = (
		%header,
		fh => $fh,
		meta => $meta,
		index_format => ($header{index1_item_format} eq '>LL' ? 'L>L>' : 'L>Q>'),
		index_length => ($header{index1_item_format} eq '>LL' ? 8 : 12),
	);
	$obj{index1_offset} = $header_length + $obj{meta_length};
	$obj{index2_offset} = $obj{index1_offset} + $obj{index_count} * $obj{index_length};
	bless \%obj, $self
}

1;
__END__