File Coverage

blib/lib/Mixin/Historian.pm

Criterion	Covered	Total	%
statement	32	32	100.0
branch	1	2	50.0
condition			n/a
subroutine	12	12	100.0
pod	5	5	100.0
total	50	51	98.0

package Mixin::Historian 0.102001;
# ABSTRACT: a mixin for recording history about objects

use Mixin::ExtraFields 0.008 ();
use parent 'Mixin::ExtraFields';

use strict;
use warnings;

use Sub::Exporter::ForMethods ();

use Sub::Exporter -setup => {
  groups => {
    history => \'gen_fields_group',
  },
  installer => Sub::Exporter::ForMethods::method_installer(),
};

#pod =head1 SYNOPSIS
#pod
#pod   package My::Object;
#pod   use Mixin::Historian -history => {
#pod     driver => {
#pod       class => 'YourDriver',
#pod       ...,
#pod     },
#pod   };
#pod
#pod   # Later...
#pod   my $object = My::Object->retrieve(1234);
#pod
#pod   $object->add_history({
#pod     type     => 'lava damage',
#pod     severity => 'very badly burned',
#pod     volcano  => 'Eyjafjallajokull',
#pod   });
#pod
#pod =head1 DESCRIPTION
#pod
#pod Mixin::Historian is an application of Mixin::ExtraFields.  If you're not
#pod familiar with it, you should read about it, both in L
#pod documentation|Mixin::ExtraFields> and in L
#pod Mixin::ExtraFields|http://advent.rjbs.manxome.org/2009-12-22.html>.
#pod
#pod Generally, it provides simple mechanism for write-only history.  Importing the
#pod C<-history> group will get you the C method, which generally will
#pod accept one hashref with at least a C key.  This will be passed along to
#pod the driver's C method.
#pod
#pod =head1 TODO
#pod
#pod I have shoehorned an extra layer of functionality into the Historian driver
#pod that I use in my employer's code.  When initialized, the Historian mixin is
#pod told all legal types, something like this:
#pod
#pod   type_map => {
#pod     'lava damage' => {
#pod       severity => { required => 1, store_as => 'extra_1' },
#pod       volcano  => { required => 0, store_as => 'extra_2' },
#pod     },
#pod     ...
#pod   }
#pod
#pod This way, history entries can be validated before writing.  The C
#pod entries indicate how the arguments to C are mapped to database
#pod columns.  The entire argument is also stored in one field as JSON, and a few
#pod other attributes are always required (like C) and some are added just
#pod in time (like C).
#pod
#pod This feature is not yet present in the CPAN library because I have not yet
#pod found a suitable decomposition of concerns to make it a component.
#pod
#pod =cut

sub default_moniker { 'history' }

sub driver_base_class { 'Mixin::Historian::Driver' }

sub methods { qw(add) }

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

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

  # Remember that these are all passed in as references, to avoid unneeded
  # copying. -- rjbs, 2006-12-07
  my $id_method = $arg->{id_method};
  my $driver    = $arg->{driver};

  my $driver_method  = $self->driver_method_name($method_name);

  return sub {
    my $object = shift;
    my $id     = $object->$$id_method;
    Carp::confess "couldn't determine id for object" unless defined $id;
    $$driver->$driver_method({
      object => $object,
      mixin  => $self,
      id     => $id,
      args   => \@_,
    });
  };
}

1;

__END__