File Coverage

blib/lib/Tree/Binary/Dictionary.pm

Criterion	Covered	Total	%
statement	127	129	98.4
branch	30	38	78.9
condition	5	8	62.5
subroutine	27	27	100.0
pod	11	11	100.0
total	200	213	93.9

package Tree::Binary::Dictionary;

=head1 NAME

Tree::Binary::Dictionary - A dictionary API to a binary tree

=head1 DESCRIPTION

A simple class to provide a dictionary style API
to a binary tree of data.

This can provide a useful alternative to a long-lived
hash in long running daemons and processes.


=head1 SYNOPSIS

use Tree::Binary::Dictionary;

my $dictionary = Tree::Binary::Dictionary->new;

# populate
$dictionary->add(aaaa => "One");
$dictionary->add(cccc => "Three");
$dictionary->add(dddd => "Four");
$dictionary->add(eeee => "Five");
$dictionary->add(foo => "Foo");
$dictionary->add(bar => "quuz");

# interact
$dictionary->exists('bar');
$dictionary->get('eeee');
$dictionary->delete('cccc');

# hash stuff
my %hash = $dictionary->to_hash;
my @values = $dictionary->values;
my @keys = $dictionary->keys;

# for long running processes
$dictionary->rebuild();

=head1 METHODS

=head2 new - constructor

my $dictionary = Tree::Binary::Dictionary->new (cache => 0);

Instantiates and returns a new dictionary object.

Optional arguments are cache, which will re-use internal objects and structures
rather than rebuilding them as required. Default is 1 / True.

=head2 rebuild

$dictionary->rebuild();

Rebuilds the internal binary tree to reduce wasteful memory use

=head2 add

my $added = $dictionary->add(bar => "quuz");

Adds new key and value in dictionary object, returns true on success, warns and returns 0
on duplicate key or other failure.

=head2 set

my $set = $dictionary->set(bar => 'quuuz');

Sets key and value in dictionary object, returns true on success, 0 on error.

This will add a new key and value if the key is new, or update the value of an existing key

=head2 exists

$dictionary->exists('bar');

=head2 get

my $value = $dictionary->get('eeee');

=head2 delete

my $deleted = $dictionary->delete('cccc');

=head2 to_hash

my %hash = $dictionary->to_hash;

returns a hash populated from the dictionary

=head2 values

my @values = $dictionary->values;

returns dictionary values as an array

=head2 keys

my @keys = $dictionary->keys;

returns dictionary keys as an array

=head2 count

my $count = $dictionary->count

returns the number of entries in the dictionary

=cut

use strict;
our $VERSION = 1.01;

use Tree::Binary::Search;
use Tree::Binary::Visitor::InOrderTraversal;

use constant _COUNTER    => 0;
use constant _BTREE      => 1;
use constant _KEYS_VIS   => 2;
use constant _VALUES_VIS => 3;
use constant _HASH_VIS   => 4;
use constant _CACHE_FLAG => 5;

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

  my $cache_flag = (defined $args{cache}) ? $args{cache} : 1;
  my $btree = Tree::Binary::Search->new();
  $btree->useStringComparison();
  my $self = [ 0, $btree, undef, undef, undef, $cache_flag];

  if ($cache_flag) {
    my $hash_visitor = Tree::Binary::Visitor::InOrderTraversal->new();
    $hash_visitor->setNodeFilter(sub {
				   my ($t) = @_;
				   return ($t->getNodeKey, $t->getNodeValue());
				 });
    $self->[_HASH_VIS] = $hash_visitor;

    my $keys_visitor = Tree::Binary::Visitor::InOrderTraversal->new();
    $keys_visitor->setNodeFilter(sub { return shift()->getNodeKey; } );
    $self->[_KEYS_VIS] = $keys_visitor;

    my $values_visitor = Tree::Binary::Visitor::InOrderTraversal->new();
    $values_visitor->setNodeFilter(sub { return shift()->getNodeValue; } );
    $self->[_VALUES_VIS] = $values_visitor;
  }
  return bless $self, ref $class || $class;
}

