File Coverage

blib/lib/HTML/EP/Session.pm

Criterion	Covered	Total	%
statement	9	66	13.6
branch	0	28	0.0
condition	0	33	0.0
subroutine	3	7	42.8
pod			n/a
total	12	134	8.9

# -*- perl -*-
#
#   HTML::EP	- A Perl based HTML extension.
#
#
#   Copyright (C) 1998    Jochen Wiedmann
#                         Am Eisteich 9
#                         72555 Metzingen
#                         Germany
#
#                         Phone: [phone]
#                         Email: [e-mail]
#
#   All rights reserved.
#
#   You may distribute this module under the terms of either
#   the GNU General Public License or the Artistic License, as
#   specified in the Perl README file.
#
############################################################################

require 5.004;
use strict;

use HTML::EP ();
use Storable ();


package HTML::EP::Session;

$HTML::EP::Session::VERSION = '0.1002';
@HTML::EP::Session::ISA = qw(HTML::EP);

sub _ep_session {
    my $self = shift; my $attr = shift;

    my $class = $attr->{'class'} || 'HTML::EP::Session::DBI';
    my $c = $class . '.pm';
    $c =~ s/\:\:/\//g;
    require $c;

    $self->{'_ep_session_code'} = $attr->{'hex'} ? 'h' : 's';

    my $session;
    my $id = $attr->{'id'};
    if (!$id) {
	# Create a new session
	require MD5;
	my $secret = ($attr->{'secret'} || 'this is secret?');
	my $max_retries = $attr->{'max_retries'} || 5;
	for (my $i = 0;  !$session  &&  $i < $max_retries;  $i++) {
	    $id = MD5->hexhash(time() . {} . rand() . $$ . $secret);
	    $session = eval { $class->new($self, $id, $attr) };
	}
	if (!$session) { die $@ }
    } else {
	$session = $class->Open($self, $id, $attr);
    }

    $self->{'_ep_session_id'} = $id;
    my $var = $attr->{'var'} || 'session';
    $self->{'_ep_session_var'} = $var;
    $self->{$var} = $session;
    $self->print("Created session:\n", $self->Dump($session))
	if $self->{'debug'};
    '';
}

sub _ep_session_store {
    my $self = shift; my $attr = shift;

    my $id = ($attr->{'id'} || $self->{'_ep_session_id'})
	or die "No session ID given";
    my $var = $attr->{'var'} || $self->{'_ep_session_var'};
    my $session = $self->{$var}	or die "No such session: $var";
    $self->print("Storing session:\n", $self->Dump($session))
	if $self->{'debug'};
    $session->Store($self, $id, $attr->{'locked'});
    '';
}

sub _ep_session_item {
    my $self = shift; my $attr = shift;

    my $id = ($attr->{'id'} || $self->{'_ep_session_id'})
	or die "No session ID given";
    my $var = $attr->{'var'} || $self->{'_ep_session_var'};
    my $session = $self->{$var}	or die "No such session: $var";
    my $items = $session->{'items'};
    if (!$items) {
	$items = $session->{'items'} = {};
    }
    my $item = $attr->{'item'};
    my $num;
    if ($num = $attr->{'add'}) {
	$num = ($items->{$item} || 0) + $attr->{'add'};
    } else {
	$num = $attr->{'num'} || 0;
    }
    $items->{$item} = $num;
    '';
}

sub _ep_session_delete {
    my $self = shift; my $attr = shift;

    my $id = ($attr->{'id'} || $self->{'_ep_session_id'})
	or die "No session ID given";
    my $var = $attr->{'var'} || $self->{'_ep_session_var'};
    my $session = $self->{$var}	or die "No such session: $var";
    $session->Delete($self, $id);
    undef $self->{'_ep_session_id'} unless $attr->{'id'};
    '';
}


1;

__END__