File Coverage

blib/lib/Mixin/ExtraFields/Hive.pm

Criterion	Covered	Total	%
statement	62	63	98.4
branch	13	14	92.8
condition			n/a
subroutine	17	17	100.0
pod	5	5	100.0
total	97	99	97.9

use strict;
use warnings;

package Mixin::ExtraFields::Hive;
{
  $Mixin::ExtraFields::Hive::VERSION = '0.007';
}
use Mixin::ExtraFields 0.002 ();
use parent qw(Mixin::ExtraFields);
# ABSTRACT: infest your objects with hives


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";
}


1;

__END__