CAM::Session - DBI and cookie CGI session state maintenance

CAM-Session documentation Contained in the CAM-Session distribution.

Index

Code Index:

NAME

Top

CAM::Session - DBI and cookie CGI session state maintenance

LICENSE

Top

Copyright 2005 Clotho Advanced Media, Inc., <cpan@clotho.com>

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

COMPARISON

Top

CGI::Session is a better module than this one, but this one is a little easier to use. If you are starting from scratch, use CGI::Session. If you are using CAM::App, then we recommend this module for session management since CAM::App takes care of all of the details for you.

See README for more detail.

SYNOPSIS

Top

  use CAM::Session;
  use DBI;
  my $dbh = DBI->connect(...);
  CAM::Session->setDBH($dbh);

  my $session = new CAM::Session();
  $session->printCookie();

  $session->set("username", $username);
  ...
  $session->get("username", $username);
  $session->delete("username");

To periodically clean up the session table, run a script like the following as a daily scheduled task:

  use CAM::Session;
  use DBI;
  my $dbh = DBI->connect(...) || die "no dbh";
  CAM::Session->setDBH($dbh);
  CAM::Session->setExpiration(24*60*60); # older than one day
  CAM::Session->clean();

DESCRIPTION

Top

CAM::Session interacts with the CGI program, the database and the visitor's cookie to create a storage space for persistent data.

FUNCTIONS

Top

new
new DBIHANDLE

Create a new session object, retrieving the session ID from the cookie, if any. If the database handle is not set here, it must have been set previously via the setDBH() class method.

DESTROY

Saves the session data on object destruction, if needed.

getID
getCookie

Return a cookie that indicates this session. Any arguments are passed to CGI::Cookie::new(). Use this, for example, with

    print CGI->header(-cookie => $session->getCookie);
printCookie

Outputs a cookie that indicates this session. Use this just before "print CGI->header()", for example.

getAll

Retrieve a hash of all of the session data.

get FIELDNAME

Retrieve a field from the session storage.

set FIELDNAME, VALUE, FIELDNAME, VALUE, ...

Record a field in the session storage. If autoSave is on (it is by default) this value is immediately recorded in the database.

delete FIELDNAME, FIELDNAME, ...

Remove one or more fields from the session storage. If autoSave is on (it is by default) this change is immediately recorded in the database.

clear

Calls delete() on every field in the session storage.

loadSessionData

Retrieve the session data from storage. This function is called by new() so it is only needed if you need to reload the data for some reason.

Returns a boolean indicating the success or failure of the load operation.

saveSessionData

Write the session data to permanent storage. This function is called by the set() method. so it is only needed if you have turned off the autoSave feature.

Returns a boolean indicating the success or failure of the save operation.

isNewSession

Returns true if this session was newly created (as opposed to a repeat visitor)

setDBH DBI_HANDLE

Set the global database handle for this package. Use like this:

  CAM::Session->setDBH($dbh);
setExpiration SECONDS

