File Coverage

blib/lib/Doubly/Linked/PP.pm

Criterion	Covered	Total	%
statement	155	161	96.2
branch	40	48	83.3
condition	6	12	50.0
subroutine	27	27	100.0
pod	0	23	0.0
total	228	271	84.1

package Doubly::Linked::PP;

use 5.006;
use strict;
use warnings;

our $VERSION = '0.06';

sub new {
	my ($pkg, $data) = @_;

	return bless {
		data => $data,
		next => undef,
		prev => undef
	}, ref $pkg || $pkg;
}

sub length {
	my ($self) = @_;

	my $i = $self->{next} || $self->{data} ? 1 : 0;

	while ($self->next) {
		$self = $self->next;
		$i++;
	}

	return $i;
}

sub start {
	my ($self) = @_;

	while ($self->prev) {
		$self = $self->prev;
	}

	return $self;
}

sub is_start {
	if ($_[0]->prev) {
		return 0;
	}
	return 1;
}

sub end {
	my ($self) = @_;

	while ($self->next) {
		$self = $self->next;
	}

	return $self;
}

sub is_end {
	if ($_[0]->next) {
		return 0;
	}
	return 1;
}

sub data { $_[0]->{data} = $_[1] if $_[1]; $_[0]->{data} }

sub next { $_[0]->{next} }

sub prev { $_[0]->{prev} }

sub bulk_add {
	my ($self, @items) = @_;
	$self = $self->end;
	for (@items) {
		$self = $self->insert_at_end($_);
	}
	return $self;
}

sub add {
	$_[0]->insert_at_end($_[1]);
}

sub insert {
	my ($self, $cb, $data) = @_;

	if (_is_undef($self)) {
		$self->{data} = $data;
		return $self;
	}

	$self  = $self->find($cb);

	return $self->insert_before($data);
}

sub insert_before {
	my ($self, $data) = @_;

	if (_is_undef($self)) {
		$self->{data} = $data;
		return $self;
	}

	my $node = $self->new($data);

	$node->{next} = $self;

	if ($self->{prev}) {
		$node->{prev} = $self->{prev};
		$self->{prev}->{next} = $node;
	}

	$self->{prev} = $node;

	return $node;
}

sub insert_after {
	my ($self, $data) = @_;

	if (_is_undef($self)) {
		$self->{data} = $data;
		return $self;
	}

	my $node = $self->new($data);

	$node->{prev} = $self;

	if ($self->{next}) {
		$node->{next} = $self->{next};
		$self->{next}->{prev} = $node;
	}

	$self->{next} = $node;

	return $node;
}

sub insert_at_start {
	my ($self, $data) = @_;

	if (_is_undef($self)) {
		$self->{data} = $data;
		return $self;
	}

	$self = $self->start();

	my $node = $self->new($data);

	$self->{prev} = $node;
	$node->{next} = $self;

	return $node;
}

sub insert_at_end {
	my ($self, $data) = @_;

	if (_is_undef($self)) {
		$self->{data} = $data;
		return $self;
	}

	$self = $self->end();

	my $node = $self->new($data);

	$self->{next} = $node;
	$node->{prev} = $self;

	return $node;
}

sub insert_at_pos {
	my ($self, $pos, $data) = @_;

	if (_is_undef($self)) {
		$self->{data} = $data;
		return $self;
	}

	$self = $self->start;

	for (my $i = 0; $i < $pos; $i++) {
		if ($self->{next}) {
			$self = $self->{next};
		}
	}

	return $self->insert_after($data);
}

sub remove {
	my ($self) = @_;

	if (_is_undef($self)) {
		return undef;
	}

	my $prev = $self->{prev};
	my $next = $self->{next};
	my $data = $self->{data};

	if ($prev) {
		if ($next) {
			$next->{prev} = $prev;
			$prev->{next} = $next;
			%{$self} = %{$next};
		} else {
			$prev->{next} = undef;
			%{$self} = %{$prev};
		}
	} elsif ($next) {
		$next->{prev} = undef;
		%{$self} = %{$next};
	} else {
		$self->{data} = undef;
	}

	return $data;
}

sub remove_from_start {
	my ($self) = @_;

	if (_is_undef($self)) {
		return undef;
	}

	$self = $self->start();

	return $self->remove();
}

sub remove_from_end {
	my ($self) = @_;

	if (_is_undef($self)) {
		return undef;
	}

	$self = $self->end();

	return $self->remove();
}

sub remove_from_pos {
	my ($self, $pos) = @_;

	if (_is_undef($self)) {
		return undef;
	}

	$self = $self->start();

	for (my $i = 0; $i < $pos; $i++) {
		if ($self->{next}) {
			$self = $self->{next};
		}
	}

	return $self->remove();
}

sub find {
	my ($self, $cb) = @_;

	$self = $self->start;

	if ( $cb->($self->data) ) {
		return $self;
	}

	while ($self->next) {
		$self = $self->next;

		if ( $cb->($self->data) ) {
			return $self;
		}
	}

	die "No match found for find cb";
}

sub destroy {
	my ($self) = @_;
	my $orig = $self;
	$self = $self->end;
	while ($self->prev) {
		my $next = $self->prev;
		$self->remove();
		$self = $next;
	}
	$self->remove();
	%{$orig} = %{$self};
	$orig;
}

sub _is_undef {
	my ($self) = shift;

	if ($self->{data} || $self->{prev} || $self->{next}) {
		return 0;
	}
	return 1;
}


1;

__END__