File Coverage

blib/lib/Array/Window.pm

Criterion	Covered	Total	%
statement	81	122	66.3
branch	32	62	51.6
condition	1	9	11.1
subroutine	25	29	86.2
pod	18	20	90.0
total	157	242	64.8

package Array::Window;

use 5.005;
use strict;
use Params::Util '_ARRAYLIKE';

use vars qw{$VERSION};
BEGIN {
	$VERSION = '1.02';
}

# A description of the properties
#
# source_start          - The lowest index of the source array
# source_end            - The highest index of the source array
# source_length         - The total length of the source
# window_start          - The lowest index of the data window
# window_end            - The highest index of the data window
# window_length         - The length of the window ( number of items inclusive )
# window_length_desired - The length of the window they would LIKE to have
# previous_start        - The index number of window_start for the "Previous" window
# next_start            - The index number of window_start for the "Next" window

sub new {
	my $class   = shift;
	my %options = @_;

	# Create the new object
	my $self = bless {
		source_start          => undef,
		source_end            => undef,
		source_length         => undef,
		window_start          => undef,
		window_end            => undef,
		window_length         => undef,
		window_length_desired => undef,
		previous_start        => undef,
		next_start            => undef,
		}, $class;

	# Check for a specific source
	if ( $options{source} ) {
		_ARRAYLIKE($options{source}) or return undef;
		$self->{source_start}  = 0;
		$self->{source_end}    = $#{$options{source}};
		$self->{source_length} = $self->{source_end} + 1;

	} elsif ( defined $options{source_start} and defined $options{source_end} ) {
		$self->{source_start}  = $options{source_start};
		$self->{source_end}    = $options{source_end};
		$self->{source_length} = $options{source_end} - $options{source_start} + 1;

	} elsif ( defined $options{source_start} and defined $options{source_length} ) {
		return undef unless $options{source_length} > 0;
		$self->{source_start}  = $options{source_start};
		$self->{source_end}    = $options{source_start} + $options{source_length} - 1;
		$self->{source_length} = $options{source_length};

	} elsif ( defined $options{source_end} and defined $options{source_length} ) {
		return undef unless $options{source_length} > 0;
		$self->{source_start}  = $options{source_end} - $options{source_length} + 1;
		$self->{source_end}    = $options{source_end};
		$self->{source_length} = $options{source_length};

	} elsif ( defined $options{source_length} ) {
		return undef unless $options{source_length} > 0;
		$self->{source_start}  = 0;
		$self->{source_end}    = $options{source_length} - 1;
		$self->{source_length} = $options{source_length};

	} else {
		# Source not defined
		return undef;
	}

	# Do we have the window start?
	if ( defined $options{window_start} ) {
		# We can't be before the beginning
		$self->{window_start} = $options{window_start};
	} else {
		return undef;
	}

	# Do we have the window length?
	if ( defined $options{window_length} ) {
		return undef unless $options{window_length} > 0;
		$self->{window_length} = $options{window_length};
		$self->{window_length_desired} = $options{window_length};
	} elsif ( defined $options{window_end} ) {
		return undef if $options{window_end} < $self->{window_start};
		$self->{window_end} = $options{window_end};
	} else {
		# Not enough data to do the math
		return undef;
	}

	# Do the math
	$self->_calculate;

	return $self;
}

# Do the calculations to set things as required.
# We also support incremental calculations.
sub _calculate {
	my $self = shift;

	# First, finish the third of the window_ values.
	# This will be either window_length or window_end.
	$self->_calculate_window_end    unless defined $self->{window_end};
	$self->_calculate_window_length unless defined $self->{window_length};

	# Adjust the window back into the source if needed
	if ( $self->{window_start} < $self->{source_start} ) {
		$self->{window_start} += ($self->{source_start} - $self->{window_start});
		$self->_calculate_window_end;

		# If this move puts window_end after source_end, fix it
		if ( $self->{window_end} > $self->{source_end} ) {
			$self->{window_end} = $self->{source_end};
			$self->_calculate_window_length;
		}
	}
	if ( $self->{window_end} > $self->{source_end} ) {
		$self->{window_start} -= ($self->{window_end} - $self->{source_end});
		$self->_calculate_window_end;

		# If this move puts window_start before source_start, fix it
		if ( $self->{window_start} < $self->{source_start} ) {
			$self->{window_start} = $self->{source_start};
			$self->_calculate_window_length;
		}
	}

	# Calculate the next window_start
	if ( $self->{window_end} == $self->{source_end} ) {
		$self->{next_start} = undef;
	} else {
		$self->{next_start} = $self->{window_end} + 1;
	}

	# Calculate the previous window_start
	if ( $self->{window_start} == $self->{source_start} ) {
		$self->{previous_start} = undef;
	} else {
		$self->{previous_start} = $self->{window_start} - $self->{window_length};
		if ( $self->{previous_start} < $self->{source_start} ) {
			$self->{previous_start} = $self->{source_start};
		}
	}

	return 1;
}

