File Coverage

blib/lib/Compress/LZW/Compressor.pm

Criterion	Covered	Total	%
statement	74	76	97.3
branch	28	32	87.5
condition	3	3	100.0
subroutine	10	10	100.0
pod	2	2	100.0
total	117	123	95.1

package Compress::LZW::Compressor;
# ABSTRACT: Scaling LZW compressor class
$Compress::LZW::Compressor::VERSION = '0.04';


use Compress::LZW qw(:const);

use Types::Standard qw( Bool Int );

use bytes;

use Moo;
use namespace::clean;

my $CHECKPOINT_BITS = 10_000;


has block_mode => (
  is      => 'ro',
  default => 1,
  isa     => Bool,
);


has max_code_size => ( # max bits
  is      => 'ro',
  default => 16,
  isa     => Type::Tiny->new(
    parent     => Int,
    constraint => sub { $_ >= $INIT_CODE_SIZE and $_ < $MASK_BITS },
    message    => sub { "$_ isn't between $INIT_CODE_SIZE and $MASK_BITS" },
  ),
);



sub compress {
  my $self = shift;
  my ( $str ) = @_;

  $self->reset;

  my $bytes_in;
  my ( $checkpoint, $last_ratio ) = ( 0, 0 );

  my $seen = '';

  for ( 0 .. length($str) ){
    my $char = substr($str, $_, 1);

    $bytes_in += 1;

    if ( exists $self->{code_table}{ $seen . $char } ){
      $seen .= $char;
    }
    else {
      $self->_buf_write( $self->{code_table}{ $seen } );

      $self->_new_code( $seen . $char );

      $seen = $char;

      if ( $self->{at_max_code} and $self->block_mode ){
        if ( ! defined $checkpoint ){
          $checkpoint = $self->{buf_pos} + $CHECKPOINT_BITS;
        }
        elsif ( $bytes_in > $checkpoint ){
          my $ratio   = $bytes_in / ( $self->{buf_pos} / 8 );
          $last_ratio = 0 if !defined $last_ratio;


          if ( $ratio >= $last_ratio ){
            $last_ratio = $ratio;
            $checkpoint = $self->{buf_pos} + $CHECKPOINT_BITS;
          }
          elsif ( $ratio < $last_ratio ){
            # warn "Resetting code table ( $ratio < $last_ratio :: $self->{buf_pos} )";
            $self->_buf_write( $RESET_CODE );
            $self->_code_reset;

            undef $checkpoint;
            undef $last_ratio;
          }
        }
      }

    }
  }

  $self->_buf_write( $self->{code_table}{ $seen } );  #last bit of input
  # warn "final ratio: " . ($bytes_in / ($self->{buf_pos} / 8));

  return $self->{buf};
}



sub reset {
  my $self = shift;

  # replace buf with empty buffer after magic bytes
  $self->{buf}     = $MAGIC
    . chr( $self->max_code_size | ( $self->block_mode ? $MASK_BLOCK : 0 ) );

  $self->{buf_pos} = length($self->{buf}) * 8;

  $self->_code_reset;
}


sub _code_reset {
  my $self = shift;

  $self->{code_table} = {
    map { chr($_) => $_ } 0 .. 255
  };

  $self->{at_max_code}   = 0;
  $self->{code_size}     = $INIT_CODE_SIZE;
  $self->{next_code}     = $self->block_mode ? $BL_INIT_CODE : $NR_INIT_CODE;
  $self->{next_increase} = 2 ** $self->{code_size};

}

sub _new_code {
  my $self = shift;
  my ( $word ) = @_;

  if ( $self->{next_code} >= $self->{next_increase} ){

    if ( $self->{code_size} < $self->{max_code_size} ){
      $self->{code_size}     += 1;
      $self->{next_increase} *= 2;
    }
    else {
      $self->{at_max_code} = 1;
    }
  }

  if ( $self->{at_max_code} == 0 ){
    $self->{code_table}{ $word } = $self->{next_code};
    $self->{next_code} += 1;
  }

}

sub _buf_write {
  my $self = shift;
  my ( $code ) = @_;

  return unless defined $code;

  if ( $code > ( 2 ** $self->{code_size} ) ){
    die "Code value $code too high for current code size $self->{code_size}";
  }

  my $wpos = $self->{buf_pos};
  # if ( $code == $RESET_CODE ){
  #   warn "wrote a reset code ($RESET_CODE) at $wpos";
  # }
  #~ warn "write $code \tat $code_size bits\toffset $wpos (byte ".int($wpos/8) . ')';

  if ( $code == 1 ){
    vec( $self->{buf}, $wpos, 1 ) = 1;
  }
  else {
    for my $bit ( 0 .. ($self->{code_size} - 1) ){

      if ( ($code >> $bit) & 1 ){
        vec( $self->{buf}, $wpos + $bit, 1 ) = 1;
      }
    }
  }

  $self->{buf_pos} += $self->{code_size};
}

1;

__END__