Set the duration for the session content. If the session is older than the specified time, a new session will be created. The default expiration is unlimited (set solely by the visitor's cookie expiration). This is a class method

Use like this:

  CAM::Session->setExpiration($seconds);
setTableName NAME

Set the name of the database table that is used for the session storage. This is a class method.

Use like this:

  CAM::Session->setTableName($name);
setCookieName NAME

Set the name of the cookie that is used for the recording the session. This is a class method.

Use like this:

  CAM::Session->setCookieName($name);
setup
setup DBIHANDLE, TABLENAME

Create a database table for storing sessions. This is not intended to be called often, if ever. This is a class method.

clean
clean DBIHANDLE, TABLENAME, SECONDS

Cleans out all records older than the specified number of seconds. This is a class method.

AUTHOR

Top

Clotho Advanced Media Inc., cpan@clotho.com

Primary developer: Chris Dolan

SEE ALSO

Top

CGI::Session, CAM::App

CAM-Session documentation Contained in the CAM-Session distribution. 
package CAM::Session;


#----------------

require 5.005_62;
use strict;
use warnings;
use Carp;
use CGI::Cookie;
use CGI;
use DBI;

our @ISA = qw();
our $VERSION = '1.03';

# global settings, can be overridden for the whole class or for
# individual instances.
our $global_expiration = 24*60*60;  # one day, in seconds
our $global_dbh = undef;
our $global_dbTablename = "session";
our $global_cookieName = "session";
our $global_keylength = 16;

our $colname_key  = "session_key";
our $colname_time = "session_time";
our $colname_data = "session_data";

#----------------


#----------------


sub new
{
   my $pkg = shift;
   my $dbh = shift; # optional

   my $self = bless({
      data => {},
      expiration => $global_expiration,
      dbTablename => $global_dbTablename,
      cookieName => $global_cookieName,
      dbh => $dbh || $global_dbh,
      needsSave => 0,
   }, $pkg);

   if (!$self->{dbh})
   {
      &carp("No database connection has been specified.  Please use ".$pkg."::setDBH()");
      return undef;
   }
   if (!ref($self->{dbh}) || ref($self->{dbh}) !~ /^(DBI|DBD)\b/)
   {
      my $type = ref($self->{dbh}) ? ref($self->{dbh}) : "scalar";
      &carp("The DBH object is not a valid DBI/DBD connection: $type");
      return undef;
   }

   my %cookies = CGI::Cookie->fetch();
   if (exists $cookies{$self->{cookieName}})
   {
      # existing session
      $self->{id} = $cookies{$self->{cookieName}}->value;
      if (!$self->loadSessionData())
      {
         $self->_newSession();
      }
   }
   else
   {
      $self->_newSession();
   }

   return $self;
}
#----------------


sub DESTROY
{
   my $self = shift;
   if ($self->{needsSave})
   {
      $self->saveSessionData();
   }
   return $self;
}
#----------------


sub getID
{
   my $self = shift;
   return $self->{id};
}
#----------------


sub getCookie
{
   my $self = shift;

   my $id = $self->getID();
   my $cookie = CGI::Cookie->new(-name => $self->{cookieName},
                                 -value => $id,
                                 -path => "/",
                                 @_);
   return $cookie;
}
#----------------


sub printCookie
{
   my $self = shift;

   my $cookie = $self->getCookie(@_);
   print "Set-Cookie: $cookie\n";
}
#----------------


sub getAll
{
   my $self = shift;

   if (wantarray)
   {
      return (%{$self->{data}});
   }
   else
   {
      return (scalar keys %{$self->{data}});
   }
}
#----------------


sub get
{
   my $self = shift;
   my $fieldName = shift;

   return undef if (!defined $fieldName);
   return $self->{data}->{$fieldName};
}
#----------------


sub set
{
   my $self = shift;

   while (@_ > 0)
   {
      my $fieldName = shift;
      my $value = shift;

      return undef if (!defined $fieldName);

      $self->{data}->{$fieldName} = $value;
   }
   $self->{needsSave} = 1;
   return $self;
}
#----------------


sub delete
{
   my $self = shift;

   foreach my $fieldName (@_)
   {
      delete $self->{data}->{$fieldName};
   }
   $self->{needsSave} = 1;
   return $self;
}
#----------------


sub clear
{
   my $self = shift;
   return $self->delete(keys %{$self->{data}});
}
#----------------


sub loadSessionData
{
   my $self = shift;

   my $id = $self->getID();
   return undef if (!$id);
   my $dbrow = $self->_getSession($id);
   return undef if (!$dbrow);
      
   $self->{data} = $self->_explode($dbrow->{$colname_data});
   if (!$self->{data})
   {
      $self->{data} = {};
      return undef;
   }
   $self->{needsSave} = 0;
   return $self;
}
#----------------


sub saveSessionData
{
   my $self = shift;

   my $id = $self->getID();
   return undef if (!$id);
   my $data = $self->_implode($self->{data});
   $data = "" if (!defined $data);
   my $dbh = $self->{dbh};
   my $result = $dbh->do("update $$self{dbTablename} set " .
                         "$colname_data=" . $dbh->quote($data) . "," .
                         "$colname_time=now() " .
                         "where $colname_key='$id'");

   return undef if ((!$result) || $result == 0);
   return $self;
}
#----------------


sub isNewSession
{
   my $self = shift;
   return $self->{newsession};
}
#----------------

# PRIVATE FUNCTION
sub _newSession
{
   my $self = shift;

   $self->{id} = undef;

   my $dbh = $self->{dbh};
   my $tries = 0;
   # Loop until we get an unused ID, but give up if it takes too long
   while ($tries++ < 20)
   {
      my $id = $self->_newID();
      my $sth = $dbh->prepare("select count(*) from $$self{dbTablename} " .
                              "where $colname_key=?");
      $sth->execute($id);
      my ($matches) = $sth->fetchrow_array();
      $sth->finish();

      if ($matches == 0)
      {
         $dbh->do("insert into $$self{dbTablename} set " .
                  "$colname_key='$id',$colname_time=now()");
         $self->{id} = $id;
         $self->{newsession} = 1;
         last;
      }
   }
   return $self;
}

# PRIVATE FUNCTION
sub _getSession
{
   my $self = shift;
   my $id = shift;

   return undef if (!$id);

   my $dbh = $self->{dbh};
   my $sth = $dbh->prepare("select *" .
                           (defined $self->{expiration} ?
                            ",date_add(now(), interval -$$self{expiration} second) as expires "
                            : "") .
                           "from $$self{dbTablename} " .
                           "where $colname_key=?");
   $sth->execute($id);
   my $row = $sth->fetchrow_hashref();
   $sth->finish();

   return undef if (!$row);

   if (defined $self->{expiration})
   {
      $row->{$colname_time} =~ s/\D//g;
      $row->{expires} =~ s/\D//g;
      
      if ($row->{$colname_time} lt $row->{expires})
      {
         $dbh->do("delete from $$self{dbTablename} " .
                  "where $colname_key=" . $dbh->quote($self->{cachekey}));
         return undef;
      }
   }

   return $row;
}
#----------------


sub setDBH
{
   my $pkg = shift; # unused
   my $val = shift;
   $global_dbh = $val;
}
#----------------


sub setExpiration
{
   my $pkg = shift; # unused
   my $val = shift;
   $global_expiration = $val;
}
#----------------


sub setTableName
{
   my $pkg = shift; # unused
   my $val = shift;
   $global_dbTablename = $val;
}
#----------------


sub setCookieName
{
   my $pkg = shift; # unused
   my $val = shift;
   $global_cookieName = $val;
}
#----------------


# PRIVATE FUNCTION
sub _implode
{
   my $self = shift;
   my $H_data = shift;

   # Treat the hash like an array.  The keys and values are treated
   # identically.
   my @escaped = (%$H_data);
   foreach (@escaped)
   {
      $_ = "" if (!defined $_);
      $_ = CGI::escape($_);
   }
   return join(",", @escaped);
}

# PRIVATE FUNCTION
sub _explode
{
   my $self = shift;
   my $implosion = shift;

   $implosion = "" if (!defined $implosion);

   # The split limit of -1 prevents trailing blank fields from being omitted
   my @fields = split /,/, $implosion, -1;
   if (@fields %2 != 0)
   {
      &carp("not an even number of fields in imploded data");
      return undef;
   }
   foreach (@fields)
   {
    $_ = CGI::unescape($_);
   }
   return {@fields};
}

# PRIVATE FUNCTION
sub _newID
{
   my $self = shift;

   require Digest::MD5;
   # Copied from CGI::Session::ID::MD5
   my $md5 = Digest::MD5->new();
   $md5->add($$ , time() , rand(9999) );
   return substr($md5->hexdigest(), 0, $global_keylength);
}
#----------------


sub setup
{
   my $pkg = shift; # unused
   my $dbh = shift || $global_dbh;
   my $tablename = shift || $global_dbTablename;

   $dbh->do("create table if not exists $tablename (" .
            "$colname_key char($global_keylength) primary key not null," .
            "$colname_time timestamp," .
            "$colname_data mediumtext)");
}
#----------------


sub clean
{
   my $pkg = shift; # unused
   my $dbh = shift || $global_dbh;
   my $tablename = shift || $global_dbTablename;
   my $seconds = shift || $global_expiration;

   return $dbh->do("delete from $tablename " .
                   "where $colname_time < " .
                   "date_add(now(),interval -$seconds second)");
}


1;
__END__