File Coverage

blib/lib/Tie/RangeHash.pm

Criterion	Covered	Total	%
statement	175	182	96.1
branch	111	124	89.5
condition	48	72	66.6
subroutine	33	33	100.0
pod	10	12	83.3
total	377	423	89.1

package Algorithm::SkipList::StringRangeNode;

require 5.006;

use strict;
use warnings; ## ::register __PACKAGE__;

use Carp;
#  no Carp::Assert;

use base 'Algorithm::SkipList::Node';

sub key_cmp {
  my $self = shift;
#   assert( UNIVERSAL::isa($self, __PACKAGE__) ), if DEBUG;

  my $left  = $self->key;
  my $right = shift;

  unless (defined $left) { return -1; }

  if ($right =~ /,/) {

    my ($lo, $hi) = map { $_ || "" } split /,/, $left;
    $hi = "", unless (defined $hi);
    my ($lr, $hr) = map { $_ || "" } split /,/, $right;
    $hr = "", unless (defined $hr);

    my $lo_cmp = ($hr eq "") ?
      (($lo ne "") ? -1 : -1 ) : # ?
      (($lo ne "") ? ($lo cmp $hr) : -1);
    my $lr_cmp = ($lr eq "") ?
      (($lo ne "") ? 1 : 0 ) :
      (($lo ne "") ? ($lo cmp $lr) : -1);
    my $hi_cmp = ($lr eq "") ?
      (($hi ne "") ? 1 : 1 ) :
      (($hi ne "") ? ($hi cmp $lr) : 1);
    my $hr_cmp = ($hr eq "") ?
      (($hi ne "") ? -1 : 0 ) :
      (($hi ne "") ? ($hi cmp $hr) : 1);

    if ( (($lo_cmp==-1) && ($hi_cmp==1) && (!$lr_cmp) && (!$hr_cmp)) ||
         ((!$lo_cmp) && (!$hi_cmp) && (!$lr_cmp) && (!$hr_cmp)) ){
      return 0;
    } elsif  (($lo_cmp==1) && ($hi_cmp==1) &&
	      ($lr_cmp==1) && ($hr_cmp==1)) {
      return 1;
    } elsif  (($lo_cmp==-1) && ($hi_cmp==-1) &&
	      ($lr_cmp==-1) && ($hr_cmp==-1)) {
      return -1;
    } else {
      confess "Overlapping ranges";
    }

  } else {

    my ($lo, $hi) = split /,/, $left;

    my $lo_cmp = ($lo ne "") ? ($lo cmp $right) : -1;
    my $hi_cmp = ($hi ne "") ? ($hi cmp $right) : 1;

#     assert( $hi_cmp >= $lo_cmp ), if DEBUG;

    if (($lo_cmp <= 0) && ($hi_cmp >= 0)) {
      return 0;
    } elsif ($hi_cmp < 0) {
      return -1;
    } elsif ($lo_cmp > 0) {
      return 1;
    }
  }
}


1;

package Algorithm::SkipList::NumericRangeNode;

require 5.006;

use strict;
use warnings; # ::register __PACKAGE__;

use Carp;
# no Carp::Assert;

use base 'Algorithm::SkipList::Node';

