The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Myco::Entity::Event;

###############################################################################
# $Id: Event.pm,v 1.5 2006/03/31 19:12:57 sommerb Exp $
#
# See license and copyright near the end of this file.
###############################################################################

=head1 NAME

Myco::Entity::Event - a Myco entity class

=head1 SYNOPSIS

  use Myco;

  # Constructors. See Myco::Entity for more.
  my $obj = Myco::Entity::Event->new;

  # Accessors.
  my $value = $obj->get_fooattrib;
  $obj->set_fooattrib($value);

  $obj->save;
  $obj->destroy;

=head1 DESCRIPTION

An Event logging class for recording information and history for selected
objects

=cut

##############################################################################
# Dependencies
##############################################################################
# Module Dependencies and Compiler Pragma
use warnings;
use strict;
use Myco::Exceptions;
use Myco::Config qw(:evlog);
use WeakRef;
use Myco::Util::DateTime;
use Tangram::Type::Dump::Perl;

##############################################################################
# Constants
##############################################################################
use constant CREATE => 1;
use constant DELETE => 2;
use constant MODIFY => 3;

our @EXPORT = qw(CREATE DELETE MODIFY);

our $kind_map = { &CREATE => 'Create',
                  &DELETE => 'Delete',
                  &MODIFY => 'Modify', };

##############################################################################
# Private Class Variables
##############################################################################
my $event_cache = {};
sub get_event_cache {
    return $event_cache;
}

my $_enabled = EVLOG;
sub enabled {
    return \$_enabled;
}

my $_classes;
for ( @{+EVLOG_CLASSES} ) {
    $_classes->{$_} = undef;
}
sub classes {
    return $_classes;
}

# Must defer import of constants from Myco::Config  until runtime.
# Workaround for mysterious problem when running under mod_perl (?).
#sub init_constants {
#    Myco::Config->import( qw(:evlog) );
#    $_enabled = EVLOG;
#    for ( @{+EVLOG_CLASSES} ) {
#        $_classes->{$_} = undef;
#    }
#}

##############################################################################
# Inheritance & Introspection
##############################################################################
use base qw(Myco::Entity Exporter);
my $md = Myco::Entity::Meta->new
  ( name => __PACKAGE__,
    tangram => { table => 'entity_event' },
  );

##############################################################################
# Function and Closure Prototypes
##############################################################################
# Use this code reference to validate that a real Myco::User object sourced
# the event
my $chk_user_src = sub {
    my $user_src = $ {$_[0]};
    Myco::Exception::DataValidation->throw
        (error => "$user_src is not a Myco::User object")
          unless UNIVERSAL::isa($user_src, 'Myco::User');
};

# Use this code reference to validate the kind of event
my $chk_kind = sub {
    my $kind = $ {$_[0]};
    Myco::Exception::DataValidation->throwMyco::Entity::Test
        (error => "$kind is not a valid kind of event")
          unless defined $kind_map->{$kind};
};

##############################################################################
# Constructor, etc.
##############################################################################

=head1 COMMON ENTITY INTERFACE

Constructor, accessors, and other methods -- as inherited from
Myco::Entity.

=cut

sub new {
    init_constants() unless defined $_enabled;
    my $invocant = shift;
    my $class = ref $invocant || $invocant;
    my %params = @_;
    my $entity = $params{entity};
    my $entity_class = ref $entity;

    # Handle object event
    my $caching;
    if ($entity_class) {
        if ($_enabled && exists $_classes->{$entity_class}) {
            $caching = 1;
        } else {
            return;
        }
    }

    my $event = $class->SUPER::new(@_);

    if ($caching) {
        my $key = "$entity";
        weaken($event->{entity});
        if (exists $event_cache->{$key}) {
            return $event_cache->{$key};
        } else {
            $event_cache->{$key} = $event;
        }
    }
    return $event;
}

##############################################################################
# Attributes & Attribute Accessors / Schema Definition
##############################################################################

=head1 ATTRIBUTES

Attributes may be initially set during object construction (with C<new()>) but
otherwise are accessed solely through accessor methods. Typical usage:

=over 3

=item *  Set attribute value

 $obj->set_attribute($value);

Check functions (see L<Class::Tangram|Class::Tangram>) perform data
validation. If there is any concern that the set method might be called with
invalid data then the call should be wrapped in an C<eval> block to catch
exceptions that would result.

=item *  Get attribute value

 $value = $obj->get_attribute;

=back

A listing of available attributes follows:

=head2 kind

 type: int

The kind of the event. Could be 'Create', 'Delete', or 'Modify'

=cut

my %kind_map = %$kind_map;
$md->add_attribute( name => 'kind',
                    type => 'int',
                    values => [ keys %kind_map ],
                    value_labels => { %kind_map },
                    tangram_options => { check_func => $chk_kind, },
                  );

=head2 state

 type: perl_dump

A string dump of the Entity at time of Event creation.

=cut

$md->add_attribute( name => 'state',
                    type => 'perl_dump',
                    tangram_options => { sql => 'TEXT',
                                         col => 'state' },
                  );



=head2 entity_id

 type: int

The Tangram ID for the entity.

=cut

$md->add_attribute( name => 'entity_id',
                    type => 'int', );



=head2 user_src

 type: ref

The Myco::User object that created (sourced) the entity.

=cut

# NOTE TO SELF: myco-deploy script was puking on the attribute name: 'user'
$md->add_attribute( name => 'user_src',
                    type => 'ref',
                    tangram_options => { check_func => $chk_user_src,
                                         class => 'Myco::User', },
                  );



=head2 entity_class

 type: string

The name of the class of the entity.

=cut

$md->add_attribute( name => 'entity_class',
                    type => 'string', );



=head2 date

 type: rawdate

The date the event was occured.

=cut

$md->add_attribute( name => 'date',
                    type => 'rawdate',
                    tangram_options =>
                    { sql => 'DATE',
                      init_default => sub {
                          Myco::Util::DateTime->date('YYYY-MM-DD') },
                    },
                  );



=head2 entity

 type: transient

The entity object about which an event is being recorded. Intitalized with a
reference to it.

=cut

$md->add_attribute( name => 'entity',
                    type => 'transient', );

##############################################################################
# Methods
##############################################################################

sub flush_event {
    my ($class, $entity) = @_;

    my $key = "$entity";
    if ( exists $event_cache->{$key} ) {
        my $event = $event_cache->{$key};

        my $ent_id = $entity->id;
        $event->set_entity_id( $ent_id ) if $ent_id;

        my $id = Myco->insert($event);
        delete $event_cache->{$key} if exists $event_cache->{$key};
        Myco->unload($event);
        return $id;
    }
}

# Method to build up a cache of events.
sub build_event_cache {
    my ($self, $attr, $val) = @_;
    # Exit if we're trying to create an event for an event object
    return if ref $self eq 'Myco::Entity::Event';

    # Treat $val specially if $val is a reference. Just stringify it for now.
    $val = "$val" if ref $val ne '';

    my $event;
    my $key = "$self";
#    if ( exists $event_cache->{$key} ) {
#        $event_cache->{$key}->{$attr} = $val;
#    } else {
#        $event = Myco::Entity::Event->new;
#        $event_cache->{"$event"}->{$attr} = $val;
#        $event_cache->{"$event"}->{$attr} = $val;
#        $event = $self;
#    }

    # Stringify $event for use as a hash key - we'll probably add attrs to it
}

##############################################################################
# Object Schema Activation and Metadata Finalization
##############################################################################
$md->activate_class;

1;
__END__