File Coverage

blib/lib/Net/OnlineCode/Decoder.pm

Criterion	Covered	Total	%
statement	24	98	24.4
branch	0	18	0.0
condition	0	9	0.0
subroutine	8	13	61.5
pod	0	5	0.0
total	32	143	22.3

package Net::OnlineCode::Decoder;

use strict;
use warnings;

use Carp;

use Net::OnlineCode;
use Net::OnlineCode::GraphDecoder;
use Net::OnlineCode::Bones;

require Exporter;

use vars qw(@ISA @EXPORT_OK @EXPORT %EXPORT_TAGS $VERSION);

# Inherit from base class
@ISA = qw(Net::OnlineCode Exporter);
@EXPORT_OK = qw();

$VERSION = '0.04';

use constant DEBUG => 0;

sub new {

  my $class = shift;

  my %opts = (
              # decoder-specific arguments:
              expand_aux  => 0,    # override parent class's default
              expand_msg  => 1,    # expand_* options used by expansion()
              initial_rng => undef,
              # user-supplied arguments:
              @_
             );
  unless (ref($opts{initial_rng})) {
    carp "$class->new requires an initial_rng => \$rng parameter\n";
    return undef;
  }

  # Send all arguments to the base class. It does basic parameter
  # handling/mangling, calculates the number of auxiliary blocks based
  # on them and generates a probability distribution.

  my $self = $class->SUPER::new(@_);

  # Our subclass includes extra data/options
  $self->{expand_msg}=$opts{expand_msg};
  my $graph = Net::OnlineCode::GraphDecoder->new
    (
     $self->{mblocks},
     $self->{ablocks},
     $self->auxiliary_mapping($opts{initial_rng}),
    );
  $self->{graph} = $graph;

  # print "Decoder: returning from constructor\n";
  return $self;

}

sub accept_check_block {
  my $self = shift;
  my $rng  = shift;

  # print "Decoder: calling checkblock_mapping\n";
  my $composite_blocks = $self->checkblock_mapping($rng);

  print "Decoder check block: " . (join " ", @$composite_blocks)
    . "\n" if DEBUG;

  # print "Decoder: Adding check block to graph\n";
  my $check_node = $self->{graph}->add_check_block($composite_blocks);

  ++($self->{chblocks});

  # Caller will now have to call resolve manually ...
  # print "Decoder: Resolving graph\n";
  # ($self->{graph}->resolve($check_node));

  # caller probably won't use return value, but if they do it makes
  # sense to return zero-based array index

  return $check_node - $self->get_coblocks;

}

# pass calls to resolve onto graph decoder object
sub resolve {
  my ($self,@args) = @_;

  $self->{graph}->resolve(@args);
}

# new routine to replace xor_list; does "lazy" expansion of node lists
# from graph object, honouring the expand_aux and (new) expand_msg
# flags.
sub expansion {

  my ($self, $bone_or_node) = @_;

  my ($bone, $node);

  if (ref($bone_or_node)) {
    $bone = $bone_or_node;
    $node = $bone->[1];
  } else {
    $node = $bone_or_node;
    $bone = $self->{graph}->{solution}->[$node];
  }

  # pull out frequently-used variables (using hash slice)
  my ($expand_aux,$expand_msg) = @{$self}{"expand_aux","expand_msg"};
  my ($mblocks,$coblocks)      = @{$self}{"mblocks","coblocks"};


  # Stage 1: collect list of nodes in the expansion, honouring flags
  my ($min, $max) = $bone->knowns_range;
  my $in = [ @{$bone}[$min .. $max] ];
  my ($out,$expanded,$done) = ([],0,0);

  if (DEBUG) {
    print "Expander got initial bone " . $bone->pp . "\n";
    print "It has known range of [$min,$max]\n";
    print "The values are " . (join ", ", @{$bone}[$min .. $max]) . "\n";
    print "Expansion: node ${node}'s input list is " . (join " ", @$in) . "\n";
  }

  until ($done) {
    # we may need several loops to expand everything since aux blocks
    # may appear in the expansion of message blocks and vice-versa.
    # It's possible to do the expansion with just one loop, but the
    # code is more messy/complicated.

    for my $i (@$in) {
      if ($expand_msg and $i < $mblocks) {
        ++$expanded;
	$bone = $self->{solution}->[$i];
	($min, $max) = $bone->knowns_range;
        push @$out, ($bone->[$min .. $max]);
      } elsif ($expand_aux and $i >= $mblocks and $i < $coblocks) {
        ++$expanded;
	$bone = $self->{solution}->[$i];
	($min, $max) = $bone->knowns_range;
        push @$out, ($bone->[$min .. $max]);
      } else {
        push @$out, $i;
      }
    }
    $done = 1 unless $expanded;
  } continue {
    ($in,$out) = ($out,[]);
    $expanded = 0;
  }

  # test expansion after stage 1
  if (0) {
    for my $i (@$in) {
      if ($expand_aux) {
	die "raw expanded list had aux blocks after stage 1\n"
	  if $i >= $mblocks and $i < $coblocks;
      }
      if ($expand_msg) {
	die "raw expanded list had msg blocks after stage 1\n"
	  if $i < $mblocks;
      }
    }
  }

  if (DEBUG) {
    print "Expansion: list after expand_* is " . (join " ", @$in) . "\n";
  }

  # Stage 2: sort the list
  my @sorted = sort { $a <=> $b } @$in;

  # Stage 3: create output list containing only nodes that appear an
  # odd number of times
  die "expanded list was empty\n" unless @sorted;

  my ($previous, $runlength) = ($sorted[0], 0);
  my @output = ();

  foreach my $i (@sorted, -1) {	# -1 is a sentinel
    if ($i == $previous) {
      ++$runlength;
    } else {
      push @output, $previous if $runlength & 1;
      $previous = $i;
      $runlength = 1;
    }
  }

  # test expansion after stage 3
  if (0) {
    for my $i (@output) {
      if ($expand_aux) {
	die "raw expanded list had aux blocks after stage 3\n"
	  if $i >= $mblocks and $i < $coblocks;
      }
      if ($expand_msg) {
	die "raw expanded list had msg blocks after stage 3\n"
	  if $i < $mblocks;
      }
    }
  }

  # Finish: return list
  return @output;

}

# expand_aux already handled in graph object (DELETEME)
sub xor_list {
  my $self = shift;
  my $i = shift;

  return ($self->{graph}->xor_list($i));

  # algorithm will no longer return just composite blocks


  my $coblocks = $self->get_coblocks;

  # the graph object assigns check blocks indexes after the composite
  # blocks, but the user would prefer to count them from zero:

  my @list = map { $_ - $coblocks } ($self->{graph}->xor_list($i));

  foreach (@list) { die "xor_list: $_ is negative!\n" if $_ < 0; }

  return @list;
}

1;

__END__