[Catalyst] Re: Subsessions?

[Rainer Clasen]

Yuval Kogman wrote:
> sub session {
[...]
>               return $self->NEXT::session->{$sub} ||= {};


Zbigniew Lukasiak wrote:
> On 9/27/07, Rainer Clasen <[EMAIL PROTECTED]> wrote:
> > So I'm searching for something functional similar to:
> > http://paneris.net/cgi-bin/cvsweb.cgi/SubSession/SubSessions.html?rev=1.3
> >
> 
> Interesting.  I usually use GET parameters for that - but I can
> imagine where it would become not enough.

Thanks to both of you. Your responses helped a lot to sort my Ideas and
hack up my initial "poor man" / proof of concept solution:

- subsession ids are generated with c->generate_session_id from the
  Session Plugin.
- subsession data is stored as $c->session->{SUBSESSION}{$ssid}
- ssid is picked from $c->param
- uri_for automagically sets ssid
- all internal links are constructed with uri_for()
- change of subsession data doesn't yet cause a new ssid to be assigned.
  This comes later. Up to then it has to be done manually with
  subsession_next.
- You cannot change subsession data after you've shown the subsession id
  to the client (i.e. you've used uri_for).

So far this seems to work fine, but it needs a bit more testing (and
documentation).


Rainer

-- 
KeyID=759975BD fingerprint=887A 4BE3 6AB7 EE3C 4AE0  B0E1 0556 E25A 7599 75BD

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;

_______________________________________________
List: Catalyst@lists.rawmode.org
Listinfo: http://lists.rawmode.org/mailman/listinfo/catalyst
Searchable archive: http://www.mail-archive.com/catalyst@lists.rawmode.org/
Dev site: http://dev.catalyst.perl.org/