CGI::Session::DB2 - DB2 driver for CGI::Session

    use CGI::Session;
    $session = new CGI::Session("driver:DB2", undef, {DB=>'dbname', Schema=>'cgisess',Table=>'cgisess'});

    perl -MCGI::Session::DB2 -e 'CGI::Session::DB2->create(DBName=>q[dbname],Schema=>q[cgisess],Table=>q[cgisess])'

    my $options = {
        DBName => q[web],
        Schema => q[cgisess],
        Table  => q[cgisess],
    };

    if ($ARGV[0] and $ARGV[0] eq 'create')
    {
        CGI::Session::DB2->create($options);
        exit(0);
    }
    my $session = new CGI::Session('driver:DB2', $query, $options);
    # ...

    if ($ARGV[0] and $ARGV[0] eq 'cleanup')
    {
        CGI::Session::DB2->cleanup($options);
        exit(0);
    }

package CGI::Session::DB2;

use strict;
use base qw(
    CGI::Session
    CGI::Session::ID::MD5
    CGI::Session::Serialize::Default
);

our $VERSION = '0.03';

# stores the serialized data. Returns 1 for sucess, undef otherwise
sub store
{
    my ($self, $sid, $options, $data) = @_;

    my $table = $self->get_table($options);
    my $row   = $table->find_id($sid);
    unless ($row)
    {
        $row = $table->create_row();
        $row->column(id => $sid);
    }
    $row->column(asession => $self->freeze($data));
    if ($self->expire())
    {
        $row->column(expires  => $self->expire() + $self->atime());
    }
    else
    {
        $row->column(expires => undef);
    }

    $row->save();
}

# retrieves the serialized data and deserializes it
sub retrieve {
    my ($self, $sid, $options) = @_;

    my $table = $self->get_table($options);
    my $row = $table->find_id($sid);

    $row ? $self->thaw($row->column('asession')) : undef;
}


# removes the given data and all the disk space associated with it
sub remove
{
    my ($self, $sid, $options) = @_;

    my $table = $self->get_table($options);
    my $row = $table->find_id($sid);
    $table->delete($row) if $row;

    1;
}


# called right before the object is destroyed to do cleanup
sub teardown
{
    my ($self, $sid, $options) = @_;

    return 1;
}

sub get_table
{
    my ($self, $options) = @_;

    return $self->{_table} if $self->{_table};

    my ($db, $table) = _setup_db($options);
    $self->{_db} = $db;
    $self->{_table} = $table;

    $table;
}

sub _setup_db
{
    my $options = shift;
    $options = $options->[1] if $options and ref $options and ref $options eq 'ARRAY';
    
    my $db = $options->{DB2Driver} || 'CGI::Session::DB2::db';
    unless (ref $db)
    {
        $db = $db->new();
        unless ($options->{DB2Driver})
        {
            $db->{db_name} = $options->{Database} || 'cgisess';
            $db->{user_name} = $options->{UserName};
            $db->{user_pw} = $options->{UserPW};
        }
    }
    $db->add_table($options->{Table} || 'Cgisess');
    my $table = $db->get_table($options->{Table} || 'Cgisess');
    $table->{schema_name} = $options->{Schema} || 'cgisess';
    $table->{table_name} = $options->{Table} || 'Cgisess';

    ($db,$table);
}

sub create
{
    my $name = shift;
    my $options = $_[0];
    unless (ref $options eq 'HASH')
    {
        $options = { @_ };
    }
    my ($db, $table) = _setup_db($options);

    $db->create_db();
}

# quick clean up of expired sessions.
sub cleanup
{
    my $name = shift;
    my $options = $_[0];
    unless (ref $options eq 'HASH')
    {
        $options = { @_ };
    }
    my ($db, $table) = _setup_db($options);
    $table->delete_where('EXPIRES < ?',
                         DB2::Row->time_to_timestamp(time));
}


package CGI::Session::DB2::db;

use base 'DB2::db';

sub db_name { shift->{db_name} }
sub user_name { shift->{user_name} }
sub user_pw { shift->{user_pw} }

sub setup_row_table_relationships {}

package CGI::Session::DB2::Cgisess;

use base 'DB2::Table';

sub schema_name { shift->{schema_name} }
sub table_name { shift->{table_name} }

sub data_order {
    [
     {
         COLUMN => 'ID',
         TYPE   => 'CHAR',
         LENGTH => 32,
         PRIMARY => 1,
     },
     {
         COLUMN => 'ASESSION',
         TYPE   => 'LONG VARCHAR',
     },
     {
         COLUMN => 'EXPIRES',
         TYPE   => 'TIMESTAMP',
     },
    ];
}

# cannot use distinct for VARCHAR tables.  DB2::db probably should
# be smarter than this, but this works in the meantime.
sub _prepare_attributes {
    { distinct => 0 }
}

1;