File Coverage

blib/lib/Data/Hive.pm

Criterion	Covered	Total	%
statement	64	74	86.4
branch	34	36	94.4
condition	5	5	100.0
subroutine	17	22	77.2
pod	11	12	91.6
total	131	149	87.9

use strict;
use warnings;
package Data::Hive;
# ABSTRACT: convenient access to hierarchical data
$Data::Hive::VERSION = '1.013';
use Carp ();

#pod =head1 SYNOPSIS
#pod
#pod   use Data::Hive;
#pod
#pod   my $hive = Data::Hive->NEW(\%arg);
#pod
#pod   $hive->foo->bar->quux->SET(17);
#pod
#pod   print $hive->foo->bar->quux->GET;  # 17
#pod
#pod =head1 DESCRIPTION
#pod
#pod Data::Hive doesn't do very much.  Its main purpose is to provide a simple,
#pod consistent interface for accessing simple, nested data dictionaries.  The
#pod mechanism for storing or consulting these dictionaries is abstract, so it can
#pod be replaced without altering any of the code that reads or writes the hive.
#pod
#pod A hive is like a set of nested hash references, but with a few crucial
#pod differences:
#pod
#pod =begin :list
#pod
#pod * a hive is always accessed by methods, never by dereferencing with C<< ->{} >>
#pod
#pod For example, these two lines perform similar tasks:
#pod
#pod   $href->{foo}->{bar}->{baz}
#pod
#pod   $hive->foo->bar->baz->GET
#pod
#pod * every key may have a value as well as children
#pod
#pod With nested hashrefs, each entry is either another hashref (representing
#pod children in the tree) or a leaf node.  With a hive, each entry may be either or
#pod both.  For example, we can do this:
#pod
#pod   $hive->entry->SET(1);
#pod
#pod   $hive->entry->child->SET(1)
#pod
#pod This wouldn't be possible with a hashref, because C<< $href->{entry} >> could
#pod not hold both another node and a simple value.
#pod
#pod It also means that along the ways to existing values in a hive, there might be
#pod paths with no existing value.
#pod
#pod   $hive->NEW(...);                  # create a new hive with no entries
#pod
#pod   $hive->foo->bar->baz->SET(1);     # set a single value
#pod
#pod   $hive->foo->EXISTS;               # false!  no value exists here
#pod
#pod   grep { 'foo' eq $_ } $hive->KEYS; # true!   we can descent down this path
#pod
#pod   $hive->foo->bar->baz->EXISTS;     # true!   there is a value here
#pod
#pod * hives are accessed by path, not by name
#pod
#pod When you call C<< $hive->foo->bar->baz->GET >>, you're not accessing several
#pod substructures.  You're accessing I hive.  When the C method is
#pod reached, the intervening names are converted into an entry path and I is
#pod accessed.  Paths are made of zero or more non-empty strings.  In other words,
#pod while this is legal:
#pod
#pod   $href->{foo}->{''}->baz;
#pod
#pod It is not legal to have an empty part in a hive path.
#pod
#pod =end :list
#pod
#pod =head1 WHY??
#pod
#pod By using method access, the behavior of hives can be augmented as needed during
#pod testing or development.  Hives can be easily collapsed to single key/value
#pod pairs using simple notations whereby C<< $hive->foo->bar->baz->SET(1) >>
#pod becomes C<< $storage->{"foo.bar.baz"} = 1 >> or something similar.
#pod
#pod This, along with the L API makes it very easy to swap out
#pod the storage and retrieval mechanism used for keeping hives in persistent
#pod storage.  It's trivial to persist entire hives into a database, flatfile, CGI
#pod query, or many other structures, without using weird tricks beyond the weird
#pod trick that is Data::Hive itself.
#pod
#pod =head1 METHODS
#pod
#pod =head2 hive path methods
#pod
#pod All lowercase methods are used to travel down hive paths.
#pod
#pod When you call C<< $hive->some_name >>, the return value is another Data::Hive
#pod object using the same store as C<$hive> but with a starting path of
#pod C.  With that hive, you can descend to deeper hives or you can get
#pod or set its value.
#pod
#pod Once you've reached the path where you want to perform a lookup or alteration,
#pod you call an all-uppercase method.  These are detailed below.
#pod
#pod =head2 hive access methods
#pod
#pod These methods are thin wrappers around required modules in L
#pod subclasses.  These methods all basically call a method on the store with the
#pod same (but lowercased) name and pass it the hive's path.
#pod
#pod =head3 NEW
#pod
#pod This constructs a new hive object.  Note that the name is C and not
#pod C!  The C method is just another method to pick a hive path part.
#pod
#pod The following are valid arguments for C.
#pod
#pod =begin :list
#pod
#pod = store
#pod
#pod a L object, or one with a compatible interface; this will be
#pod used as the hive's backend storage driver;  do not supply C or
#pod C if C is supplied
#pod
#pod = store_class
#pod
#pod This names a class from which to instantiate a storage driver.  The classname
#pod will have C prepended; to avoid this, prefix it with a '='
#pod (C<=My::Store>).  A plus sign can be used instead of an equal sign, for
#pod historical reasons.
#pod
#pod = store_args
#pod
#pod If C has been provided instead of C, this argument may be
#pod given as an arrayref of arguments to pass (dereferenced) to the store class's
#pod C method.
#pod
#pod =end :list
#pod
#pod =cut

