AxKit-XSP-Minisession
view release on metacpan or search on metacpan
lib/AxKit/XSP/Minisession.pm view on Meta::CPAN
# $Id: /local/CPAN/AxKit-XSP-Minisession/lib/AxKit/XSP/Minisession.pm 1430 2008-03-08T21:44:59.461106Z claco $
package AxKit::XSP::Minisession;
use strict;
use warnings;
use vars qw/$VERSION $NS/;
use base 'Apache::AxKit::Language::XSP';
$VERSION = "1.10000";
$NS = 'http://squash.oucs.ox.ac.uk/XSP/Minisession';
sub start_document { 'use Apache::Log;' }
sub parse_char {
my ($e, $text) = @_;
$text =~ s/^\s*//;
$text =~ s/\s*$//;
return '' unless $text;
$text = Apache::AxKit::Language::XSP::makeSingleQuoted($text);
return ". $text";
}
sub parse_end {
my ($e, $tag, %attr) = @_;
$tag =~ s/-/_/g;
if ($tag eq "set_value") {
} elsif ($tag eq "get_value") {
$e->manage_text(0);
$e->append_to_script("\";AxKit::XSP::Minisession::Backend::get_value(\$r,
\$flange);\n");
$e->end_expr();
return "";
} else { die "Unknown tag $tag\n" }
}
sub parse_start {
my ($e, $tag, %attr) = @_;
$tag =~ s/-/_/g;
if ($tag eq "get_value") {
$e->start_expr($tag);
$e->manage_text(1);
return 'my $flange = "';
} elsif ($tag eq "set_value") {
$e->manage_text(0);
my $buildup = '';
$buildup .= "\$r->log->debug('calling
put_value');AxKit::XSP::Minisession::Backend::put_value(\$r, ".
Apache::AxKit::Language::XSP::makeSingleQuoted($_)
.", ". Apache::AxKit::Language::XSP::makeSingleQuoted($attr{$_})
.");\n"
for keys %attr;
return $buildup;
}
}
package AxKit::XSP::Minisession::Backend;
use Apache::Log;
use Apache::Session::File;
use Apache::Cookie;
use strict;
use warnings;
sub get_session {
my $r = shift;
my $sid;
if (!($sid = $r->pnotes("SESSION_ID"))) {
# Has it come from a cookie?
my %jar = Apache::Cookie->new($r)->parse;
if (exists $jar{sessionid}) {
$sid = $jar{sessionid}->value();
$r->log->debug("Got the session id ($sid) from a cookie");
}
}
$sid = undef unless $sid; # Clear it, as 0 is a valid sid.
my %session = ();
my $new = !(defined $sid);
$r->log->debug(defined $sid ? "Retrieving session $sid"
: "Creating a new session");
tie %session, 'Apache::Session::File', $sid, {
Directory => $r->dir_config("MinisessionDir") || "/tmp/sessions",
LockDirectory => $r->dir_config("MinisessionLockDir") ||
"/tmp/sessionlock",
};
$r->pnotes("SESSION_ID", $sid);
$r->log->debug("Session contains @{[%session]}");
if ($new) {
put_session($r, \%session);
}
return \%session;
}
sub put_session {
my ($r, $sess_ref) = @_;
$r->log->debug("Returning session ".$sess_ref->{_session_id}." to the cookie
jar");
my $cookie = Apache::Cookie->new($r,
-name => "sessionid",
-value => $sess_ref->{_session_id},
-path => "/"
);
$cookie->bake();
$r->pnotes("SESSION_ID", $sess_ref->{_session_id});
}
sub get_value {
my $r = shift;
my $key = shift;
my $sref = get_session($r);
$r->log->debug("get_value saw session ".$sref->{_session_id});
$r->log->debug("retrieving $key -> $sref->{$key}");
my $v = $sref->{$key};
# Make damn sure the locks are released.
my $obj = tied %$sref;
untie %$sref;
$obj->DESTROY;
return $v;
}
sub put_value {
my $r = shift;
my $sref = get_session($r);
while (@_) {
my $key = shift;
my $val = shift;
$r->log->debug("set_value saw session ".$sref->{_session_id}. ", setting
$key to $val");
$sref->{$key} = $val;
}
put_session($r, $sref);
# Make damn sure the locks are released.
my $obj = tied %$sref;
untie %$sref;
$obj->DESTROY;
return undef; # To stop xsp leakage.
}
1;
=head1 NAME
AxKit::XSP::Minisession - Yet Another Session Handling Library
=head1 SYNOPSIS
In your config file:
PerlSetVar MinisessionDir /tmp/sessions
PerlSetVar MinisessionLockDir /tmp/sessionlock
AxAddXSPTaglib +AxKit::XSP::Minisession
In your XSP code:
<xsp:page
xmlns:session="http://squash.oucs.ox.ac.uk/XSP/Minisession"
( run in 0.625 second using v1.01-cache-2.11-cpan-39bf76dae61 )