# Table.pm
#
# $Id: Table.pm,v 1.3 2005/01/27 21:33:26 rsandberg Exp $
#

package CGI::CRUD::Table;

use strict;

use vars qw(%insert_tags %update_tags @ISA);

use DBIx::IO::Table;
use DBIx::IO::GenLib ();

@ISA = qw(DBIx::IO::Table);


%insert_tags = (
    CREATE_USER => q[defined($self->user()) ? $self->user() : 'UNKNOWN'],
    UPDATE_USER => q[defined($self->user()) ? $self->user() : 'UNKNOWN'],
    CREATE_DATE => 'DBIx::IO::GenLib::local_normal_sysdate()',
    LAST_UPDATE => 'DBIx::IO::GenLib::local_normal_sysdate()',
);

%update_tags = (
    UPDATE_USER => q[defined($self->user()) ? $self->user() : 'UNKNOWN'],
    LAST_UPDATE => 'DBIx::IO::GenLib::local_normal_sysdate()',
);

=pod

=head1 NAME

CGI::CRUD::Table - Convenient database triggers for a web front-end

=head1 DESCRIPTION

Subclass of DBIx::IO::Table convenient for CGI forms.
Provides database trigger-like functions to tag records with the authenticated operator ID and timestamp of last update/insertion.

Default column names that get tagged are:
    CREATE_USER
    UPDATE_USER
    CREATE_DATE
    LAST_UPDATE

so that any columns with these names in any table get automagically populated with their likely value.
These column names and the routines that populate them may be overridden by re-defining %CGI::CRUD::Table::insert_tags and %CGI::CRUD::Table::update_tags.

=cut


sub new
{
    my ($caller,$dbh,$user,$fetch_or_ins,$key_name,$table_name) = @_;
    my $self;
    $self = $caller->SUPER::new($dbh,$fetch_or_ins,$key_name,$table_name) || return $self;
    $self->{user} = $user;
    return $self;
}

sub user
{
    my $self = shift;
    return $self->{user};
}

sub insert
{
    my $self = shift;
    my $insert = shift() || {};
    my $types = $self->column_types();
    foreach my $tag (keys(%insert_tags))
    {
        next unless exists($types->{$tag});
        my $ins = eval($insert_tags{$tag});
        $insert->{$tag} = $ins;
    }
    return $self->SUPER::insert($insert,@_);
}

sub _prepare_update
{
    my $self = shift();
    my $upd = $self->SUPER::_prepare_update(@_);
    if (%$upd)
    {
        my $types = $self->column_types();
        foreach my $tag (keys(%update_tags))
        {
            next unless exists($types->{$tag});
            my $new_val = eval($update_tags{$tag});
            $self->_post_update($tag,$new_val,$upd) || return undef;
        }
    }
    return $upd;
}

sub _post_update
{
    my ($self,$field,$new_val,$upd) = @_;
    defined(eval("\$self->${field}(\$new_val)")) || ($self->{io}->_alert("Check routine failed for $field: $new_val"), return undef);
    defined(eval("\$self->__update__${field}(\$new_val)")) ||
        ($self->{io}->_alert("pre-update routine failed for $field: $new_val"), return undef);
    $upd->{$field} = $new_val;
    return 1;
}

1;

__END__

=head1 SEE ALSO

L<DBIx::IO>, L<DBIx::IO::Table>

=head1 AUTHOR

Reed Sandberg, E<lt>reed_sandberg Ӓ yahooE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2000-2007 Reed Sandberg

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

The full text of the license can be found in the
LICENSE file included with this module.