view release on metacpan or  search on metacpan

lib/Apache2/WebApp/Plugin/Session.pm  view on Meta::CPAN

#  across servers, within a database, or local file.  Data persistence is
#  maintained between requests using web browser cookies.
#
#  AUTHOR
#  Marc S. Brooks <mbrooks@cpan.org>
#
#  This module is free software; you can redistribute it and/or
#  modify it under the same terms as Perl itself.
#
#----------------------------------------------------------------------------+

package Apache2::WebApp::Plugin::Session;

use strict;
use base 'Apache2::WebApp::Plugin';
use Params::Validate qw( :all );
use Switch;

our $VERSION = 0.16;

#~~~~~~~~~~~~~~~~~~~~~~~~~~[  OBJECT METHODS  ]~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~#

#----------------------------------------------------------------------------+
# create(\%controller, $name, \%data)
#
# Create a new session.

sub create {
    my $self = shift;
    $self->_init_new($_[0]);
    $self->{OBJECT}->create(@_);
}

#----------------------------------------------------------------------------+
# get(\%controller, $name)
#
# Return session data as a hash reference.

sub get {
    my $self = shift;
    $self->_init_new($_[0]);
    $self->{OBJECT}->get(@_);
}

#----------------------------------------------------------------------------+
# delete(\%controller, $name)
#
# Delete an existing session.

sub delete {
    my $self = shift;
    $self->_init_new($_[0]);
    $self->{OBJECT}->delete(@_);
}

#----------------------------------------------------------------------------+
# update(\%controller, $name, \%data)
#
# Update existing session data.

sub update {
    my $self = shift;
    $self->_init_new($_[0]);
    $self->{OBJECT}->update(@_);
}

#----------------------------------------------------------------------------+
# id(\%controller, $name)
#
# Return the unique identifier for the given session.

sub id {
    my $self = shift;
    $self->_init_new($_[0]);
    $self->{OBJECT}->id(@_);
}

#~~~~~~~~~~~~~~~~~~~~~~~~~~[  PRIVATE METHODS  ]~~~~~~~~~~~~~~~~~~~~~~~~~~~~~#

#----------------------------------------------------------------------------+
# _init(\%params)
#
# Return a reference of $self to the caller.

sub _init {
    my ($self, $params) = @_;
    return $self;
}

#----------------------------------------------------------------------------+
# _init_new(\%controller)
#
# Based on config value for 'storage_type', include the correct sub-class.

sub _init_new {
    my ($self, $c)
      = validate_pos(@_,
          { type => OBJECT  },
          { type => HASHREF }
      );

    my $package;

    switch ($c->config->{session_storage_type}) {
        case /file/      { $package = "Apache2::WebApp::Plugin::Session::File"      }
        case /memcached/ { $package = "Apache2::WebApp::Plugin::Session::Memcached" }
        case /mysql/     { $package = "Apache2::WebApp::Plugin::Session::MySQL"     }
        else {
            $self->error("Missing config value for 'storage_type'");
        }
    }

    unless ( $package->can('isa') ) {
        eval "require $package";

        $self->error("Failed to load package '$package': $@") if $@;
    }

    if ( $package->can('new') ) {
        $self->{OBJECT} = $package->new;
    }