sub NEW {
  my ($invocant, $arg) = @_;
  $arg ||= {};

  my @path = @{ $arg->{path} || [] };

  my $class = ref $invocant ? ref $invocant : $invocant;
  my $self = bless { path => \@path } => $class;

  if ($arg->{store_class}) {
    die "don't use 'store' with 'store_class' and 'store_args'"
      if $arg->{store};

    $arg->{store_class} = "Data::Hive::Store::$arg->{store_class}"
      unless $arg->{store_class} =~ s/^[+=]//;

    $self->{store} = $arg->{store_class}->new(@{ $arg->{store_args} || [] });
  } elsif ($arg->{store}) {
    $self->{store} = $arg->{store};
  } else {
    Carp::croak "can't create a hive with no store";
  }

  return $self;
}

#pod =head3 GET
#pod
#pod   my $value = $hive->some->path->GET( $default );
#pod
#pod The C method gets the hive value.  If there is no defined value at the
#pod path and a default has been supplied, the default will be returned instead.
#pod
#pod C<$default> should be a simple scalar or a subroutine.  If C<$default> is a
#pod subroutine, it will be called to compute the default only if needed.  The
#pod behavior for other types of defaults is undefined.
#pod
#pod =head4 overloading
#pod
#pod Hives are overloaded for stringification and numification so that they behave
#pod like their value when used without an explicit C.  This behavior is
#pod deprecated and will be removed in a future release.  Always use C to get
#pod the value of a hive.
#pod
#pod =cut

use overload (
  q{""}    => sub {
    Carp::carp "using hive as string for implicit GET is deprecated";
    shift->GET(@_);
  },
  q{0+}    => sub {
    Carp::carp "using hive as number for implicit GET is deprecated";
    shift->GET(@_);
  },
  fallback => 1,
);

sub GET {
  my ($self, $default) = @_;
  my $value = $self->STORE->get($self->{path});
  return defined $value     ? $value
       : ! defined $default ? undef
       : ref $default       ? $default->()
       :                      $default;
}

#pod =head3 SET
#pod
#pod   $hive->some->path->SET(10);
#pod
#pod This method sets (replacing, if necessary) the hive value.
#pod
#pod Data::Hive was built to store simple scalars as values.  Although it
#pod I works just fine with references in the hive, it has not been
#pod tested for such use, and there may be bugs lurking in there.
#pod
#pod C's return value is not defined.
#pod
#pod =cut

sub SET {
  my $self = shift;
  return $self->STORE->set($self->{path}, @_);
}

#pod =head3 EXISTS
#pod
#pod   if ($hive->foo->bar->EXISTS) { ... }
#pod
#pod This method tests whether a value (even an undefined one) exists for the hive.
#pod
#pod =cut

sub EXISTS {
  my $self = shift;
  return $self->STORE->exists($self->{path});
}

#pod =head3 DELETE
#pod
#pod   $hive->foo->bar->DELETE;
#pod
#pod This method deletes the hive's value.  The deleted value is returned.  If no
#pod value had existed, C is returned.
#pod
#pod =cut

sub DELETE {
  my $self = shift;
  return $self->STORE->delete($self->{path});
}

#pod =head3 DELETE_ALL
#pod
#pod This method behaves like C, but all values for paths below the current
#pod one will also be deleted.
#pod
#pod =cut

sub DELETE_ALL {
  my $self = shift;
  return $self->STORE->delete_all($self->{path});
}

