HTTP::Daemon::Threaded::SessionCache

package HTTP::Daemon::Threaded::SessionCache;

use threads;
use threads::shared;
use HTTP::Daemon::Threaded::Session;

use strict;
use warnings;

our $VERSION = '0.91';

sub new {
	my $class = shift;
	my %sessions : shared = ();
	my %self : shared = (
		_cache => \%sessions
		);
	return bless \%self, $class;
}

sub addSession {
	my ($self, $session) = @_;

	my $id = $session->getID();
	my $cache = $self->{_cache};
	$cache->{$id} = $session;
	return $session;
}

sub removeSession {
	my ($self, $id) = @_;
	my $cache = $self->{_cache};
	delete $cache->{$id};
	return $self;
}

sub getSession {
	my ($self, $request) = @_;

#
#	strictly speaking, this can be multivalued...but we're
#	not gonna deal with that for now
#
	my $cookie = $request->header('Cookie');
#	print STDERR "Sorry, no cookie\n" and
	return undef
		unless $cookie;
#	print STDERR "Cookie is $cookie\n";
	$cookie = ';' . $cookie;	# normalize
	return undef
		unless ($cookie=~/;Session=([^;]+)/i);

	my $id = $1;
	my $cache = $self->{_cache};

#	print STDERR "ID is $id\n";

	return $cache->{$id}->setLastAccessedTime()
		if (exists $cache->{$id});

#	print STDERR "Session $id not found\n";
	my $session = $self->openSession($cookie);
	return $session ? $session->setLastAccessedTime() : undef;
}

sub createSession {
	my $self = shift;
	my $id = shift;

	my $cache = $self->{_cache};
	return undef
		if defined($id) && (exists $cache->{$id});
	my $session = HTTP::Daemon::Threaded::Session->new($self, $id, @_);
	return undef
		unless $session;
	$id = $session->getID();
	$cache->{$id} = $session;
	$session->setLastAccessedTime();
	return $session;
}

sub openSession {
	my ($self, $cookie) = @_;

	$cookie = ';' . $cookie;	# normalize
	my $id = ($cookie=~/;Session=([^;]+)/i);

	my $cache = $self->{_cache};
	return $cache->{$id}
		if exists $cache->{$id};

	my $session = HTTP::Daemon::Threaded::Session->open($id, $self);
	return undef
		unless $session;
	$id = $session->getID();
	$cache->{$id} = $session;
	return $session;
}

1;