sub key_cmp {
  my $self = shift;
#   assert( UNIVERSAL::isa($self, __PACKAGE__) ), if DEBUG;

  my $left  = $self->key;
  my $right = shift;

  unless (defined $left) { return -1; }

  if ($right =~ /,/) {

    my ($lo, $hi) = map { $_ || "" } split /,/, $left;
    $hi = "", unless (defined $hi);
    my ($lr, $hr) = map { $_ || "" } split /,/, $right;
    $hr = "", unless (defined $hr);

    my $lo_cmp = ($hr eq "") ?
      (($lo ne "") ? -1 : -1 ) : # ?
      (($lo ne "") ? ($lo <=> $hr) : -1);
    my $lr_cmp = ($lr eq "") ?
      (($lo ne "") ? 1 : 0 ) :
      (($lo ne "") ? ($lo <=> $lr) : -1);
    my $hi_cmp = ($lr eq "") ?
      (($hi ne "") ? 1 : 1 ) :
      (($hi ne "") ? ($hi <=> $lr) : 1);
    my $hr_cmp = ($hr eq "") ?
      (($hi ne "") ? -1 : 0 ) :
      (($hi ne "") ? ($hi <=> $hr) : 1);

#    print join(" ", $hi, $hr, $lo_cmp, $lr_cmp, $hi_cmp, $hr_cmp), "\n";

    if ( (($lo_cmp==-1) && ($hi_cmp==1) && (!$lr_cmp) && (!$hr_cmp)) ||
         ((!$lo_cmp) && (!$hi_cmp) && (!$lr_cmp) && (!$hr_cmp)) ){
      return 0;
    } elsif  (($lo_cmp==1) && ($hi_cmp==1) &&
	      ($lr_cmp==1) && ($hr_cmp==1)) {
      return 1;
    } elsif  (($lo_cmp==-1) && ($hi_cmp==-1) &&
	      ($lr_cmp==-1) && ($hr_cmp==-1)) {
      return -1;
    } else {
      confess "Overlapping ranges";
    }

  } else {

    my ($lo, $hi) = split /,/, $left;

    $lo = "",    unless (defined $lo);
    $hi = "",    unless (defined $hi);
    $right = "", unless (defined $right);

    my $lo_cmp = ($lo ne "") ? ($lo <=> $right) : -1;
    my $hi_cmp = ($hi ne "") ? ($hi <=> $right) : 1;

#     assert( $hi_cmp >= $lo_cmp ), if DEBUG;

    if (($lo_cmp <= 0) && ($hi_cmp >= 0)) {
      return 0;
    } elsif ($hi_cmp < 0) {
      return -1;
    } elsif ($lo_cmp > 0) {
      return 1;
    }
  }
}


1;

package Tie::RangeHash::TYPE_STRING;

use base 'Algorithm::SkipList::StringRangeNode';

1;

package Tie::RangeHash::TYPE_NUMBER;

use base 'Algorithm::SkipList::NumericRangeNode';

1;

package Tie::RangeHash;

require 5.006;

use strict;
use warnings; # ::register __PACKAGE__;

use Carp;
# no Carp::Assert;
use Algorithm::SkipList 1.02;

our $VERSION   = '1.05';
# $VERSION = eval $VERSION;

use constant TYPE_STRING => 'Algorithm::SkipList::StringRangeNode';
use constant TYPE_NUMBER => 'Algorithm::SkipList::NumericRangeNode';

# we use the full Exporter rather than something like Exporter::Lite
# because Algorithm::SkipList uses the full exporter.

require Exporter;

our @ISA = qw(Exporter);

our @EXPORT = ();
our @EXPORT_OK = qw( TYPE_STRING TYPE_NUMBER );

sub new {
  my $class = shift;

  my $self = {
    SKIPLIST  => undef,
    NODECLASS => TYPE_STRING,
  };

  bless $self, $class;

  {
    my %ARGLIST = ( map { $_ => 1 } qw( Type ) );
    my %args;

    if (ref($_[0]) eq "HASH") {
      %args = %{$_[0]};
    } else {
      %args = @_;
    }

    foreach my $arg_name (keys %args) {
      if ($ARGLIST{$arg_name}) {
	my $method = "_set_" . $arg_name;
	$self->$method( $args{ $arg_name } );
      } else {
	croak "Invalid parameter name: ``$arg_name\'\'";
      }
    }
  }

  $self->{SKIPLIST} = new Algorithm::SkipList(
    node_class => $self->{NODECLASS},
  );

  return $self;
}

