First pass at adding key files
This commit is contained in:
dsainty
297
site/slowtwitch.com/cgi-bin/articles/GT/Session/File.pm
Normal file
297
site/slowtwitch.com/cgi-bin/articles/GT/Session/File.pm
Normal file
@ -0,0 +1,297 @@
|
||||
# ==================================================================
|
||||
# Gossamer Threads Module Library - http://gossamer-threads.com/
|
||||
#
|
||||
# GT::Session::File
|
||||
# Author : Alex Krohn
|
||||
# CVS Info : 087,071,086,086,085
|
||||
# $Id: File.pm,v 1.15 2007/11/02 01:32:34 brewt Exp $
|
||||
#
|
||||
# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
||||
# ==================================================================
|
||||
#
|
||||
# Description:
|
||||
# A module for implementing session management.
|
||||
#
|
||||
# Todo:
|
||||
# - SQL Support.
|
||||
#
|
||||
|
||||
package GT::Session::File;
|
||||
# ===============================================================
|
||||
# Pragmas
|
||||
use strict;
|
||||
use vars qw(@ISA $VERSION $DEBUG $ATTRIBS $ERRORS $error $DIRECTORY $SESSION);
|
||||
|
||||
# Internal nodules
|
||||
use GT::Base ();
|
||||
use GT::MD5 qw/md5_hex/;
|
||||
use GT::Dumper;
|
||||
|
||||
# Global variable init
|
||||
@ISA = qw/GT::Base/;
|
||||
$VERSION = sprintf "%d.%03d", q$Revision: 1.15 $ =~ /(\d+)\.(\d+)/;
|
||||
$DEBUG = 0;
|
||||
$ATTRIBS = {
|
||||
id => undef,
|
||||
data => undef,
|
||||
directory => undef,
|
||||
save => 0,
|
||||
subdir => 0,
|
||||
|
||||
_debug => $DEBUG
|
||||
};
|
||||
$ERRORS = {
|
||||
'BADDATA' => "Invalid data in session: '%s'. Reason: '%s'",
|
||||
'NOROOT' => "No root directory was defined!",
|
||||
'CANTOPEN' => "Can't open file: '%s'. Reason: '%s'",
|
||||
'CANTDEL' => "Unable to delete file: '%s'. Reason: '%s'",
|
||||
'CLASSFUNC' => "This is a class function only.",
|
||||
'INVALIDSESSION' => "Invalid session id: '%s'."
|
||||
};
|
||||
$DIRECTORY = "./auth";
|
||||
$SESSION = '';
|
||||
|
||||
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->{$_} = $ATTRIBS->{$_};
|
||||
}
|
||||
|
||||
# Don't save by default.
|
||||
$self->{save} = 0;
|
||||
|
||||
# We got passed in a single session id.
|
||||
if (@_ == 1) {
|
||||
$self->load ($_[0]) or return $self->error ('INVALIDSESSION', 'WARN', $_[0]);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# We got passed some options, possibly a session id.
|
||||
if (@_ > 1) {
|
||||
my $opts = $self->common_param(@_);
|
||||
foreach (keys %$opts) {
|
||||
exists $self->{$_} and ($self->{$_} = $opts->{$_});
|
||||
}
|
||||
if ($self->{directory}) {
|
||||
$DIRECTORY = $self->{directory};
|
||||
}
|
||||
}
|
||||
|
||||
# If we have an id, load it or return.
|
||||
if ($self->{id}) {
|
||||
$self->load ($self->{id}) or return $self->error ('INVALIDSESSION', 'WARN', $self->{id});
|
||||
}
|
||||
else {
|
||||
$self->{id} = generate_session_id();
|
||||
$self->{save} = 1;
|
||||
}
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub DESTROY {
|
||||
# ---------------------------------------------------------------
|
||||
# Makes sure we save the session.
|
||||
#
|
||||
$_[0]->save() if ($_[0]->{save});
|
||||
$_[0]->debug ("Object destroyed.") if ($_[0]->{_debug} > 1);
|
||||
}
|
||||
|
||||
sub data {
|
||||
# ---------------------------------------------------------------
|
||||
# Set/retrieve the data, make sure to set save to 1.
|
||||
#
|
||||
if (@_ > 1) { $_[0]->{data} = $_[1]; $_[0]->{save} = 1; }
|
||||
return $_[0]->{data};
|
||||
}
|
||||
|
||||
sub load {
|
||||
# ---------------------------------------------------------------
|
||||
# Loads a session id and data.
|
||||
#
|
||||
my ($self, $sid) = @_;
|
||||
if (($sid =~ /^([\w\d]+)$/) and (length $sid < 40)) {
|
||||
$sid = $1;
|
||||
my $root = $DIRECTORY or return $self->error ('NOROOT', 'FATAL');
|
||||
my $file = $root;
|
||||
if ($self->{subdir}) {
|
||||
$file .= '/' . substr ($sid, 0, 1);
|
||||
}
|
||||
$file .= '/' . $sid;
|
||||
if (-e $file) {
|
||||
local ($@, $!, $SESSION);
|
||||
$file =~ /(.*)/;
|
||||
$file = $1;
|
||||
|
||||
do "$file";
|
||||
($@ || $!) and return $self->error ('BADDATA', 'FATAL', $file, "$@" || "$!");
|
||||
$self->{data} = $SESSION;
|
||||
$self->{id} = $sid;
|
||||
$self->debug ("Session '$sid' loaded ok.") if ($self->{_debug});
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
$self->debug ("Attempted to load invalid session: '$sid'.") if ($self->{_debug});
|
||||
}
|
||||
}
|
||||
else {
|
||||
$self->debug ("Attempted to load invalid, or blank session '$sid'.") if ($self->{_debug});
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
sub save {
|
||||
# ---------------------------------------------------------------
|
||||
# Save a session id and data.
|
||||
#
|
||||
my $self = shift;
|
||||
my $sid = $self->{id};
|
||||
|
||||
if (($sid =~ /^([\w\d]+)$/) and (length $sid < 40)) {
|
||||
$sid = $1;
|
||||
my $root = $DIRECTORY or return $self->error ('NOROOT', 'FATAL');
|
||||
my $file = $root;
|
||||
if ($self->{subdir}) {
|
||||
$file .= '/' . substr ($sid, 0, 1);
|
||||
-d $file or mkdir ($file, 0755) or return $self->error ('CANTOPEN', 'FATAL', $file, "$!");
|
||||
}
|
||||
$file .= '/' . $sid;
|
||||
my $fh = \do {local *FH; *FH};
|
||||
open ($fh, "> $file") or return $self->error ('CANTOPEN', 'FATAL', $file, "$!");
|
||||
my $dump = GT::Dumper->dump(
|
||||
var => '$SESSION',
|
||||
data => $self->{data}
|
||||
);
|
||||
print $fh $dump;
|
||||
close $fh;
|
||||
$self->{save} = 0;
|
||||
$self->debug ("Session '$sid' saved.") if ($self->{_debug});
|
||||
}
|
||||
else {
|
||||
$self->debug ("Attempted to save invalid session '$sid'") if ($self->{_debug});
|
||||
}
|
||||
}
|
||||
|
||||
sub delete {
|
||||
# ---------------------------------------------------------------
|
||||
# Delete a session.
|
||||
#
|
||||
my $self = shift;
|
||||
my $sid;
|
||||
if (! ref $self) {
|
||||
$self = bless { _debug => $DEBUG }, $self;
|
||||
$sid = shift;
|
||||
}
|
||||
else {
|
||||
$sid = $self->{id}
|
||||
}
|
||||
|
||||
if (($sid =~ /^([\w\d]+)$/) and (length $sid < 40)) {
|
||||
$sid = $1;
|
||||
my $root = $DIRECTORY or return $self->error ('NOROOT', 'FATAL');
|
||||
my $file = $root;
|
||||
if ($self->{subdir}) {
|
||||
$file .= '/' . substr ($sid, 0, 1);
|
||||
}
|
||||
$file .= '/' . $sid;
|
||||
unlink $file or return $self->error ('CANTDEL', 'WARN', $file, "$!");
|
||||
$self->{id} = undef;
|
||||
$self->{data} = undef;
|
||||
$self->{save} = 0;
|
||||
$self->debug ("Session '$sid' deleted.") if ($self->{_debug});
|
||||
}
|
||||
}
|
||||
|
||||
sub cleanup {
|
||||
# ---------------------------------------------------------------
|
||||
# CLASS function to cleanup session directory.
|
||||
#
|
||||
my ($self, $seconds, $directory) = @_;
|
||||
(ref $self) or $self = bless { _debug => $DEBUG }, $self;
|
||||
|
||||
if ($seconds == 0) {
|
||||
$self->debug ("Cleanup not erasing anything, seconds set to 0.") if ($self->{_debug});
|
||||
return;
|
||||
}
|
||||
|
||||
defined $seconds or ($seconds = 3600);
|
||||
defined $directory or ($directory = $DIRECTORY);
|
||||
$directory or return $self->error ('NOROOT', 'FATAL');
|
||||
|
||||
my $dir = \do {local *FH; *FH};
|
||||
opendir ($dir, $directory) or return $self->error ('CANTOPEN', 'FATAL', $directory, "$!");
|
||||
my @files = grep { $_ and (!/^\.\.?$/) and (/^[\w\d]+$/) and (length ($_) < 40) } readdir ($dir);
|
||||
closedir ($dir);
|
||||
|
||||
foreach my $file (@files) {
|
||||
my $full_file = "$directory/$file";
|
||||
my $is_dir = -d $full_file;
|
||||
|
||||
if ($self->{subdir} and $is_dir) {
|
||||
my $dir = \do {local *FH; *FH};
|
||||
opendir $dir, $full_file or return $self->error ('CANTOPEN', 'FATAL', $full_file, "$!");
|
||||
push @files, map { $file . '/' . $_ } grep { (!/^\.\.?$/) and (/^[\w\d]+$/) and (length ($_) < 40) } readdir ($dir);
|
||||
closedir $dir;
|
||||
next;
|
||||
}
|
||||
elsif ($is_dir) {
|
||||
next;
|
||||
}
|
||||
|
||||
if (((stat($full_file))[9] + $seconds) <= time()) {
|
||||
$self->debug ("Cleanup is removing '$full_file' older then $seconds s. old.") if ($self->{_debug});
|
||||
$full_file =~ /(.*)/;
|
||||
$full_file = $1;
|
||||
unlink $full_file or return $self->error ('CANTDEL', 'FATAL', $full_file, "$!");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub generate_session_id {
|
||||
# ---------------------------------------------------------------
|
||||
# Generates a session id.
|
||||
#
|
||||
return md5_hex ( time . $$ . rand (16000) );
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
GT::Session::File - A session management module, with simple data storage/retrieval.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
Create a session:
|
||||
my $session = new GT::Session::File;
|
||||
my $id = $session->id();
|
||||
|
||||
Save data with the session:
|
||||
$session->data ("Save this information!");
|
||||
|
||||
Load a session.
|
||||
my $session = new GT::Session::File ( $id ) or die "Can't load session: '$id'."
|
||||
|
||||
Set session directory.
|
||||
my $session = new GT::Session::File ( directory => '/path/to/sessions', id => $id );
|
||||
|
||||
Delete a session
|
||||
$session->delete();
|
||||
|
||||
Cleanup old sessions, takes argument of number of seconds old.
|
||||
$session->cleanup ( 5000 );
|
||||
|
||||
=head1 TODO
|
||||
|
||||
* Integrate SQL interface into flatfile interface.
|
||||
289
site/slowtwitch.com/cgi-bin/articles/GT/Session/SQL.pm
Normal file
289
site/slowtwitch.com/cgi-bin/articles/GT/Session/SQL.pm
Normal file
@ -0,0 +1,289 @@
|
||||
# ==================================================================
|
||||
# Gossamer Threads Module Library - http://gossamer-threads.com/
|
||||
#
|
||||
# GT::Session::SQL
|
||||
# Author: Alex Krohn
|
||||
# CVS Info : 087,071,086,086,085
|
||||
# $Id: SQL.pm,v 1.36 2006/07/25 04:27:50 brewt 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.36 $ =~ /(\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 $sth = $self->{tb}->select({ session_id => $sid }) or return $self->error($GT::SQL::error);
|
||||
my $ret = $sth->fetchrow_hashref;
|
||||
if (!$sth->rows or !$ret) {
|
||||
$self->debug("Attempted to load invalid or expired session: '$sid'.") if $self->{_debug};
|
||||
return;
|
||||
}
|
||||
|
||||
# For backwards compatibility - session_expires isn't a required column
|
||||
# The only two instances where the date doesn't need to be checked is if
|
||||
# expires is 0, or the session_expires column exists and it is 0
|
||||
my $check_date = 1;
|
||||
if (not $self->{expires} or (exists $ret->{session_expires} and not $ret->{session_expires})) {
|
||||
$check_date = 0;
|
||||
}
|
||||
if ($check_date and $ret->{session_date} < time - $self->{expires} * 60 * 60) {
|
||||
$self->debug("Attempted to load expired 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;
|
||||
$cp->{session_data} = GT::Dumper->dump(
|
||||
var => '',
|
||||
compress => 1,
|
||||
data => $self->{info}->{session_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};
|
||||
}
|
||||
# It doesn't exist, so insert
|
||||
else {
|
||||
# For backwards compatibility - session_expires isn't a required column
|
||||
if (exists $self->{tb}->cols->{session_expires}) {
|
||||
$info->{session_expires} = $self->{expires} ? 1 : 0;
|
||||
}
|
||||
$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 $cond = GT::SQL::Condition->new(session_date => '<' => time - $seconds);
|
||||
# For backwards compatibility - session_expires isn't a required column
|
||||
if (exists $self->{tb}->cols->{session_expires}) {
|
||||
$cond->add(session_expires => '=' => 1);
|
||||
}
|
||||
|
||||
$self->{tb}->delete($cond) 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;
|
||||
310
site/slowtwitch.com/cgi-bin/articles/GT/Session/TempTable.pm
Normal file
310
site/slowtwitch.com/cgi-bin/articles/GT/Session/TempTable.pm
Normal file
@ -0,0 +1,310 @@
|
||||
package GT::Session::TempTable;
|
||||
# ===============================================================
|
||||
# Pragmas
|
||||
use strict;
|
||||
use vars qw| $ATTRIBS @ISA $ERRORS |;
|
||||
|
||||
# Internal nodules
|
||||
use GT::Base;
|
||||
use GT::SQL;
|
||||
use GT::MD5 qw| md5_hex |;
|
||||
|
||||
# Global variable init
|
||||
@ISA = qw| GT::Base |;
|
||||
|
||||
$ATTRIBS = {
|
||||
id => undef,
|
||||
tb => undef,
|
||||
|
||||
def_path => '',
|
||||
db => undef,
|
||||
set_name => 'Set_Sessions',
|
||||
create_session => undef,
|
||||
delete_session => undef,
|
||||
seconds => 60*60,
|
||||
sid => ''
|
||||
};
|
||||
|
||||
$ERRORS = {
|
||||
'NODB' => "No GT::SQL object, need to set 'db' or 'def_path'",
|
||||
'NOCS' => "No session creation hook specified",
|
||||
'CSNOTCODE' => "Session creation hook is not a coderef",
|
||||
'NOSID' => "No session ID",
|
||||
'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 install {
|
||||
#-------------------------------------------------------------------------------
|
||||
# creates the controller table
|
||||
#
|
||||
my $self = shift;
|
||||
my $DB = $self->_db();
|
||||
|
||||
my $c = $DB->creator( $self->{set_name} );
|
||||
|
||||
$c->cols(
|
||||
ID => { pos => 1, type => 'INT', not_null => 1, unsigned => 1, regex => '^d+$' },
|
||||
SessID => { pos => 2, type => 'CHAR', size => 100, not_null => 1 },
|
||||
SessTable => { pos => 3, type => 'CHAR', size => 100, not_null => 1 },
|
||||
Timestmp => { pos => 4, type => 'TIMESTAMP', time_check => 1 }
|
||||
);
|
||||
|
||||
$c->pk('ID');
|
||||
$c->ai('ID');
|
||||
$c->create('force');
|
||||
$c->set_defaults();
|
||||
$c->save_schema();
|
||||
}
|
||||
|
||||
sub uninstall {
|
||||
#-------------------------------------------------------------------------------
|
||||
# drops the controller table along with all the
|
||||
#
|
||||
my $self = shift;
|
||||
my $DB = $self->_db() or return;
|
||||
my $err = 1;
|
||||
|
||||
# drop all the associated temp tables...,
|
||||
eval {
|
||||
my $tb = $DB->table( $self->{set_name} );
|
||||
my $sth = $tb->select( [ 'SessTable' ] );
|
||||
while ( my $aref = $sth->fetchrow_arrayref() ) {
|
||||
my $table_name = $aref->[0];
|
||||
eval {
|
||||
my $e = $DB->editor( $table_name );
|
||||
$e->drop_table("remove") or die "Can't drop table";
|
||||
};
|
||||
$@ and $err = undef;
|
||||
|
||||
}
|
||||
|
||||
# now drop the master control table
|
||||
my $e = $DB->editor( $self->{set_name});
|
||||
$e->drop_table("remove") or die "Can't drop table";
|
||||
};
|
||||
|
||||
return $@ ? undef : 1;
|
||||
}
|
||||
|
||||
sub new_set {
|
||||
#-------------------------------------------------------------------------------
|
||||
# creates a new temp table
|
||||
#
|
||||
my $self = shift;
|
||||
my $create_session = ( ref $_[0] eq 'CODE' ? shift : $self->{create_session} ) or return $self->error( 'NOCS', 'WARN' );
|
||||
|
||||
my $sid = $self->{id} or return $self->error( 'NOSID', 'WARN' );
|
||||
my $DB = $self->_db();
|
||||
my $Session = $DB->table( $self->{set_name} );
|
||||
|
||||
# create a new sesson
|
||||
my $table_name = generate_session_id();
|
||||
my $newid = $Session->add({ SessTable => $table_name, SessID => $sid }) or return;
|
||||
|
||||
# create the new table, extra parameters are passed into the create_session sub procedure
|
||||
if ( my $result = &{$create_session}( $DB, $table_name, $newid, @_ ) ) {
|
||||
my $tbl = $DB->table( $table_name );
|
||||
return wantarray ? ( $tbl, $newid ) : $tbl;
|
||||
}
|
||||
else {
|
||||
$Session->delete($newid);
|
||||
return;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
sub get_set {
|
||||
#-------------------------------------------------------------------------------
|
||||
# returns a table reference to the sethandle
|
||||
#
|
||||
my $self = shift;
|
||||
my $set_id = shift or return;
|
||||
my $sid = $self->{id} or return $self->error( 'NOSID', 'WARN' );
|
||||
|
||||
my $DB = $self->_db();
|
||||
my $Session = $DB->table( $self->{set_name} ) or return;
|
||||
my $sth = $Session->select({ ID => $set_id, SessID => $sid }) or return undef;
|
||||
my $href = $sth->fetchrow_hashref() or return undef;
|
||||
$href->{Timestmp} = \'NOW()';
|
||||
$Session->update( $href );
|
||||
|
||||
if ( my $table_name = $href->{'SessTable'} ) {
|
||||
my $tbl = $DB->table( $table_name );
|
||||
return $tbl;
|
||||
}
|
||||
else {
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
sub list_sets {
|
||||
#-------------------------------------------------------------------------------
|
||||
# returns a hashref of ID => tablenames, of tables that the current session ID owns
|
||||
#
|
||||
my $self = shift;
|
||||
my $DB = $self->_db();
|
||||
|
||||
my $sid = $self->{id} or return $self->error( 'NOSID', 'WARN' );
|
||||
my $Session = $DB->table( $self->{set_name} ) or return;
|
||||
|
||||
my $sth = $Session->select({ SessID => $sid }, [ 'ID', 'SessTable' ]);
|
||||
my $list = {};
|
||||
while ( my $aref = $sth->fetchrow_arrayref() ) {
|
||||
my ( $id, $sesstable ) = @{$aref};
|
||||
$list->{$id} = $sesstable;
|
||||
}
|
||||
|
||||
return $list;
|
||||
}
|
||||
|
||||
sub delete {
|
||||
#-------------------------------------------------------------------------------
|
||||
# deletes all sets associated with the session
|
||||
#
|
||||
my $self = shift;
|
||||
my $DB = $self->_db();
|
||||
|
||||
my $Session = $DB->table( $self->{set_name} ) or return;
|
||||
my $sid = ( shift || $self->{id} ) or return $self->error( 'NOSID', 'WARN' );
|
||||
my $sth = $Session->select({ SessID => $sid },['SessTable']);
|
||||
|
||||
# delete all created temp tables
|
||||
while ( my $aref = $sth->fetchrow_arrayref() ) {
|
||||
my $tbl_name = $aref->[0];
|
||||
eval {
|
||||
my $e = $DB->editor($tbl_name);
|
||||
$e->drop_table( "remove" );
|
||||
}
|
||||
}
|
||||
|
||||
$Session->delete({ SessID => $sid });
|
||||
|
||||
# cheap workaround
|
||||
shift or $self->GT::Session::SQL::delete();
|
||||
}
|
||||
|
||||
sub delete_set {
|
||||
#-------------------------------------------------------------------------------
|
||||
# deletes a single set
|
||||
#
|
||||
my $self = shift;
|
||||
my $set_id = shift;
|
||||
|
||||
my $DB = $self->_db();
|
||||
my $Session = $DB->table( $self->{set_name} ) or return;
|
||||
my $sid = $self->{id} or return $self->error( 'NOSID', 'WARN' );
|
||||
my $sth = $Session->select( { ID => $set_id, SessID => $sid }, [ 'SessTable' ] ) or return;
|
||||
my $aref = $sth->fetchrow_arrayref() or return;
|
||||
|
||||
if ($aref->[0]) {
|
||||
my $e = $DB->editor($aref->[0]);
|
||||
$e->drop_table();
|
||||
$Session->delete( { ID => $set_id } );
|
||||
}
|
||||
}
|
||||
|
||||
sub cleanup {
|
||||
#-------------------------------------------------------------------------------
|
||||
my $self = shift;
|
||||
my $seconds = shift || $self->{seconds};
|
||||
|
||||
if ($seconds == 0) {
|
||||
$self->debug ("Cleanup not erasing anything, seconds set to 0.") if ($self->{_debug});
|
||||
return;
|
||||
}
|
||||
|
||||
my $DB = $self->_db() or return;
|
||||
my $tb = $DB->table( $self->{set_name} );
|
||||
|
||||
defined $seconds or ($seconds = 3600);
|
||||
my $new_sec = time - $seconds;
|
||||
my @time = localtime ($new_sec);
|
||||
|
||||
my $date_str = sprintf ("%4d-%02d-%02d %02d:%02d:%02d",
|
||||
$time[5] + 1900, $time[4] + 1, $time[3], $time[2], $time[1], $time[0]);
|
||||
|
||||
my $sth = $tb->select( GT::SQL::Condition->new('Timestmp', '<', $date_str), [ 'SessID' ] ) or return $self->error ($GT::SQL::error);
|
||||
while ( my $aref = $sth->fetchrow_arrayref() ) {
|
||||
$self->delete( $aref->[0], 1 );
|
||||
}
|
||||
$tb->delete (GT::SQL::Condition->new ('Timestmp', '<', $date_str)) or return $self->error ($GT::SQL::error);
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub _db {
|
||||
#-------------------------------------------------------------------------------
|
||||
# returns a database handle
|
||||
#
|
||||
my $self = shift;
|
||||
if ( my $db = $self->{'db'} ) {
|
||||
return $db;
|
||||
}
|
||||
|
||||
elsif ( my $def_path = $self->{'def_path'} ) {
|
||||
$db = GT::SQL->new( $def_path );
|
||||
return $db;
|
||||
}
|
||||
|
||||
else {
|
||||
$self->error( 'NODB', 'FATAL' );
|
||||
}
|
||||
}
|
||||
|
||||
sub generate_session_id {
|
||||
# ---------------------------------------------------------------
|
||||
# Generates a session id.
|
||||
#
|
||||
return md5_hex( time . $$ . rand (16000) );
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
GT::Session::TempTable - A session management module, subclassing GT::Session::SQL providing temp table support
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
Create a session:
|
||||
my $session = new GT::Session::TempTable({
|
||||
db => GT::SQL->new( '/path/to/defs' ),
|
||||
def_path => '/path/to/defs',
|
||||
create_session => \&create_table_sub
|
||||
});
|
||||
|
||||
Create temp table controller table. (do once before using this module)
|
||||
$session->initial_create();
|
||||
|
||||
Create a new temp table:
|
||||
my ( $GT_SQL_Table_ref, $tmp_id ) = $session->new_set();
|
||||
|
||||
Get the GT::SQL::Table ref to a previous table:
|
||||
my $GT_SQL_Table_ref = $session->get_set( $tmp_id );
|
||||
|
||||
List all the sets for current session:
|
||||
my $href = $session->list_sets();
|
||||
|
||||
Save data with the session:
|
||||
$session->data ("Save this information!");
|
||||
|
||||
Load a session.
|
||||
my $session = new GT::Session::TempTable ( $id ) or die "Can't load session: '$id'."
|
||||
|
||||
Delete a session:
|
||||
$session->delete();
|
||||
|
||||
Delete a table set:
|
||||
$session->delete_set( $tmp_id );
|
||||
|
||||
Cleanup old sessions, takes argument of number of seconds old.
|
||||
$session->cleanup ( 5000 );
|
||||
|
||||
=cut
|
||||
|
||||
Reference in New Issue
Block a user