HTTP::Daemon::Threaded::Session

package HTTP::Daemon::Threaded::Session;

use threads;
use threads::shared;
use Time::HiRes qw(time);

use strict;
use warnings;

our $VERSION = '0.91';

our $id_gen : shared = 0;

sub new {
	my ($class, $cache, $id, $timeout, $dough, $expires) = @_;
	unless (defined($id)) {
#
#	if none provided, create our own
#
		lock($id_gen);
		$id_gen = int(time())
			unless $id_gen;
		$id = ++$id_gen;
	}

	my $cookie = (defined($dough) ? "Session=$id;$dough" : "Session=$id");
	$cookie .= ";Expires=$expires" if $expires;
	my %attrs : shared = ();
	my %self : shared = (
		_created	=> time(),
		_id			=> $id,
		_attributes => \%attrs,
		_max_inactive => $timeout || 600,
		_cookie_sent => undef,
		_cache		=> $cache,
		_last_access => time(),
		_expires	=> $expires,
		_cookie		=> $cookie
	);
	return bless \%self, $class;
}

sub open {
	my ($class, $id, $cache) = @_;
	return undef;
}

sub close {
	my $self = shift;
	lock(%$self);
	$self->{_cache}->removeSession($self->{_id});
	delete $self->{_cache};
	return undef;
}

sub getAttribute {
	my ($self, $name) = @_;
	lock(%$self);
	return $self->{_attributes}{$name};
}

sub getAttributeNames {
	my $self = shift;
	lock(%$self);
	return sort keys %{$self->{_attributes}};
}

sub removeAttribute {
	my ($self, $name) = @_;
	my ($cookie, $key, $val) = ('', '', '');

	lock(%$self);
	my $attrs = $self->{_attributes};
	my $expires = $self->{_expires};
	my $old = delete $attrs->{$name};
	$cookie .= "$key=$val;"
		while (($key, $val) = each %$attrs);

	chop $cookie;
	$cookie .= ";Expires=$expires" if $expires;
	$self->{_cookie} = $cookie;
	return $old;
}

sub setAttribute {
	my ($self, $name, $value) = @_;
	my ($cookie, $key, $val) = ('', '', '');

	lock(%$self);
	my $attrs = $self->{_attributes};
	my $expires = $self->{_expires};
	$attrs->{$name} = $value;
	$cookie .= "$key=$val;"
		while (($key, $val) = each %$attrs);

	chop $cookie;
	$cookie .= ";Expires=$expires" if $expires;
	$self->{_cookie} = $cookie;

	return $self;
}

sub getExpiration {
	my $self = shift;

	lock(%$self);
	return $self->{_expires};
}

sub setExpiration {
	my ($self, $expires) = @_;

	lock(%$self);
	$self->{_expires} = $expires;
	my $cookie = $self->{_cookie};
	$cookie=~s/;Expires=.*$//;
	$cookie .= ";Expires=$expires"
		if $expires;
	$self->{_cookie} = $cookie;

	return $self;
}

sub getCreationTime {
	my $self = shift;
	return $self->{_created};
}

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

sub getLastAccessedTime {
	my $self = shift;
	lock(%$self);
	return $self->{_last_access};
}

sub setLastAccessedTime {
	my $self = shift;
	lock(%$self);
	$self->{_last_access} = time();
	return $self;
}

sub getMaxInactiveInterval {
	my $self = shift;
	lock(%$self);
	return $self->{_max_inactive};
}

sub setMaxInactiveInterval {
	my $self = shift;
	lock(%$self);
	$self->{_max_inactive} = $_[0];
	return $self;
}

#
#	should we also apply the cookie expiration here ?
#

sub isInactive {
	my ($self, $idle) = @_;
	lock(%$self);
	return ($self->{_max_inactive} < (time() - $idle));
}

sub isNew {
	my $self = shift;
	lock(%$self);
	return !$self->{_cookie_sent};
}

sub cookieSent {
	my $self = shift;
	lock(%$self);
	$self->{_cookie_sent} = 1;
	return $self;
}

sub getCookie {
	my $self = shift;
	lock(%$self);
	return $self->{_cookie};
}

1;