277 lines
8.8 KiB
Perl
277 lines
8.8 KiB
Perl
# ==================================================================
|
|
# Gossamer Threads Module Library - http://gossamer-threads.com/
|
|
#
|
|
# GT::Session::SQL
|
|
# Author: Alex Krohn
|
|
# CVS Info :
|
|
# $Id: SQL.pm,v 1.34 2004/06/11 21:07:43 alex Exp $
|
|
#
|
|
# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
|
# ==================================================================
|
|
#
|
|
# Description:
|
|
# A module for implementing session management in SQL.
|
|
# Note that it requires a table with the following columns:
|
|
# session_id - must be CHAR(32) BINARY
|
|
# session_user_id
|
|
# session_date - must be INT
|
|
# session_data
|
|
|
|
package GT::Session::SQL;
|
|
# ===============================================================
|
|
# Pragmas
|
|
use strict;
|
|
use vars qw(@ISA $VERSION $DEBUG $ATTRIBS $ERRORS $error $DIRECTORY);
|
|
|
|
# Internal nodules
|
|
use GT::Base ();
|
|
|
|
# Global variable init
|
|
@ISA = qw/GT::Base/;
|
|
$VERSION = sprintf "%d.%03d", q$Revision: 1.34 $ =~ /(\d+)\.(\d+)/;
|
|
$DEBUG = 0;
|
|
|
|
$ATTRIBS = {
|
|
info => {
|
|
session_date => undef,
|
|
session_data => undef,
|
|
session_id => undef,
|
|
session_user_id => undef
|
|
},
|
|
tb => undef,
|
|
_debug => $DEBUG,
|
|
expires => 4
|
|
};
|
|
|
|
$ERRORS = {
|
|
BADDATA => "Invalid data in session: '%s'. Reason: '%s'",
|
|
CLASSFUNC => "This is a class function only.",
|
|
INVALIDSESSION => "Invalid session id: '%s'.",
|
|
BADARGS => "Invalid arguments: %s"
|
|
};
|
|
|
|
sub new {
|
|
# ---------------------------------------------------------------
|
|
# Initilizes a session. Expects to find a session id to lookup, some
|
|
# data to save, or nothing. If no session is defined, then one will
|
|
# be generated. If an invalid session is specified, nothing is returned.
|
|
#
|
|
my $this = shift;
|
|
my $class = ref $this || $this;
|
|
my $self = bless {}, $class;
|
|
|
|
# Set defaults.
|
|
foreach (keys %$ATTRIBS) {
|
|
$self->{$_} = ref $ATTRIBS->{$_} eq 'HASH'
|
|
? {%{$ATTRIBS->{$_}}}
|
|
: $ATTRIBS->{$_};
|
|
}
|
|
|
|
# We got passed in a single session id.
|
|
if (@_ == 2) {
|
|
$self->{tb} = $_[1];
|
|
$self->load($_[0]) or return $self->error('INVALIDSESSION', 'WARN', $_[0]);
|
|
$self->{save} = 0;
|
|
return $self;
|
|
}
|
|
|
|
# We got passed some options, possibly a session id.
|
|
my $suggested;
|
|
if (@_ == 1 and ref $_[0] eq 'HASH') {
|
|
my $opts = $_[0];
|
|
foreach (keys %{$opts}) {
|
|
if (exists $self->{$_}) { $self->{$_} = $opts->{$_} }
|
|
elsif (exists $self->{info}->{$_}) { $self->{info}->{$_} = $opts->{$_} }
|
|
elsif ($_ eq 'suggested_sid') { $suggested = $opts->{$_}; }
|
|
}
|
|
}
|
|
|
|
exists($self->{tb}) or return $self->error("BADARGS", "FATAL", "Must pass in a table object");
|
|
|
|
# If we have an id, load it or return.
|
|
if ($self->{info}->{session_id}) {
|
|
$self->load($self->{info}->{session_id}) or return $self->error('INVALIDSESSION', 'WARN', $self->{info}->{session_id});
|
|
$self->{save} = 0;
|
|
}
|
|
else {
|
|
my $sid;
|
|
$sid = defined $suggested ? $suggested : generate_session_id();
|
|
while ($self->{tb}->count({ session_id => $sid }) > 0) {
|
|
$sid = generate_session_id();
|
|
}
|
|
$self->{info}->{session_id} = $sid;
|
|
$self->{save} = 1;
|
|
}
|
|
|
|
return $self;
|
|
}
|
|
|
|
DESTROY {
|
|
# ---------------------------------------------------------------
|
|
# Makes sure we save the session.
|
|
#
|
|
local $SIG{__WARN__};
|
|
my $self = shift;
|
|
$self->save() if $self->{save};
|
|
$self->debug("Object destroyed.") if $self->{_debug} and $self->{_debug} > 1;
|
|
}
|
|
|
|
sub data {
|
|
# ---------------------------------------------------------------
|
|
# Set/retrieve the data, make sure to set save to 1.
|
|
#
|
|
my $self = shift;
|
|
if (@_ >= 1) {
|
|
$self->{info}->{session_data} = shift;
|
|
$self->{save} = 1;
|
|
}
|
|
return $self->{info}->{session_data};
|
|
}
|
|
|
|
sub load {
|
|
# ---------------------------------------------------------------
|
|
# Loads a session id and data. Also updates the date if the
|
|
# session is valid
|
|
#
|
|
my ($self, $sid) = @_;
|
|
if (defined($sid) and $sid =~ /^\w{1,32}$/) {
|
|
my $expires = $self->{expires};
|
|
my $too_old = ($expires ? time - $expires * 60 * 60 : 0);
|
|
my $sth = $self->{tb}->select(
|
|
GT::SQL::Condition->new(
|
|
'session_id' => '=' => $sid,
|
|
($too_old ? ('session_date' => '>' => $too_old) : ())
|
|
)
|
|
) or return $self->error($GT::SQL::error);
|
|
|
|
my $ret = $sth->fetchrow_hashref;
|
|
if (!$sth->rows or !$ret) {
|
|
$self->debug("Attempted to load invalid session: '$sid'.") if $self->{_debug};
|
|
return;
|
|
}
|
|
my $cp = {};
|
|
for (keys %{$self->{info}}) {
|
|
if ($_ eq 'session_data') {
|
|
if (defined $self->{info}->{session_data}) {
|
|
require GT::Dumper;
|
|
my $data = GT::Dumper->dump(
|
|
var => '',
|
|
data => $self->{info}->{session_data},
|
|
);
|
|
$cp->{session_data} = $data;
|
|
}
|
|
}
|
|
else {
|
|
$cp->{$_} = $self->{info}->{$_};
|
|
}
|
|
}
|
|
if (exists $ret->{session_data}) {
|
|
my $ev = delete $ret->{session_data};
|
|
local ($@, $SIG{__DIE__});
|
|
$self->{info}->{session_data} = eval $ev;
|
|
$@ and return $self->error('BADDATA', 'FATAL', $sid, "$@");
|
|
}
|
|
for (keys %$ret) {
|
|
$self->{info}->{$_} = $ret->{$_};
|
|
$cp->{$_} = $ret->{$_} unless defined $cp->{$_};
|
|
}
|
|
$cp->{session_date} = time;
|
|
my $s = delete $cp->{session_id};
|
|
$self->{tb}->update($cp, { session_id => $s }) or return $self->error($GT::SQL::error);
|
|
}
|
|
else {
|
|
$self->debug("Attempted to load invalid, or blank session '" . (defined($sid) ? $sid : '[undefined]') . ".") if $self->{_debug};
|
|
return;
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
sub save {
|
|
# ---------------------------------------------------------------
|
|
# Save a session id and data.
|
|
#
|
|
my $self = shift;
|
|
my $sid = $self->{info}->{session_id};
|
|
|
|
if ($sid =~ /^\w{1,32}$/ and (defined $self->{info}->{session_user_id} or defined $self->{info}->{session_data})) {
|
|
require GT::Dumper;
|
|
my $data = GT::Dumper->dump(
|
|
var => '',
|
|
data => $self->{info}->{session_data},
|
|
compress => 1 # Eliminates whitespace and changes => to , to shrink the dump
|
|
);
|
|
my $info = {%{$self->{info}}}; # Copy $self->{info}
|
|
$info->{session_data} = $data;
|
|
$info->{session_date} = time;
|
|
if ($self->{tb}->count({ session_id => $sid })) {
|
|
delete $info->{session_id};
|
|
# need to do an update instead of an insert because it already exists
|
|
$self->{tb}->update($info, { session_id => $sid }) or return $self->error($GT::SQL::error);
|
|
$self->debug("Changes to session '$sid' saved.") if $self->{_debug};
|
|
}
|
|
else {
|
|
# It doesn't exist, so insert
|
|
$self->{tb}->insert($info) or return $self->error($GT::SQL::error);
|
|
$self->debug("Session '$sid' created and saved.") if $self->{_debug};
|
|
}
|
|
$self->{save} = 0;
|
|
}
|
|
else {
|
|
$self->debug("Attempted to save invalid session '$sid'") if $self->{_debug};
|
|
}
|
|
}
|
|
|
|
sub delete {
|
|
# ---------------------------------------------------------------
|
|
# Delete a session.
|
|
#
|
|
my $self = shift;
|
|
my $sid = $self->{info}->{session_id};
|
|
|
|
if ($sid =~ /^\w{1,32}$/) {
|
|
$self->{tb}->delete({ session_id => $sid }) or return $self->error($GT::SQL::error);
|
|
|
|
$self->{info}->{session_id} = undef;
|
|
$self->{info}->{session_data} = undef;
|
|
$self->{save} = 0;
|
|
$self->debug("Session '$sid' deleted.") if $self->{_debug};
|
|
}
|
|
else {
|
|
$self->debug("Attempted to delete an invalid session '$sid'") if $self->{_debug};
|
|
return;
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
sub cleanup {
|
|
# ---------------------------------------------------------------
|
|
# Method to cleanup sessions.
|
|
#
|
|
# Takes an optional arguments - the session timeout (in seconds).
|
|
# If omitted, $self->{expires} will be used for the timeout.
|
|
#
|
|
my $self = shift;
|
|
|
|
my $seconds;
|
|
$seconds = @_ ? shift : $self->{expires} * 60 * 60;
|
|
|
|
unless ($seconds) {
|
|
$self->debug("cleanup not deleting anything, seconds set to 0.") if $self->{_debug};
|
|
return;
|
|
}
|
|
|
|
my $too_old = time - $seconds;
|
|
|
|
$self->{tb}->delete(GT::SQL::Condition->new(session_date => '<' => $too_old)) or return $self->error($GT::SQL::error);
|
|
}
|
|
|
|
sub generate_session_id {
|
|
# ---------------------------------------------------------------
|
|
# Generates a session id.
|
|
#
|
|
require GT::MD5;
|
|
GT::MD5::md5_hex(rand(16000) . (time() ^ ($$ + ($$ << 15))) . $$);
|
|
}
|
|
|
|
1;
|