sub count {
  return shift()->[_COUNTER];
}

sub keys {
  my $self = shift;
  return () unless ($self->[_COUNTER]);
  my $keys_visitor;
  if ($self->[_CACHE_FLAG]) {
    $keys_visitor = $self->[_KEYS_VIS];
  } else {
    $keys_visitor = Tree::Binary::Visitor::InOrderTraversal->new();
    $keys_visitor->setNodeFilter(sub { return shift()->getNodeKey; } );
  }
  $self->[_BTREE]->accept($keys_visitor);
  return $keys_visitor->getResults();
}

sub values {
  my $self = shift;
  return () unless ($self->[_COUNTER]);
  my $values_visitor;
  if ($self->[_CACHE_FLAG]) {
    $values_visitor = $self->[_VALUES_VIS];
  } else {
    $values_visitor = Tree::Binary::Visitor::InOrderTraversal->new();
    $values_visitor->setNodeFilter(sub { return shift()->getNodeValue; } );
  }
  $self->[_BTREE]->accept($values_visitor);
  return $values_visitor->getResults();
}

sub to_hash {
  my $self = shift;
  return () unless ($self->[_COUNTER]);
  my $hash_visitor;
  if ($self->[_CACHE_FLAG]) {
    $hash_visitor = $self->[_HASH_VIS];
  } else {
    $hash_visitor = Tree::Binary::Visitor::InOrderTraversal->new();
    $hash_visitor->setNodeFilter(sub {
				   my ($t) = @_;
				   return ($t->getNodeKey, $t->getNodeValue());
				 });
  }
  $self->[_BTREE]->accept($hash_visitor);
  return $hash_visitor->getResults();
}

sub delete {
  my $self = shift;
  return 0 unless ($self->[_COUNTER]);
  my $ok = eval { $self->[_BTREE]->delete(shift()); };
  warn "attempted to delete non-existant key" if $@;
  $self->[_COUNTER]-- unless ($@);
  return $ok || 0;
}

sub exists {
  my $self = shift;
  return 0 unless ($self->[_COUNTER]);
  return $self->[_BTREE]->exists(shift());
}

sub get {
  my $self = shift;
  return 0 unless ($self->[_COUNTER]);
  my $value = eval {$self->[_BTREE]->select(shift()); };
  warn "attempted to get value from non-existant key" if $@;
  return $value;
}

sub add {
  my $self = shift;
  eval { $self->[_BTREE]->insert(@_); };
  if ($@) {
    warn $@;
    return 0;
  } else {
    $self->[_COUNTER]++;
    return 1;
  }
}

sub set {
  my $self = shift;
  if ($self->[_COUNTER] && $self->[_BTREE]->exists($_[0])) {
    eval { $self->[_BTREE]->update(@_); };
  } else {
    eval { $self->[_BTREE]->insert(@_); };
    $self->[_COUNTER]++ unless ($@);
  }
  if ($@) {
    warn $@;
    return 0;
  } else {
    return 1;
  }
}

sub rebuild {
  my $self = shift;
  my $keys_visitor;
  if ($self->[_CACHE_FLAG]) {
    $keys_visitor = $self->[_KEYS_VIS];
  } else {
    $keys_visitor = Tree::Binary::Visitor::InOrderTraversal->new();
    $keys_visitor->setNodeFilter(sub { return shift()->getNodeKey; } );
  }
  $self->[_BTREE]->accept($keys_visitor);
  my @keys = $keys_visitor->getResults();

  my $btree = Tree::Binary::Search->new();
  $btree->useStringComparison();

  foreach my $key (@keys) {
    $btree->insert($key, $self->[_BTREE]->select($key));
  }
  $self->[_BTREE] = $btree;
  return 1;
}

=head1 SEE ALSO

Tree::Binary

=head1 AUTHOR

aaron trevena, [e-mail]

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2006 by Aaron Trevena

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.5 or,
at your option, any later version of Perl 5 you may have available.

=cut


    1;