File Coverage

lib/Array/Sticky.pm

Criterion	Covered	Total	%
statement	52	60	86.6
branch	7	10	70.0
condition	2	2	100.0
subroutine	15	17	88.2
pod	0	2	0.0
total	76	91	83.5

use strict;
use warnings;
package Array::Sticky;

our $VERSION = 0.01;

sub TIEARRAY {
  my ($class, %args) = @_;

  my $self = bless +{
    head => [ @{ $args{head} || [] } ],
    body => [ @{ $args{body} || [] } ],
    tail => [ @{ $args{tail} || [] } ],
  }, $class;

  return $self;
}

sub POP { pop @{shift()->{body}} }
sub PUSH { push @{shift()->{body}}, @_ }
sub SHIFT { shift @{shift()->{body}} }
sub UNSHIFT { unshift @{shift()->{body}}, @_ }

sub CLEAR {
  my ($self) = @_;
  @{$self->{body}} = ();
}
sub EXTEND {}
sub EXISTS {
  my ($self, $index) = @_;
  my @serial = $self->serial;
  return exists $serial[$index];
}

sub serial {
  my ($self) = @_;
  return map { @{$self->{$_}} } qw(head body tail);
}

sub STORE {
  my ($self, $index, $value) = @_;
  $self->{body}[$index] = $value;
}

sub SPLICE {
  my $self = shift;
  my $offset = shift || 0;
  my $length = shift; $length = $self->FETCHSIZE if ! defined $length;

  # avoid "splice() offset past end of array"
  no warnings;

  return splice @{$self->{body}}, $offset, $length, @_;
}

sub FETCHSIZE {
  my $self = shift;

  my $size = 0;
  my %size = $self->sizes;

  foreach (values %size) {
    $size += $_;
  }

  return $size;
}

sub sizes {
  my $self = shift;
  return map { $_ => scalar @{$self->{$_}} } qw(head body tail);
}

sub FETCH {
  my $self = shift;
  my $index = shift;

  my %size = $self->sizes;

  foreach my $slot (qw(head body tail)) {
    if ($size{$slot} > $index) {
      return $self->{$slot}[$index];
    } else {
      $index -= $size{$slot};
    }
  }

  return $self->{body}[$size{body} + 1] = undef;
}

1;

__END__