view release on metacpan or  search on metacpan

lib/Apache/SWIT/Session.pm  view on Meta::CPAN

use strict;
use warnings FATAL => 'all';

package Apache::SWIT::Session;
use Storable qw(thaw freeze);
use HTML::Tested::Seal;

sub access_handler($$) {
	my ($class, $r) = @_;
	my $session = $class->begin($r);
	$r->pnotes("SWITSession", $session);
	return Apache2::Const::OK();
}

sub begin {
	my ($class, $r) = @_;
	my %args = (_request => $r);
	my %cookies = Apache2::Cookie->fetch($r);
	$args{session_value} = $cookies{$class->cookie_name}->value
		if $cookies{$class->cookie_name};
	my $self = $class->new(%args);
	$self->read_stash;
	return $self;
}

sub request { return shift()->{_request}; }

sub end {
	my $self = shift;
	$self->write_stash;
	my $cookie = Apache2::Cookie->new($self->{_request}, 
			'-name' => $self->cookie_name,
			'-value' => $self->session_value);
	$cookie->path($self->{_request}->dir_config("SWITRootLocation") . ";HttpOnly");
	$cookie->bake($self->{_request});
}

sub new {
	my ($class, %args) = @_;
	return bless(\%args, $class);
}

sub _get {
	my ($self, $name, $val) = @_;
	return $self->{_stash}->{$name};
}

sub _delete_children {
	my ($self, $name) = @_;
	for my $d (@{ $self->_get_args($name)->{children} || [] }) {
		my $f = "delete_$d";
		$self->$f;
	}
}

sub _set {
	my ($self, $name, $val) = @_;
	$self->{_stash}->{$name} = $val;
	$self->_delete_children($name);
}

sub _delete {
	my ($self, $name) = @_;
	my $res = delete $self->{_stash}->{$name};
	$self->_delete_children($name);
	return $res;
}

sub add_class_dbi_var {
	my ($class, $var, $dbi_class) = @_;
	$class->add_var($var, inflate => sub {
		return $dbi_class->retrieve(shift());
	}, deflate => sub { return shift()->id });
}

sub _get_args {
	my ($self, $name) = @_;
	my $p_args = "$name\_args";
	return $self->$p_args;
}

sub add_var {
	my ($class, $name, %args) = @_;
	no strict 'refs';
	*{ "$class\::get_$name" } = sub {
		return shift()->_get($name, @_);
	};
	*{ "$class\::set_$name" } = sub {
		return shift()->_set($name, @_);
	};
	*{ "$class\::delete_$name" } = sub {