File Coverage

blib/lib/Tie/LLHash.pm

Criterion	Covered	Total	%
statement	96	114	84.2
branch	33	44	75.0
condition			n/a
subroutine	15	22	68.1
pod	10	10	100.0
total	154	190	81.0

package Tie::LLHash;

use strict;
use warnings;
use Carp;

our $VERSION = '1.004';

sub TIEHASH {
   my $pkg = shift;

   my $self = bless {}, $pkg;
   %$self = ( %$self, %{shift()} ) if ref $_[0];
   $self->CLEAR;

   # Initialize the hash if more arguments are given
   while (@_) {
      $self->last( splice(@_, 0, 2) );
   }

   return $self;
}

# Standard access methods:

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

   return undef unless $self->EXISTS($key);
   return $self->{'nodes'}{$key}{'value'};
}

sub STORE {
   my $self = shift;
   my $name = shift;
   my $value = shift;

   if (exists $self->{'nodes'}{$name}) {
     return $self->{'nodes'}{$name}{'value'} = $value;
   }

   croak ("No such key '$name', use first() or insert() to add keys") unless $self->{lazy};
   return $self->last($name, $value);
}


sub FIRSTKEY {
   my $self = shift;
   return $self->{'current'} = $self->{'first'};
}

sub NEXTKEY {
   my $self = shift;
   return $self->{'current'} = (defined $self->{'current'}
				? $self->{'nodes'}{ $self->{'current'} }{'next'}
				: $self->{'first'});
}

sub EXISTS {
   my $self = shift;
   my $name = shift;
   return exists $self->{'nodes'}{$name};
}

sub DELETE {
  my $self = shift;
  my $key = shift;

  return unless $self->EXISTS($key);
  my $node = $self->{'nodes'}{$key};

  if ($self->{'first'} eq $self->{'last'}) {
    $self->{'first'} = undef;
    $self->{'current'} = undef;
    $self->{'last'} = undef;

  } elsif ($self->{'first'} eq $key) {
    $self->{'first'} = $node->{'next'};
    $self->{'nodes'}{ $self->{'first'} }{'prev'} = undef;
    $self->{'current'} = undef;

  } elsif ($self->{'last'} eq $key) {
    $self->{'current'} = $self->{'last'} = $node->{'prev'};
    $self->{'nodes'}{ $self->{'last'} }{'next'} = undef;

  } else {
    my $key_one   = $node->{'prev'};
    my $key_three = $node->{'next'};
    $self->{'nodes'}{$key_one  }{'next'} = $key_three;
    $self->{'nodes'}{$key_three}{'prev'} = $key_one;
    $self->{'current'} = $key_one;
  }

  return +(delete $self->{'nodes'}{$key})->{value};
}

sub CLEAR {
   my $self = shift;

   $self->{'first'} = undef;
   $self->{'last'} = undef;
   $self->{'current'} = undef;
   $self->{'nodes'} = {};
}

sub SCALAR {
    my $self = shift;
    return scalar %{$self->{'nodes'}};
}

# Special access methods
# Use (tied %hash)->method to get at them

sub insert {
   my $self = shift;
   my $two_key = shift;
   my $two_value = shift;
   my $one_key = shift;

   # insert(key,val) and insert(key,val,undef)  ==  first(key,val)
   return $self->first($two_key, $two_value) unless defined $one_key;

   croak ("No such key '$one_key'") unless $self->EXISTS($one_key);
   croak ("'$two_key' already exists") if $self->EXISTS($two_key);

   my $three_key = $self->{'nodes'}{$one_key}{'next'};

   $self->{'nodes'}{$one_key}{'next'} = $two_key;

   $self->{'nodes'}{$two_key}{'prev'} = $one_key;
   $self->{'nodes'}{$two_key}{'next'} = $three_key;
   $self->{'nodes'}{$two_key}{'value'} = $two_value;

   if (defined $three_key) {
      $self->{'nodes'}{$three_key}{'prev'} = $two_key;
   }

   # If we're adding to the end of the hash, adjust the {last} pointer:
   if ($one_key eq $self->{'last'}) {
      $self->{'last'} = $two_key;
   }

   return $two_value;
}

sub first {
   my $self = shift;

   if (@_) { # Set it
      my $newkey = shift;
      my $newvalue = shift;

      croak ("'$newkey' already exists") if $self->EXISTS($newkey);

      # Create the new node
      $self->{'nodes'}{$newkey} =
      {
         'next'  => undef,
         'value' => $newvalue,
         'prev'  => undef,
      };

      # Put it in its relative place
      if (defined $self->{'first'}) {
         $self->{'nodes'}{$newkey}{'next'} = $self->{'first'};
         $self->{'nodes'}{ $self->{'first'} }{'prev'} = $newkey;
      }

      # Finally, make this node the first node
      $self->{'first'} = $newkey;

      # If this is an empty hash, make it the last node too
      $self->{'last'} = $newkey unless (defined $self->{'last'});
   }
   return $self->{'first'};
}

sub last {
   my $self = shift;

   if (@_) { # Set it
      my $newkey = shift;
      my $newvalue = shift;

      croak ("'$newkey' already exists") if $self->EXISTS($newkey);

      # Create the new node
      $self->{'nodes'}{$newkey} =
      {
         'next'  => undef,
         'value' => $newvalue,
         'prev'  => undef,
      };

      # Put it in its relative place
      if (defined $self->{'last'}) {
         $self->{'nodes'}{$newkey}{'prev'} = $self->{'last'};
         $self->{'nodes'}{ $self->{'last'} }{'next'} = $newkey;
      }

      # Finally, make this node the last node
      $self->{'last'} = $newkey;

      # If this is an empty hash, make it the first node too
      $self->{'first'} = $newkey unless (defined $self->{'first'});
   }
   return $self->{'last'};
}

sub key_before {
   return $_[0]->{'nodes'}{$_[1]}{'prev'};
}

sub key_after {
   return $_[0]->{'nodes'}{$_[1]}{'next'};
}

sub current_key {
   return $_[0]->{'current'};
}

sub current_value {
   my $self = shift;
   return $self->FETCH($self->{'current'});
}

sub next {
   my $self = shift;
   return $self->NEXTKEY;
}

sub prev {
   my $self = shift;
   return $self->{'current'} = $self->{'nodes'}{ $self->{'current'} }{'prev'};
}

sub reset {
   my $self = shift;
   return $self->FIRSTKEY;
}

1;
__END__