# Smaller calculation componants
sub _calculate_window_start {
	my $self = shift;
	$self->{window_start} = $self->{window_end} - $self->{window_length} + 1;
}
sub _calculate_window_end {
	my $self = shift;
	$self->{window_end} = $self->{window_start} + $self->{window_length} - 1;
}
sub _calculate_window_length {
	my $self = shift;
	$self->{window_length} = $self->{window_end} - $self->{window_start} + 1;
}





#####################################################################
# Access methods

sub source_start          { $_[0]->{source_start}          }
sub source_end            { $_[0]->{source_end}            }
sub human_source_start    { $_[0]->{source_start} + 1      }
sub human_source_end      { $_[0]->{source_end} + 1        }
sub source_length         { $_[0]->{source_length}         }
sub window_start          { $_[0]->{window_start}          }
sub window_end            { $_[0]->{window_end}            }
sub human_window_start    { $_[0]->{window_start} + 1      }
sub human_window_end      { $_[0]->{window_end} + 1        }
sub window_length         { $_[0]->{window_length}         }
sub window_length_desired { $_[0]->{window_length_desired} }
sub previous_start        { $_[0]->{previous_start}        }
sub next_start            { $_[0]->{next_start}            }

# Get an object representing the first window.
# Returns 0 if we are currently the first window
sub first {
	my $self  = shift;
	my $class = ref $self;

	# If the window_start is equal to the source_start, return false
	return '' if $self->{source_start} == $self->{window_start};

	# Create the first window
	return $class->new(
		source_start  => $self->{source_start},
		source_end    => $self->{source_end},
		window_length => $self->{window_length_desired},
		window_start  => $self->{source_start},
	);
}

# Get an object representing the last window.
# Returns false if we are already the last window.
sub last {
	my $self  = shift;
	my $class = ref $self;

	# If the window_end is equal to the source_end, return false
	return '' if $self->{source_end} == $self->{window_end};

	# Create the last window
	my $window_start = $self->{source_end} - $self->{window_length_desired} + 1;
	return $class->new(
		source_start  => $self->{source_start},
		source_end    => $self->{source_end},
		window_start  => $window_start,
		window_end    => $self->{source_end},
	);
}

# Get an object representing the next window.
# Returns 0 if there is no next window.
sub next {
	my $self  = shift;
	my $class = ref $self;

	# If there is no next, return false
	return '' unless defined $self->{next_start};

	# Create the next window
	return $class->new(
		source_start  => $self->{source_start},
		source_end    => $self->{source_end},
		window_length => $self->{window_length_desired},
		window_start  => $self->{next_start},
	);
}

sub previous {
	my $self  = shift;
	my $class = ref $self;

	# If there is no previou, return false
	return '' unless defined $self->{previous_start};

	# Create the previous window
	return $class->new(
		source_start  => $self->{source_start},
		source_end    => $self->{source_end},
		window_length => $self->{window_length_desired},
		window_start  => $self->{previous_start},
	);
}

# Method to determine if we need to do windowing.
# The method returns false if the subset is the entire set,
# and true if the subset is smaller than the set
sub required {
	my $self = shift;
	return 1 unless $self->{source_start} == $self->{window_start};
	return 1 unless $self->{source_end}   == $self->{window_end};
	return '';
}

# $window->extract( \@array );
# Method takes a set that matches the window parameters, and extracts
# the specified window
# Returns a reference to the sub array on success
# Returns undef if the array does not match the window
sub extract {
	my $self = shift;
	my $arrayref = shift;

	# Check that they match
	return undef unless $self->{source_start} == 0;
	return undef unless $self->{source_end}   == $#$arrayref;

	# Create the sub array
	my @subarray = ();
	@subarray = @{$arrayref}[$self->window_start .. $self->window_end];

	# Return a reference to the sub array
	return \@subarray;
}

1;

__END__