view release on metacpan or  search on metacpan

lib/Crypt/IDA/SlidingWindow.pm  view on Meta::CPAN

package Crypt::IDA::SlidingWindow;

# Copyright (c) Declan Malone, 2019
#
# See LICENSE

# Sliding Window algorithm to support cleaner IDA split/combine code

use Class::Tiny qw(bundle yts splitting combining), {
    # our 5 pointers (not really meant to be passed to new)
    read_head => 0,		# first to be advanced
    read_tail => 0,		# } peri-
    processed => 0,		# } stal-
    write_head => 0,		# } sis 
    write_tail => 0,		# start of window; last to advance
    # substream pointers (could be on read end or write end)
    # bundle => set up in BUILD
    
    # required
    mode => undef,		# 'split' or 'combine'
    rows => undef,		# how many substreams in bundle?
    window => undef,

    # optional callbacks (might move to Algorithm?)
    cb_error => undef,
    cb_read_bundle => undef,
    cb_wrote_bundle => undef,
    cb_processed => undef,
};

sub BUILD {
    my ($self, $args) = @_;
    for my $req ( qw(mode rows window) ) {
	die "$req attribute required" unless defined $self->$req;
    }
    die "Bad mode!" unless
	$self->{mode} eq 'split' or $self->{mode} eq 'combine';
    for my $plus ( qw(rows window) ) {
	die "$plus attribute must be > 0" unless $self->$plus > 0;
    }
    for my $zero ( qw(read_head read_tail processed write_head
                      write_tail) ) {
	die "Setting $zero attribute not allowed" unless $self->$zero == 0;
    }

    # Need to set up yts
    $self->{yts} = $self->{rows};

    # Couldn't set up bundle in Class::Tiny call
    my @bundle;
    for (1 .. $self->{rows}) {
	push @bundle, { head => 0, tail => 0 }
    }
    $self->{bundle} = \@bundle;

    $self->splitting($self->{mode} eq 'split'   ? 1 : 0 );
    $self->combining($self->{mode} eq 'combine' ? 1 : 0 );

}

# 
sub _error {
    my ($self,@msg) = @_;
    my $cb = $self->{cb_error};
    return @msg unless defined $cb;
    $cb->(@msg);
    undef;
}

# For clarity, I won't combine advance_read and advance_write into a
# single sub. This makes it easier to understand what's happening in
# _advance_rw_substream.

sub advance_read {
    my ($self,$cols) = @_;

    die "Use advance_read_substream instead" if $self->{combining};
    my ($head,$tail) = ($self->{read_head}, $self->{read_tail});

    # Note that read_head can be up to two windows ahead of
    # write_tail, but never more than one window from read_tail.
    die "Would exceed read window" if $head + $cols - $tail > $self->{window};
    $self->{read_head} += $cols;
}

sub advance_write {
    my ($self,$cols) = @_;

    die "Use advance_write_substream instead" if $self->{splitting};
    my ($head,$tail) = ($self->{write_head}, $self->{write_tail});

    # Advance tail, but not past head.
    die "Write tail would overtake head" if $tail + $cols > $head;
    $self->{write_tail} += $cols;
}

# code for advancing read/write substreams is the same, apart from
# error messages, callbacks and overall pointer to possibly update
sub _advance_rw_substream;
sub advance_read_substream  { shift->_advance_rw_substream("read", @_) }
sub advance_write_substream { shift->_advance_rw_substream("write", @_)}


# Returns:
# * undef on error
# * 0 if OK and bundle pointer didn't advance
# * 1 if OK and bundle pointer did advance
sub _advance_rw_substream {
    my ($self,$which,$row,$cols) = @_;
    my ($ptr, $parent, $cb);
    if ($which eq "read") {
	die "No read substreams!" if $self->{splitting};
	($ptr, $parent, $cb) = ("head", "read_head", "cb_read_bundle")
    } elsif ($which eq "write") {
	die "No write substreams!" if $self->{combining};
	($ptr, $parent, $cb) = ("tail", "write_tail", "cb_wrote_bundle");
    } else {
	die "_advance_some_substream: $which?";
    }
    die "Row out of range" if $row >= $self->{rows};

    my $hash    = $self->{bundle}->[$row];
    my $old_val = $hash->{$ptr};
    if ($which eq "read") {
	die "Read would overflow input buffer"
	    if $old_val + $cols - $hash->{tail} > $self->{window};
    } else {
	die "Write tail would overtake head"
	    if $old_val + $cols > $hash->{head};
    }
    my $new_val = $hash->{$ptr} += $cols;

    # possibly advance parent pointer to new minimum
    return 0 unless $old_val == $self->{$parent};
    return 0 if --$self->{yts};

    my $new_yts = 1;
    for my $r (0 .. $self->{rows} - 1) {
	next if $r == $row;
	my $this_val = $self->{bundle}->[$r]->{$ptr};
	next if $this_val > $new_val;
	if ($this_val < $new_val) {
	    ($new_val, $new_yts) = ($this_val, 1);
	} else {
	    ++$new_yts;
	}
    }
    ($self->{$parent}, $self->{yts}) = ($new_val, $new_yts);
    $self->{$cb}->() if defined $self->{$cb};
    return 1;
}

# The names here reflect the names of the related I/O commands as used
# by the caller:
#
# * read_ok: how much should we read to fill input buffer?
# * process_ok: how much input can we process to produce output?
# * write_ok: how much should we write to empty output buffer?