File Coverage

blib/lib/Mixin/ExtraFields/Hive.pm

Criterion	Covered	Total	%
statement	56	57	98.2
branch	13	14	92.8
condition			n/a
subroutine	15	15	100.0
pod	5	5	100.0
total	89	91	97.8

package Mixin::ExtraFields::Hive 0.008;
# ABSTRACT: infest your objects with hives

use Mixin::ExtraFields 0.002 ();
use parent qw(Mixin::ExtraFields);

#pod =head1 SYNOPSIS
#pod
#pod   use Mixin::ExtraFields::Hive -hive => {
#pod     moniker => 'registry',
#pod     driver  => 'DBI',
#pod   };
#pod
#pod =head1 DESCRIPTION
#pod
#pod This module provides a Data::Hive to other classes' objects as a mix-in,
#pod powered by Mixin::ExtraFields.  It behaves like Mixin::ExtraFields, but
#pod generates a different set of methods.  It can use any Mixin::ExtraFields
#pod driver.
#pod
#pod =head1 GENERATED METHODS
#pod
#pod =head2 hive
#pod
#pod The main export of this module is the C method, generated by importing
#pod the C<-hive> group.  The method will be imported under the moniker given to the
#pod C group.  If this all sounds like Greek, you should probably re-read the
#pod L documentation.  As a simple example, however, the code in
#pod the L, above, would generate a C method instead of a
#pod C method.
#pod
#pod This method will return a L object for extra fields for the object
#pod on which it's called.  At present, the Data::Hive object is recreated for each
#pod call to the C method.  In the future, it will be possible to cache these
#pod on the object or in some other manner.
#pod
#pod =head2 other methods
#pod
#pod At present, two support methods are installed by this mixin.  These methods may
#pod go away in the future, when a more purpose-built subclass of Data::Hive::Store
#pod is used.
#pod
#pod These methods are:
#pod
#pod   _mutate_hive - acts as a combined get/set extra accessor
#pod   _exists_hive - acts as the standard exists_extra method
#pod   _empty_hive  - deletes all hive data
#pod   _delete_hive - deletes a single hive entry
#pod
#pod =cut

use Data::Hive 1.006;
use Data::Hive::Store::Param 1.001;

# I wish this was easier. -- rjbs, 2006-12-09
use Sub::Exporter -setup => {
  groups => [ hive => \'gen_fields_group', ],
};

sub default_moniker { 'hive' }

sub methods { qw(hive mutate exists empty delete) }

sub _build_mutate_method {
  my ($self, $arg) = @_;

  my $id_method = $arg->{id_method};
  my $driver    = $arg->{driver};
  my $driver_set = $self->driver_method_name('set');
  my $driver_get = $self->driver_method_name('get');
  my $driver_all = $self->driver_method_name('get_all');

  return sub {
    my $self = shift;
    my $id = $self->$$id_method;

    if (@_ == 0) {
      my %all = $$driver->$driver_all($self, $id);
      return keys %all;
    } elsif (@_ == 1) {
      my ($name) = @_;
      return $$driver->$driver_get($self, $id, $name);
    } elsif (@_ == 2) {
      my ($name, $value) = @_;
      return $$driver->$driver_set($self, $id, $name, $value);
    } else {
      Carp::confess 'too many arguments passed to hive mutator';
    }
  };
}

sub _build_hive_method {
  my ($self, $arg) = @_;

  my $id_method = $arg->{id_method};
  my $moniker   = ${ $arg->{moniker} };

  my %store_args = (
    method => $self->method_name('mutate', $moniker),
  );

  for my $which (qw(exists delete)) {
    my $method_name = $self->method_name($which, $moniker);

    $store_args{ $which } = sub { $_[0]->param_store->$method_name($_[1]) };
  }

  sub {
    my ($self) = @_;
    my $id = $self->$$id_method;

    # We should really get around to caching these in some awesome way.
    # -- rjbs, 2006-12-09
    Data::Hive->NEW({
      store_class => 'Param',
      store_args  => [ $self, \%store_args ],
    });
  }
}

sub build_method {
  my ($self, $method, $arg) = @_;

  return $self->_build_mutate_method($arg) if $method eq 'mutate';
  return $self->_build_hive_method($arg) if $method eq 'hive';

  $method = 'delete_all' if $method eq 'empty';

  $self->SUPER::build_method($method, $arg);
}

sub driver_method_name {
  my ($self, $method) = @_;
  $self->SUPER::method_name($method, 'extra');
}

sub method_name {
  my ($self, $method, $moniker) = @_;

  return $moniker if $method eq 'hive';

  return "_$method\_$moniker";
}

#pod =head1 TODO
#pod
#pod =for :list
#pod * provide a customizable means to cache created Data::Hive objects
#pod
#pod =cut

1;

__END__