package Catalyst::Plugin::Subsession;
use warnings;
use strict;
use Storable qw( dclone );
use Catalyst::Exception ();

our $VERSION = '0.01';

# inspired by:
# http://paneris.net/cgi-bin/cvsweb.cgi/SubSession/SubSessions.html?rev=1.3

# NOTE: has to be loaded before Catalyst::Plugin::Session to run finalize
# and prepare_action in proper order.

sub setup {
	my $c = shift;

	$c->log->debug( "setting up Subsessions" );
	$c->config->{subsession}{expire} ||= 30 * 60;
	$c->config->{subsession}{param} ||= "ssid";

	$c->NEXT::setup( @_ );
}

sub subsession {
	my( $c ) = @_;

	return $c->{subsession};
}

sub ssid {
	my( $c ) = @_;
	return $c->subsession->{SSID};
}

# TODO: automagically keep track of changes to current subsession
sub subsession_next {
	my( $c ) = @_;

	Catalyst::Exception->throw( 
		"subsession already given to user, cannot modify" )
		if $c->{subsession_shown};

	$c->subsession->{SSID} = $c->_subsession_newid;
}

sub _subsession_valid {
	my( $c, $ssid ) = @_;

	return defined $ssid 
		&& $ssid =~ /^[a-z\d]+$/
		&& exists $c->session->{SUBSESSION}
		&& exists $c->session->{SUBSESSION}{$ssid}
		&& exists $c->session->{SUBSESSION}{$ssid}{SSID};
}

sub _subsession_load {
	my( $c, $ssid ) = @_;

	if( $c->_subsession_valid( $ssid ) ){
		$c->log->debug( "found Subsession $ssid" );
		$c->session->{SUBSESSION}{$ssid}{SEEN} = time;
		return dclone( $c->session->{SUBSESSION}{$ssid} )
	}
	return;
}

sub _subsession_newid {
	my( $c ) = @_;

	return $c->generate_session_id; # from Catalyst::Plugin::Session
}

sub _subsession_new {
	my( $c ) = @_;

	my $ssid = $c->_subsession_newid;
	$c->log->debug( "new Subsession $ssid" );
	return { 
		SEEN	=> time,
		SSID	=> $ssid,
	};
	# Hmm, should we redirect for new session to tell the client about
	# the new ID?
}

sub _subsession_expire {
	my( $c ) = @_;

	my $now = time;
	my $oldest = $now - $c->config->{subsession}{expire};
	foreach my $ssid ( keys %{$c->session->{SUBSESSION}} ){
		next unless ref $c->session->{SUBSESSION}{$ssid};

		if( $c->session->{SUBSESSION}{$ssid}{SEEN} < $oldest ){
			$c->log->debug( "expire Subsession $ssid" );
			delete $c->session->{SUBSESSION}{$ssid};
		}
	}
}

sub _subsession_save {
	my( $c ) = shift;

	my $ssid = $c->ssid;
	$c->log->debug( "saving Subsession $ssid" );
	$c->session->{SUBSESSION}{$ssid} =
		$c->subsession;
}

sub prepare_action {
	my $c = shift;

	$c->NEXT::prepare_action( @_ );

	my $cfg = $c->config->{subsession};
	my $ssid = $c->req->param($cfg->{param});
	# TODO: hack to shut up my abused HTML::Widget:
	delete $c->req->parameters->{$cfg->{param}};
	delete $c->req->query_parameters->{$cfg->{param}};
	$c->{subsession} = $c->_subsession_load( $ssid ) 
		|| $c->_subsession_new;
	$c->_subsession_expire;

	$c;
}
	
sub finalize {
	my $c = shift;

	my $cfg = $c->config->{subsession};
	my $ssid = $c->req->param($cfg->{param});

	if( ! defined $ssid || $ssid ne $c->ssid ){
		$c->_subsession_save;
	}

	$c->NEXT::finalize( @_ );
}

sub uri_for {
	my( $c, $path, @args ) = @_;

	++ $c->{subsession_shown};
	my $params = ( scalar @args && ref $args[$#args] eq 'HASH' 
		? pop @args : {} );

	$params->{ssid} = $c->ssid;

	$c->NEXT::uri_for( $path, @args, $params );
}

1;
