File Coverage

blib/lib/List/Priority.pm

Criterion	Covered	Total	%
statement	71	71	100.0
branch	18	24	75.0
condition	4	6	66.6
subroutine	16	16	100.0
pod	8	8	100.0
total	117	125	93.6

package List::Priority;

use 5.006;
use strict;
use warnings;
use vars qw($VERSION);
use Carp;
use List::Util qw/min max/;

$VERSION = '0.05';


# Constructor. Enables Inheritance
sub new {
	my $this = shift;
	my $class = ref($this) || $this;
	my $self = {};
	bless $self, $class;
	if (@_) {
		my %options = @_;
		$self->{options} = \%options;
	}
	$self->{size} = 0;
	return $self;
}

# Insert an element into the list
sub insert {
	# Arguments check
	croak 'List::Priority - Expected 3 arguments!' if (scalar(@_) != 3);
	# Argument assignment
	(my $self, my $priority, my $object) = @_;
	# Check that priority is numeric - Thanks Randel/Joseph!
	croak 'List::Priority - Priority must be numeric!'
		if ((~$priority & $priority) ne '0');
	# If the list is full
	if (defined($self->{options}{capacity}) and
		$self->{options}{capacity} <= $self->{size}) {
		my ($bottom_priority) = min(keys %{$self->{queues}});
		# And the object's priority is higher than the lowest on the list
		# - remove the lowest one to insert it
		if ($priority > $bottom_priority) {
			$self->_extract($bottom_priority);
		}
		# Else, just return - the list is full.
		else {
			return 'List::Priority - Object denied, list is full';
		}
	}
	# Insert
	push(@{$self->{queues}{$priority}}, $object);
	++$self->{size};
	return 1;
}

# Helper method for pop() and shift()
# If $priority is defined, return the first-in element with that priority.
# Otherwise, use $minmax() to find the best priority in the set, and
# extract the first element with that priority.
sub _extract {
	my ($self, $priority) = @_;
	return undef if ($self->{size} == 0);
	return undef unless (defined ($priority));
	# Remove the queue's first element
	my $object = CORE::shift (@{$self->{queues}{$priority}});
	# If the queue is now empty - delete it
	delete $self->{queues}{$priority}
		if (scalar(@{$self->{queues}{$priority}}) == 0);
	# Return the object I just shifted out of the queue
	--$self->{size};
	return $object;
}

# Find out the extreme (top or bottom) priority
sub _extreme_priority {
	my ($self, $minmax) = @_;
	return $minmax->(keys %{$self->{queues}});
}

sub highest_priority {
	my $self = shift;
	return $self->_extreme_priority(\&max);
}

sub lowest_priority {
	my $self = shift;
	return $self->_extreme_priority(\&min);
}

sub pop {
	# Arguments check
	croak 'List::Priority - pop expected 1 argument' if (scalar(@_) != 1);
	my ($self) = @_;
	return $self->_extract($self->highest_priority);
}

sub shift {
	# Arguments check
	croak 'List::Priority - shift expected 1 argument' if (scalar(@_) != 1);
	my ($self) = @_;
	return $self->_extract($self->lowest_priority);
}

sub size {
	my ($self) = @_;
	return $self->{size};
}

sub capacity {
	my ($self, $new_capacity) = @_;
	if (@_ > 1) {
		$self->{options}{capacity} = $new_capacity;
		if (defined $new_capacity) {
			while ($self->size > $new_capacity) {
				$self->shift;
			}
		}
	}
	return $self->{options}{capacity};
}

1;
__END__