#pod =head3 KEYS
#pod
#pod   my @keys = $hive->KEYS;
#pod
#pod This returns a list of next-level path elements that exist.  For example, given
#pod a hive with values for the following paths:
#pod
#pod   foo
#pod   foo/bar
#pod   foo/bar/baz
#pod   foo/xyz/abc
#pod   foo/xyz/def
#pod   foo/123
#pod
#pod This shows the expected results:
#pod
#pod   keys of      | returns
#pod   -------------+------------
#pod   foo          | bar, xyz, 123
#pod   foo/bar      | baz
#pod   foo/bar/baz  |
#pod   foo/xyz      | abc, def
#pod   foo/123      |
#pod
#pod =cut

sub KEYS {
  my ($self) = @_;
  return $self->STORE->keys($self->{path});
}

#pod =head3 COPY_ONTO
#pod
#pod   $hive->foo->COPY_ONTO( $another_hive->bar );
#pod
#pod This method copies all the existing values found at or under the current path
#pod to another Data::Hive, using either the same or a different store.
#pod
#pod Currently, this will set each found value individually.  In the future, store
#pod classes should have the ability to receive a bulk-set message to operate in a
#pod transaction, if appropriate.
#pod
#pod =cut

sub COPY_ONTO {
  my ($self, $target) = @_;

  $target->SET( $self->GET ) if $self->EXISTS;

  for my $key ($self->KEYS) {
    $self->HIVE($key)->COPY_ONTO( $target->HIVE($key) );
  }
}

#pod =head3 HIVE
#pod
#pod   $hive->HIVE('foo');          #  equivalent to $hive->foo
#pod
#pod   $hive->HIVE('foo', 'bar');   #  equivalent to $hive->foo->bar
#pod
#pod This method returns a subhive of the current hive.  In most cases, it is
#pod simpler to use the lowercase hive access method.  This method is useful when
#pod you must, for some reason, access an entry whose name is not a valid Perl
#pod method name.
#pod
#pod It is also needed if you must access a path with the same name as a method in
#pod C.  In general, only C, C, and C should fall into
#pod this category, but some libraries unfortunately add methods to C.
#pod Common offenders include C, C, C.
#pod
#pod This method should be needed fairly rarely.  It may also be called as C
#pod for historical reasons.
#pod
#pod =cut

sub ITEM {
  my ($self, @rest) = @_;
  return $self->HIVE(@rest);
}

sub HIVE {
  my ($self, @keys) = @_;

  my @illegal = map  { $_ = '(undef)' if ! defined }
                grep { ! defined or ! length or ref } @keys;

  Carp::croak "illegal hive path parts: @illegal" if @illegal;

  return $self->NEW({
    %$self,
    path => [ @{$self->{path}}, @keys ],
  });
}

#pod =head3 NAME
#pod
#pod This method returns a name that can be used to represent the hive's path.  This
#pod name is B, and should not be relied upon if the store may
#pod change.  It is provided primarily for debugging.
#pod
#pod =cut

sub NAME {
  my $self = shift;
  return $self->STORE->name($self->{path});
}

#pod =head3 ROOT
#pod
#pod This returns a Data::Hive object for the root of the hive.
#pod
#pod =cut

sub ROOT {
  my $self = shift;

  return $self->NEW({
    %$self,
    path => [ ],
  });
}

#pod =head3 SAVE
#pod
#pod This method tells the hive store to save the value (or lack thereof) for the
#pod current path.  For many stores, this does nothing.  For hive stores that are
#pod written out only on demand, this method must be called.
#pod
#pod =cut

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

  $self->STORE->save($self->{path});
}

#pod =head3 SAVE_ALL
#pod
#pod This method tells the hive store to save the value (or lack thereof) for the
#pod current path and all paths beneath it.  For many stores, this does nothing.
#pod For hive stores that are written out only on demand, this method must be
#pod called.
#pod
#pod =cut

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

  $self->STORE->save_all($self->{path});
}

#pod =head3 STORE
#pod
#pod This method returns the storage driver being used by the hive.
#pod
#pod =cut

sub STORE {
  return $_[0]->{store}
}

sub AUTOLOAD {
  my $self = shift;
  our $AUTOLOAD;

  (my $method = $AUTOLOAD) =~ s/.*:://;
  die "AUTOLOAD for '$method' called on non-object" unless ref $self;

  return if $method eq 'DESTROY';

  if ($method =~ /^[A-Z_]+$/) {
    Carp::croak("all-caps method names are reserved: '$method'");
  }

  Carp::cluck("arguments passed to autoloaded Data::Hive descender") if @_;

  return $self->HIVE($method);
}

1;

__END__