EBook::Tools::LZSS - Lempel-Ziv-Storer-Szymanski compression and decompression

 use EBook::Tools::LZSS;
 my $lzss = EBook::Tools::LZSS->new(lengthbits => 3,
                                    offsetbits => 14,
                                    windowinit => 'the man');
 my $textref = $lzss->uncompress(\$data);

package EBook::Tools::LZSS;
use warnings; use strict; use utf8;
use English qw( -no_match_vars );
use version 0.74; our $VERSION = qv("0.4.8");

# Perl Critic overrides:
## no critic (Package variable)
# RequireBriefOpen seems to be way too brief to be useful
## no critic (RequireBriefOpen)
# Double-sigils are needed for lexical filehandles in clear print statements
## no critic (Double-sigil dereference)

require Exporter;
use base qw(Exporter);

our @EXPORT_OK;
@EXPORT_OK = qw (
    );
our %EXPORT_TAGS = ('all' => [@EXPORT_OK]);


use Bit::Vector;
use Carp;
use EBook::Tools qw(:all);
use Encode;
use File::Basename qw(dirname fileparse);
use File::Path;     # Exports 'mkpath' and 'rmtree'
binmode(STDERR,":utf8");


use constant ENCODED => 0;
use constant UNCODED => 1;



####################################################
########## CONSTRUCTOR AND INITIALIZATION ##########
####################################################

my %rwfields = (
    'lengthbits'  => 'integer',
    'offsetbits'  => 'integer',
    'windowinit'  => 'string',
    'windowsize'  => 'integer',
    'windowstart' => 'integer',
    'maxuncoded'  => 'integer',
    'screwybits'  => 'boolean',
    'verbose'     => 'integer',
    );
my %rofields = (
    );
my %privatefields = (
);

# A simple 'use fields' will not work here: use takes place inside
# BEGIN {}, so the @...fields variables won't exist.
require fields;
fields->import(
    keys(%rwfields),keys(%rofields),keys(%privatefields)
    );

sub new   ## no critic (Always unpack @_ first)
{
    my $self = shift;
    my $class = ref($self) || $self;
    my %args = @_;
    my $subname = (caller(0))[3];
    debug(2,"DEBUG[",$subname,"]");

    my %valid_args = (
        'lengthbits'  => 1,
        'offsetbits'  => 1,
        'windowinit'  => 1,
        'windowstart' => 1,
        'maxuncoded'  => 1,
        'screwybits'  => 1,
        'verbose'     => 1,
        );

    foreach my $arg (keys %args)
    {
        croak($subname,"(): invalid argument '",$arg,"'")
            if(!$valid_args{$arg});
    }

    $self = fields::new($class);
    $self->{lengthbits} = $args{lengthbits} || 4;
    $self->{offsetbits} = $args{offsetbits} || 12;
    $self->{windowsize} = 1 << $self->{offsetbits};
    $self->{windowinit} = $args{windowinit} || ' ' x $self->{windowsize};
    if(defined $args{windowstart})
    {
        $self->{windowstart} = $args{windowstart};
    }
    else { $self->{windowstart} = 0; }
    $self->{maxuncoded} = $args{maxuncoded} || 2;
    $self->{screwybits} = $args{screwybits};
    $self->{verbose} = $args{verbose} || 0;

    if($self->{windowinit}
       and length($self->{windowinit}) != $self->{windowsize})
    {
        croak($subname,"(): \n window initialization string size (",
              length($self->{windowinit}),
              " does not match specified number of offset bits (",
              $self->{windowsize},")\n")
    }

    return $self;
}


#############################
########## METHODS ##########
#############################

