File Coverage

blib/lib/Data/BitStream.pm

Criterion	Covered	Total	%
statement	90	91	98.9
branch	47	58	81.0
condition	2	6	33.3
subroutine	12	12	100.0
pod	5	5	100.0
total	156	172	90.7

package Data::BitStream;
# I have tested with 5.6.2 through 5.17.7 using Mouse.
# Moo requires perl 5.8.1, Moose requires 5.8.3.
use strict;
use warnings;

our $VERSION = '0.08';

# Since we're using Moo, things get rather messed up if we try to
# inherit from Exporter.  Really all we want is the ability to let people
# use a couple convenience functions, so just grab the import method.
use Exporter qw(import);
our @EXPORT_OK = qw( code_is_supported code_is_universal );


# Our class methods to support referencing codes by text names.
my %codeinfo;

sub add_code {
  my $rinfo = shift;
  die "add_code needs a hash ref" unless defined $rinfo && ref $rinfo eq 'HASH';
  foreach my $p (qw(package name universal params encodesub decodesub)) {
    die "invalid registration: missing $p" unless defined $$rinfo{$p};
  }
  my $name = lc $$rinfo{'name'};
  if (defined $codeinfo{$name}) {
    return 1 if $codeinfo{$name}{'package'} eq $$rinfo{'package'};
    die "module $$rinfo{'package'} trying to reuse code name '$name' already in use by $codeinfo{$name}{'package'}";
  }
  $codeinfo{$name} = $rinfo;
  1;
};

sub _find_code {
  my $code = lc shift;

  return $codeinfo{$code} if defined $codeinfo{$code};

  # Load codes from base
  if (   defined $Data::BitStream::Base::CODEINFO
      && ref $Data::BitStream::Base::CODEINFO eq 'ARRAY') {
    foreach my $r (@{$Data::BitStream::Base::CODEINFO}) {
      next unless ref $r eq 'HASH';
      add_code($r);
    }
  }

  # Load info for all code modules that have been included
  foreach my $module (keys %Data::BitStream::Code::) {
    # module is 'Gamma::'  mname is 'Gamma'
    my ($mname) = $module =~ /(.+)::$/;
    next unless defined $mname;
    # Load the CODEINFO variable, skip if it isn't found
    my $rinfo;
    {
      my $pname = 'Data::BitStream::Code::' . $module;
      no strict 'refs';  ## no critic
      $rinfo = ${$pname}{'CODEINFO'};
      next unless defined $rinfo;
      next unless $rinfo =~ s/^\*//;
      $rinfo = ${$rinfo};
    }
    next unless defined $rinfo;
    if (ref $rinfo eq 'HASH') {
      add_code($rinfo);
    } elsif (ref $rinfo eq 'ARRAY') {
      foreach my $r (@{$rinfo}) {
        next unless ref $r eq 'HASH';
        add_code($r);
      }
    }
  }

  $codeinfo{$code};
};

sub code_is_supported {
  my $code = lc shift;
  my $param;  $param = $1 if $code =~ s/\((.+)\)$//;
  return defined _find_code($code);
}

sub code_is_universal {
  my $code = lc shift;
  my $param;  $param = $1 if $code =~ s/\((.+)\)$//;
  my $inforef = _find_code($code);
  return unless defined $inforef;  # Unknown code.
  return $inforef->{'universal'};
}


# Pick one implementation as the default.
#
# BLVec uses the Data::BitStream::XS class, and is 50-100x faster than the
# others for most codes.
#
# WordVec is the preferred Pure Perl implementation, being both space and time
# efficient.
#
# String is simple and surprisingly fast, but uses more memory (1 byte per bit).
#
# Vec is deprecated.
#
# MinimalVec is for example only.
#
# BitVec uses Bit::Vector to try to obtain better performance.  While a few
# operations (e.g. get_unary) can be fast, in general it is as slow or slower
# than the WordVec implementation.  The main issue is that Bit::Vector uses a
# little-endian representation which does not match what we want.
#
# bench-codes with many codes, sum:
#
#   BLVec       4829 ns encode    11102 ns decode   71   x
#   String    403470 ns encode   494878 ns decode    1.3 x
#   WordVec   457533 ns encode   676737 ns decode    1.0
#   BitVec    492701 ns encode   666711 ns decode    0.98x
#   Vec       549342 ns encode   927764 ns decode    0.77x
#   MinmlVec  554690 ns encode  8252307 ns decode    0.13x
#
# A 32-bit HP 9000/785 gave similar results though ~15x slower overall.

use Moo;
if (eval {require Data::BitStream::BLVec}) {
  extends 'Data::BitStream::BLVec';
} else {
  extends 'Data::BitStream::WordVec';
}

# get and put methods for referencing codes by text names
sub code_put {
  my $self = shift;
  my $code = lc shift;
  my $param;  $param = $1 if $code =~ s/\((.+)\)$//;
  my $inforef = _find_code($code);
  die "Unknown code $code" unless defined $inforef;
  my $sub = $inforef->{'encodesub'};
  die "No encoding sub for code $code!" unless defined $sub;
  if ($inforef->{'params'}) {
    die "Code $code needs a parameter" unless defined $param;
    return $sub->($self, $param, @_);
  } else {
    die "Code $code does not have parameters" if defined $param;
    return $sub->($self, @_);
  }
}

sub code_get {
  my $self = shift;
  my $code = lc shift;
  my $param;  $param = $1 if $code =~ s/\((.+)\)$//;
  my $inforef = _find_code($code);
  die "Unknown code $code" unless defined $inforef;
  my $sub = $inforef->{'decodesub'};
  die "No decoding sub for code $code!" unless defined $sub;
  if ($inforef->{'params'}) {
    die "Code $code needs a parameter" unless defined $param;
    return $sub->($self, $param, @_);
  } else {
    die "Code $code does not have parameters" if defined $param;
    return $sub->($self, @_);
  }
}

__PACKAGE__->meta->make_immutable;
no Moo;

1;
__END__