File Coverage

blib/lib/E2/Session.pm

Criterion	Covered	Total	%
statement	15	91	16.4
branch	0	34	0.0
condition	0	3	0.0
subroutine	5	30	16.6
pod	12	14	85.7
total	32	172	18.6

# E2::Session
# Jose M. Weeks
# 29 June 2003
#
# See bottom for pod documentation.

package E2::Session;

use 5.006;
use strict;
use warnings;
use Carp;

use E2::Ticker;

our $VERSION = "0.33";
our @ISA = qw(E2::Ticker);
our $DEBUG; *DEBUG = *E2::Interface::DEBUG;

sub new;
sub clear;

sub update;

sub time;

sub votes;
sub cools;
sub karma;
sub experience;
sub writeups;
sub borged;
sub forbidden;

sub xpchange;
sub nextlevel;

sub new {
	my $arg   = shift;
	my $class = ref( $arg ) || $arg;
	my $self  = $class->SUPER::new();

	return bless ($self, $class);
}

sub clear {
	my $self = shift	or croak "Usage: clear E2SESSION";

	warn "E2::Session::clear\n"	if $DEBUG > 1;

	$self->{votes} = undef;
	$self->{cools} = undef;
	$self->{karma} = undef;
	$self->{experience} = undef;
	$self->{writeups} = undef;
	$self->{borged} = undef;
	$self->{forbidden} = undef;

	$self->{time} = undef;

	$self->{xpchange} = undef;
	$self->{nextlevel} = {};

	@{ $self->{personal} } = ();

	return 1;
}

sub votes {
	my $self = shift	or croak "Usage: votes E2SESSION";
	return $self->{votes};
}

sub cools {
	my $self = shift	or croak "Usage: cools E2SESSION";
	return $self->{cools};
}

sub karma {
	my $self = shift	or croak "Usage: karma E2SESSION";
	return $self->{karma};
}

sub experience {
	my $self = shift	or croak "Usage: experience E2SESSION";
	return $self->{experience};
}

sub writeups {
	my $self = shift	or croak "Usage: writeups E2SESSION";
	return $self->{writeups};
}

sub borged {
	my $self = shift	or croak "Usage: borged E2SESSION";
	return $self->{borged};
}

sub forbidden {
	my $self = shift	or croak "Usage: forbidden E2SESSION";
	return $self->{forbidden};
}

sub time {
	my $self = shift	or croak "Usage: time E2SESSION";
	return $self->{time};
}

sub xpchange {
	my $self = shift	or croak "Usage: xpchange E2SESSION";
	return $self->{xpchange};
}

sub nextlevel {
	my $self = shift	or croak "Usage: nextlevel E2SESSION";
	return $self->{nextlevel};
}

sub list_personal_nodes {
	my $self = shift	or croak "Usage: list_personal_nodes  E2SESSION";
	return @{ $self->{personal} };
}

sub update {
	my $self = shift or croak "Usage: update E2SESSION";

	warn "E2::Session::update\n"	if $DEBUG > 1;

	my $handlers = {
		'currentuser' => sub {
			(my $a, my $b) = @_;
			${$self->{this_username}} = $b->text;
			${$self->{this_user_id}}  = $b->{att}->{user_id};
		},
		'servertime' => sub {
			(my $a, my $b) = @_;
			$self->{time} = $b->text;
		},
		'borgstatus' => sub {
			(my $a, my $b) = @_;
			$self->{borged} = $b->{att}->{value};
		},
		'cools' => sub {
			(my $a, my $b) = @_;
			$self->{cools} = $b->text;
		},
		'votesleft' => sub {
			(my $a, my $b) = @_;
			$self->{votes} = $b->text;
		},
		'karma' => sub {
			(my $a, my $b) = @_;
			$self->{karma} = $b->text;
		},
		'experience' => sub {
			(my $a, my $b) = @_;
			$self->{experience} = $b->text;
		},
		'numwriteups' => sub {
			(my $a, my $b) = @_;
			$self->{writeups} = $b->text;
		},
		'forbiddance' => sub {
			(my $a, my $b) = @_;
			$self->{forbidden} = $b->text;
		},
		'xpinfo' => sub {
			(my $a, my $b) = @_;
			if( my $c = $b->first_child('xpchange') ) {
				$self->{xpchange} = $c->text;
			}
			if( my $c = $b->first_child('nextlevel') ) {
				$self->{nextlevel} = {
					experience => $c->{att}->
						{experience},
					writeups => $c->{att}->
						{writeups},
					level => $c->text
				};
			}
		},
		'personalnodes/e2node' => sub {
			(my $a, my $b) = @_;
			push @{ $self->{personal} }, {
				title => $b->text,
				id    => $b->{att}->{node_id}
			};
		}
	};

	$self->clear;

	$self->parse( 'session', $handlers, [ 1 ] );
}

1;
__END__