sub _set_Type {
  my $self = shift;
#   assert( UNIVERSAL::isa($self, "Tie::RangeHash") ), if DEBUG;

  my $node_class = shift;
  my $node = new $node_class;
#   assert( UNIVERSAL::isa($node, "Algorithm::SkipList::Node" ) ), if DEBUG;

  $self->{NODECLASS} = $node_class;
}

sub fetch {
  my $self = shift;
#   assert( UNIVERSAL::isa($self, "Tie::RangeHash") ), if DEBUG;
  my $key = shift;
  return $self->{SKIPLIST}->find( $key );
}

sub fetch_key {
  my $self = shift;
#   assert( UNIVERSAL::isa($self, "Tie::RangeHash") ), if DEBUG;

  my $key = shift;
  my ($x, $update_ref) = $self->{SKIPLIST}->_search($key);
  if ($x->key_cmp($key) == 0) {
    return (wantarray) ? ($x->key => $x->value) : $x->key;
  } else {
    return;
  }
}

sub fetch_overlap {
  my $self = shift;
#   assert( UNIVERSAL::isa($self, "Tie::RangeHash") ), if DEBUG;

  my $key  = shift;
  my ($low, $high) = split /,/, $key;

  my @nodes = $self->{SKIPLIST}->_search_nodes($low, undef, $high);
  unless (@nodes) {
    @nodes = $self->{SKIPLIST}->_search_nodes(undef, undef, $high);
  }

  if (@nodes) {
    return map { $_->value } @nodes;
  }
  else {
    return;
  }
}

sub key_exists {
  my $self = shift;
#   assert( UNIVERSAL::isa($self, "Tie::RangeHash") ), if DEBUG;
  my $key = shift;
  $self->{SKIPLIST}->exists($key);
}

sub add {
  my $self = shift;
#  assert( UNIVERSAL::isa($self, "Tie::RangeHash") ), if DEBUG;
  my ($key, $value) = @_;
  $self->{SKIPLIST}->insert($key, $value);
}

sub clear {
  my $self = shift;
#  assert( UNIVERSAL::isa($self, "Tie::RangeHash") ), if DEBUG;
  $self->{SKIPLIST}->clear;
}

sub remove {
  my $self = shift;
#  assert( UNIVERSAL::isa($self, "Tie::RangeHash") ), if DEBUG;
  my $key = shift;

  # We could simply call $self->{SKIPLIST}->delete( $key ), but we
  # want to make sure that the user has specified the exact key that
  # is used (to keep compatability with previous versions)

  my ($x, $update_ref) = $self->{SKIPLIST}->_search($key);
  if ($x->key eq $key) {
    return $self->{SKIPLIST}->delete( $key );
  } else {
    return;
  }
}

sub first_key {
  my $self = shift;
#  assert( UNIVERSAL::isa($self, "Tie::RangeHash") ), if DEBUG;
  return $self->{SKIPLIST}->first_key;
}

sub next_key {
  my $self = shift;
#  assert( UNIVERSAL::isa($self, "Tie::RangeHash") ), if DEBUG;
  my $last_key = shift;
  return $self->{SKIPLIST}->next_key( $last_key );
}

sub reset {
  my $self = shift;
#  assert( UNIVERSAL::isa($self, "Tie::RangeHash") ), if DEBUG;
  $self->{SKIPLIST}->reset;
}

sub size {
  my $self = shift;
#  assert( UNIVERSAL::isa($self, "Tie::RangeHash") ), if DEBUG;
  return $self->{SKIPLIST}->size;
}


BEGIN
  {
    # make aliases to methods...
    no strict;
    *TIEHASH = \&new;
    *STORE   = \&add;
    *FETCH   = \&fetch;
    *EXISTS  = \&key_exists;
    *CLEAR   = \*clear;
    *DELETE  = \*remove;
    *FIRSTKEY = \*first_key;
    *NEXTKEY = \*next_key;
  }

1;

__END__