#!/usr/bin/perl
use strict; use warnings;
select STDOUT; $| = 1;
use CGI;
use CGI::Session;
use Data::Dumper;
use HTML::Entities qw/encode_entities/;
my $q = CGI->new;
my $tssid = $q->cookie('TSSID');
my $title='huh';
my $cookie=undef;
my $delete=0;
my @lines;
my $session;
unless ($tssid){
$session = new CGI::Session(undef, undef, {Directory=>'/tmp'});
$cookie = $q->cookie(TSSID => $session->id );
$title='No session';
push @lines,$title;
setup_new($session);
} # no ssid
else {
push @lines,'tssid:'.$tssid;
$session = new CGI::Session(undef, $tssid, {Directory=>'/tmp'});
if ($tssid ne $session->id) {
$cookie = $q->cookie(TSSID => $session->id );
setup_new($session);
$title='Expired Session .. made new one';
push @lines,$title;
}
else {
$delete=5>int(rand(10));
$title='old session';
if ($delete) {
$cookie = $q->cookie (
-name => 'TSSID',
-value => '',
-path => '/',
-expires => '-1d'
);
push @lines,'deleted';
} # delete
} # not expired
} # not missing
if ($cookie){ print $q->header(-cookie=>$cookie);}
else { print $q->header();}
print ''.$title.''."\n";
print ''."\n";
print '
session:'.$session->id."\n";
for my $l (@lines) {print '
'.$l."\n"; }
print ''."\n";
local $Data::Dumper::Deepcopy=1;
local $Data::Dumper::Purity=1;
local $Data::Dumper::Sortkeys=1;
local $Data::Dumper::Indent=2;
print encode_entities(Dumper($session))."\n";
print '
'."\n";
print ''."\n";
if ($delete){$session->delete();}
exit;
sub setup_new {
my $session=shift;
my $expires=5>int(rand(10))?'+1m':'+7d';
# $session->expire('+1m');
$session->expires($expires);
# $session->expires('+7d');
my $timein = time();
$session->param('user_id','uid');
$session->param('username','username');
$session->param('forename','forename');
$session->param('lastname', 'lastname');
$session->param('timein', $timein);
$session->param('timeout', 0);
$session->param('attempts',0);
$session->param('isloggedin',1);
}