File Coverage

blib/lib/Data/BitStream/MinimalVec.pm

Criterion	Covered	Total	%
statement	46	46	100.0
branch	17	24	70.8
condition	8	18	44.4
subroutine	8	8	100.0
pod	2	2	100.0
total	81	98	82.6

package Data::BitStream::MinimalVec;
use strict;
use warnings;
BEGIN {
  $Data::BitStream::MinimalVec::AUTHORITY = 'cpan:DANAJ';
  $Data::BitStream::MinimalVec::VERSION   = '0.08';
}

use Moo;

with 'Data::BitStream::Base',
     'Data::BitStream::Code::Gamma',
     'Data::BitStream::Code::Delta',
     'Data::BitStream::Code::Omega',
     'Data::BitStream::Code::Levenstein',
     'Data::BitStream::Code::EvenRodeh',
     'Data::BitStream::Code::Fibonacci',
     'Data::BitStream::Code::Golomb',
     'Data::BitStream::Code::Rice',
     'Data::BitStream::Code::GammaGolomb',
     'Data::BitStream::Code::ExponentialGolomb',
     'Data::BitStream::Code::Baer',
     'Data::BitStream::Code::BoldiVigna',
     'Data::BitStream::Code::ARice',
     'Data::BitStream::Code::Additive',
     'Data::BitStream::Code::Comma',
     'Data::BitStream::Code::Taboo',
     'Data::BitStream::Code::BER',
     'Data::BitStream::Code::Varint',
     'Data::BitStream::Code::StartStop';

has '_vec' => (is => 'rw', default => sub{''});

sub _vecref { \shift->{_vec} }
after 'erase' => sub { shift->_vec(''); 1; };

sub read {
  my $self = shift;
  $self->error_stream_mode('read') if $self->writing;
  my $bits = shift;
  $self->error_code('param', 'bits must be in range 1-' . $self->maxbits)
         unless defined $bits && $bits > 0 && $bits <= $self->maxbits;
  my $peek = (defined $_[0]) && ($_[0] eq 'readahead');

  my $pos = $self->pos;
  my $len = $self->len;
  return if $pos >= $len;
  $self->error_off_stream if !$peek && ($pos+$bits) > $len;

  my $val = 0;
  my $rvec = $self->_vecref;
  foreach my $bit (0 .. $bits-1) {
    $val = ($val << 1) | vec($$rvec, $pos+$bit, 1);
  }
  $self->_setpos( $pos + $bits ) unless $peek;
  $val;
}
sub write {
  my $self = shift;
  $self->error_stream_mode('write') unless $self->writing;
  my $bits = shift;
  $self->error_code('param', 'bits must be > 0') unless defined $bits && $bits > 0;
  my $val  = shift;
  $self->error_code('zeroval') unless defined $val and $val >= 0;

  my $len  = $self->len;
  my $rvec = $self->_vecref;

  if ($val == 0) {
    # nothing
  } elsif ($val == 1) {
    vec($$rvec, $len + $bits - 1, 1) = 1;
  } else {
    $self->error_code('param', 'bits must be <= ' . $self->maxbits) if $bits > $self->maxbits;

    my $wpos = $len + $bits-1;
    foreach my $bit (0 .. $bits-1) {
      vec($$rvec, $wpos - $bit, 1) = 1  if  (($val >> $bit) & 1);
    }
  }

  $self->_setlen( $len + $bits);
  1;
}

# default everything else

__PACKAGE__->meta->make_immutable;
no Moo;
1;

# ABSTRACT: A minimal implementation of Data::BitStream

=pod

=head1 NAME

Data::BitStream::MinimalVec - A minimal implementation of Data::BitStream

=head1 SYNOPSIS

  use Data::BitStream::MinimalVec;
  my $stream = Data::BitStream::MinimalVec->new;
  $stream->put_gamma($_) for (1 .. 20);
  $stream->rewind_for_read;
  my @values = $stream->get_gamma(-1);

=head1 DESCRIPTION

An implementation of L.  See the documentation for that
module for many more examples, and L for the API.
This document only describes the unique features of this implementation,
which is of limited value to people purely using L.

This implementation uses a Perl C to store the data, and shows basically
the minimal work required to get an implementation working.  Everything else
is provided by the base class.  It is slow, and L
is recommended for real work.

=head2 DATA

=over 4

=item B< _vec >

A private scalar holding the data as a vector.

=back

=head2 CLASS METHODS

=over 4

=item B< _vecref >

Retrieves a reference to the private vector.

=item I B< erase >

Sets the private vector to the empty string C<''>.

=item B< read >

=item B< write >

These methods have custom implementations.

=back

=head2 ROLES

The following roles are included.

=over 4

=item L

=item L

=item L

=item L

=item L

=item L

=item L

=item L

=item L

=item L

=item L

=item L

=item L

=item L

=item L

=item L

=item L

=item L

=back

=head1 SEE ALSO

=over 4

=item L

=item L

=item L

=back

=head1 AUTHORS

Dana Jacobsen [e-mail]

=head1 COPYRIGHT

Copyright 2011-2012 by Dana Jacobsen [e-mail]

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

=cut