package Session;
# modules/Session.pm
# This utility module is an interface to a Session object based on URL rewriting.
# The session ID is stored in the "additional path info" of the URL. All URLs must
# be passed through rewrite_url() in order to maintain the state.
# manage database sessions with URL rewriting
use strict;
use CGI 'path_info','url';
use Carp;
# return a new session object, possibly retrieving
# id from the additional path info. May do a redirection
# and exit if a new ID needs to be created. Therefore this
# should be called before header() or other output.
sub new {
my $class = shift;
my $self = bless {},$class;
$self->initialize(@_); # class-specific initialization
my $id = $self->retrieve_id;
unless ($id && $self->verify_id($id)) {
$id = $self->new_id;
$self->do_redirect($id);
return;
}
$self->{'id'} = $id;
return $self;
}
# erase the ID from the underlying storage
sub erase {
my $self = shift;
return $self->erase_id;
}
# return the ID
sub id { return $_[0]->{'id'}; }
# fetch data from the store as a hash reference
sub fetch {
my $self = shift;
return $self->fetch_data();
}
# place a hash reference into storage
sub store {
my $self = shift;
my $data = shift;
return $self->store_data($data);
}
# retrieve ID from path info
sub retrieve_id {
my $self = shift;
my ($id) = path_info() =~ m!^/(\d+)!;
return $id;
}
# Please pass all self-referencing URLs through this method
# in order to preserve the session ID.
sub rewrite_url {
my ($self,$url) = @_;
my $id = $self->id; # retrieve ID
return $url unless defined $id;
my ($main,$query) = split('\?',$url);
$main = "../$main" if $main !~ m[^(http:|/)] && path_info();
return "$main/$id?$query" if $query;
return "$main/$id" unless $query;
}
# do_redirect() is called when a new session ID needs to be generated
sub do_redirect {
my ($self,$id) = @_;
$self->{'id'} = $id;
my $url = $self->rewrite_url(url(-full=>1,-query=>1)); # CGI::url()
print CGI::redirect($url); # CGI::redirect()
}
# Class-specific initialization. Probably want to override.
sub initialize { return bless {},shift; }
# the remainder is to be implemented by subclasses
sub new_id { croak "new_id() must be implemented by subclass"; }
sub verify_id { croak "verify_id() must be implemented by subclass"; }
sub erase_id { croak "erase_id() must be implemented by subclass"; }
sub fetch_data { croak "fetch_data() must be implemented by subclass"; }
sub store_data { croak "store_data() must be implemented by subclass"; }
1;
|
Previous
