File Coverage

blib/lib/Object/Annotate.pm

Criterion	Covered	Total	%
statement	106	117	90.6
branch	23	36	63.8
condition	19	45	42.2
subroutine	18	21	85.7
pod	11	11	100.0
total	177	230	76.9

use warnings;
use strict;
package Object::Annotate;
{
  $Object::Annotate::VERSION = '0.024';
}
# ABSTRACT: mix in logging-to-database to objects (deprecated)

use Carp ();
use UNIVERSAL::moniker 0.01;


# We'll store the constructed Class::DBI subclasses here.
# $class_for->{ $dsn }->{ $table } = $class
my $class_for = {};

# We'll keep a counter, here, to use to form unique class names.
my $current_suffix = 0;

# The "id" column isn't here because we want it first, always.
my %note_columns = (
  mandatory => [ qw(class object_id created) ],
  # I plan to use these values in the future. -- rjbs, 2006-01-13
  # default   => [ qw(event attr old_val new_val via comment expire_time) ],
  default   => [ qw(event attr old_val new_val via comment expire_time) ],
);

use Sub::Exporter 0.92 -setup => {
  groups => { annotator => \&setup_class },
};


sub new {
  my ($self, $arg) = @_;
  my $class = (ref $self) ? ref $self : $self;

  my $target
    = sprintf '%s::Singularity::0x%08x', $class, ++$current_suffix;

  $self->setup_class($target, $arg);

  my $singularity = \do { undef };
  bless $singularity => $target;
}



sub setup_class {
  my ($self, $name, $arg, $col) = @_;

  $arg->{db}{dsn}   ||= $self->default_dsn;
  $arg->{db}{table} ||= $self->default_table;

  $arg->{db}{user}  ||= $self->default_user;
  $arg->{db}{pass}  ||= $self->default_pass;

  $arg->{db}{sequence} ||= $self->_default_sequence;

  if ($arg->{noun} xor $arg->{verb}) {
    Carp::croak 'you must supply either both or neither "noun" and "verb"';
  } elsif (not ($arg->{noun} or $arg->{verb})) {
    @$arg{qw(noun verb)} = qw(annotations annotate);
  }

  my $class     = $self->class_for($arg);

  my $obj_class = $arg->{obj_class};

  my %build_option = (
    obj_class => $obj_class,
    id_attr   => $arg->{id_attr} || 'id',

    noun => $arg->{noun},
    verb => $arg->{verb},
  );

  my $annotator = $self->build_annotator({
    %build_option,
    columns   => $arg->{columns},
    set_time  => ($arg->{db}{dsn} && (scalar $arg->{db}{dsn} =~ /SQLite/)),
  });

  my $return = {
    "$arg->{noun}_class"  => sub { $class },
    $arg->{verb}          => $annotator,
    "search_$arg->{noun}" => $self->build_searcher(\%build_option),
  };
}


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

  my $dsn   = $arg->{db}{dsn};
  my $table = $arg->{db}{table};

  my $user  = $arg->{db}{user};
  my $pass  = $arg->{db}{pass};

  # Try to find an already-constructed class.
  my $class = ! $arg->{extra_setup}
           && exists $class_for->{ $dsn }
           && exists $class_for->{ $dsn }->{ $table }
           && $class_for->{ $dsn }->{ $table };

  return $class if $class;

  # If we have no class built for this combination, build it.
  $class = $self->construct_cdbi_class({
    dsn      => $dsn,
    user     => $user,
    pass     => $pass,
    table    => $table,
    columns  => $arg->{columns},
    sequence => $arg->{db}{sequence},
    base_class => $arg->{base_class},
  });

  $arg->{extra_setup}->($class) if $arg->{extra_setup};

  return $class;
}


sub default_dsn   { $ENV{OBJ_ANNOTATE_DSN};   }
sub default_table { $ENV{OBJ_ANNOTATE_TABLE}; }
sub default_user  { $ENV{OBJ_ANNOTATE_USER}; }
sub default_pass  { $ENV{OBJ_ANNOTATE_PASS}; }
sub default_base_class  { 'Class::DBI' }

sub _default_sequence {  }


sub construct_cdbi_class {
  my ($class, $arg) = @_;

  my $new_class
    = sprintf '%s::Construct::0x%08x', __PACKAGE__, ++$current_suffix;

  $arg->{base_class} ||= $class->default_base_class;

  eval "require $arg->{base_class};" or die $@;
  do {
    no strict 'refs';
    @{$new_class . '::ISA'} = $arg->{base_class};
  };

  if ($arg->{dsn}) {
    $new_class->connection($arg->{dsn}, $arg->{user}, $arg->{pass});
  }

  $new_class->table($arg->{table});

  my @columns = @{ $note_columns{mandatory} };
  my @extra_columns = @{ $arg->{columns} || $note_columns{default} };
  push @columns, @extra_columns;

  $new_class->columns(All => ('id', @columns));

  $new_class->sequence($arg->{sequence}) if $arg->{sequence};

  $new_class->db_Main->{ AutoCommit } = 1;

  return $class_for->{ $arg->{dsn} || '' }->{ $arg->{table} } = $new_class;
}


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

  my $obj_class = $arg->{obj_class};
  my $id_attr   = $arg->{id_attr};
  my $set_time  = $arg->{set_time};

  my @columns
    = $arg->{columns} ? @{ $arg->{columns} } : @{ $note_columns{default} };

  my $noun      = $arg->{noun};

  my $annotator = sub {
    # This $arg purposefully shadows the previous; I don't want to enclose
    # those args. -- rjbs, 2006-01-05
    my ($self, $arg) = @_;
    my $obj_class = $arg->{obj_class} || $self->moniker;

    my $id;
    if (ref $id_attr) {
      $id = $$id_attr;
    } else {
      $id = $self->$id_attr;
      Carp::croak "couldn't get id for $self via $id_attr" unless $id;
    }

    # build up only those attributes we declared
    my %attr;
    for (@columns) {
      next unless exists $arg->{$_};
      $attr{$_} = $arg->{$_};
    }

    $attr{created} = time if $set_time;

    my $class_name_method = "$noun\_class";
    my $request = $self->$class_name_method->create({
      class     => $obj_class,
      object_id => $id,
      %attr,
    });

    return $request;
  };

  return $annotator;
}


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

  my $obj_class = $arg->{obj_class};
  my $id_attr   = $arg->{id_attr};

  my $noun      = $arg->{noun};

  my $searcher = sub {
    my ($self, $arg) = @_;
    my $obj_class = $arg->{obj_class} || $self->moniker;
    $arg ||= {};

    my $id;
    if (ref $id_attr) {
      $id = $$id_attr;
    } elsif (ref $self) {
      $id = $self->$id_attr;
      Carp::croak "couldn't get id for $self via $id_attr" unless $id;
    }

    $arg->{class}     = $obj_class;
    $arg->{object_id} = $id if defined $id and not exists $arg->{object_id};

    my $class_name_method = "$noun\_class";
    $self->$class_name_method->search(%$arg);
  }
}

'2. see footnote #1';

__END__