sub uncompress :method
{
    my $self = shift;
    my ($dataref) = @_;
    my $subname = (caller(0))[3];
    debug(2,"DEBUG[",$subname,"]");

    croak($subname,"(): no data provided!\n")
        unless($dataref);
    croak($subname,"(): data is not a reference!\n")
        unless(ref $dataref);

    my $lengthbits = $self->{lengthbits} || 4;
    my $offsetbits = $self->{offsetbits} || 12;
    my $windowsize = $self->{windowsize};
    my $window = $self->{windowinit};
    my $max_uncoded = $self->{maxuncoded} || 2;
    my $max_encoded = (1 << $lengthbits) + $max_uncoded;
    my $windowpos = $self->{windowstart} || 0;

    if(length($window) != $windowsize)
    {
        croak($subname,"(): \n window initialization string size (",
              length($window),
              " does not match specified number of offset bits (",
              $windowsize,")\n")
    }

    if($self->{verbose} > 1)
    {
        print {*STDERR} ("Uncompressing with ",$lengthbits," length bits, ",
                         $offsetbits," offset bits, windowpos = ",
                         $windowpos,"\n");
    }

    my $bitsize = length($$dataref) * 8;
    my $bitvector = Bit::Vector->new($bitsize);
    my $bitoffset;
    my $bitpos = 0;
    my $bits;

    my $encflag;
    my $dataoffset = 0;
    my $lzss_offset;
    my $lzss_length;
    my $lzss_text;
    my $uncompressed;

    # Unfortunately, the bitstream needs to be processed from left to
    # right, and Bit::Vector really likes to process from right to
    # left, so we have to process by chunk instead of using
    # Block_Store
    while($bitpos < $bitsize)
    {
        $bitoffset = $bitsize-$bitpos;
        $bits = unpack('C',substr($$dataref,$dataoffset,1));
        $bitvector->Chunk_Store(8,$bitoffset-8,$bits);
        $dataoffset++;
        $bitpos += 8;
    }

    $bitpos = 0;
    while($bitpos < $bitsize - 8)
    {
        # If there are less than 8 bits left, there's nothing to
        # decode and we can stop.  Otherwise, uncompress.

        if($self->{verbose} or $EBook::Tools::debug > 0)
        {
            my $percent = int( ($bitpos / $bitsize) * 100);

            print("Uncompressing text... [",$percent,"%]\r")
                if($percent % 5 == 0);
        }
        $bitoffset = $bitsize - $bitpos;
        $encflag = $bitvector->Chunk_Read(1,$bitoffset-1);
        $bitpos++;
        $bitoffset--;

        if($encflag == UNCODED)
        {
            if($bitoffset - 8 < 0)
            {
                debug(1,"DEBUG: ran out of bits at bit position ",
                      $bitpos,"!");
                last;
            }

            $bitoffset -= 8;
            $bitpos += 8;
            $bits = $bitvector->Chunk_Read(8,$bitoffset);
            $uncompressed .= chr($bits);
            substr($window,$windowpos,1,chr($bits));
            $windowpos++;
            $windowpos %= $windowsize;
        }
        else
        {
            if($bitoffset - ($offsetbits + $lengthbits) < 0)
            {
                if($bitoffset >= 16)
                {
                    carp($subname,,"(): ran out of bits at bit position ",
                          $bitpos," [",$bitoffset," bits remaining]!");
                }
                last;
            }
            if($self->{screwybits} and $offsetbits > 8)
            {
                my $lowoffset;
                my $highoffset;
                my $extrabits = $offsetbits - 8;

                $bitoffset -= 8;
                $lowoffset = $bitvector->Chunk_Read(8,$bitoffset);
                $bitoffset -= $extrabits;
                $highoffset = $bitvector->Chunk_Read($extrabits,$bitoffset);

                $lzss_offset = (256 * $highoffset) + $lowoffset;
            }
            else
            {
                $bitoffset -= $offsetbits;
                $lzss_offset = $bitvector->Chunk_Read($offsetbits,$bitoffset);
            }
            $bitoffset -= $lengthbits;
            $lzss_length = $bitvector->Chunk_Read($lengthbits,$bitoffset);

            if($lzss_offset > $windowsize)
            {
                carp($subname,"(): LZSS offset points outside window!\n");
                last;
            }

            if($lzss_length == 0
               and $lzss_offset == 0)
            {
                if($bitoffset >= 16)
                {
                    carp($subname,"(): invalid LZSS code at bit position ",
                         $bitpos," [",$bitoffset," bits remaining]!\n");
                }
                last;
            }
            $bitpos += ($offsetbits + $lengthbits);
            $lzss_length += $max_uncoded + 1;

            foreach my $lzss_pos (0 .. ($lzss_length - 1) )
            {
                my $windowoffset;
                my $char = substr($window,
                                  ($lzss_offset + $lzss_pos) % $windowsize,
                                  1);
                substr($window,$windowpos,1,$char);
                $windowpos++;
                $windowpos %= $windowsize;
                $uncompressed .= $char;
            }
        }
    }

    if($self->{verbose} or $EBook::Tools::debug > 0)
    {
        print("Finished uncompressing text.\n");
    }
    return \$uncompressed;
}


################################
########## PROCEDURES ##########
################################


########## END CODE ##########

1;
__END__