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

CGI-CRUD documentation Contained in the CGI-CRUD distribution.

Index

Code Index:

NAME

Top

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

DESCRIPTION

Top

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.

SEE ALSO

Top

DBIx::IO, DBIx::IO::Table

AUTHOR

Top

Reed Sandberg, <reed_sandberg Ӓ yahoo>

COPYRIGHT AND LICENSE

Top

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.

CGI-CRUD documentation Contained in the CGI-CRUD distribution. 
# 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()',
);



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__