File Coverage

blib/lib/AxKit/XSP/Session.pm

Criterion	Covered	Total	%
statement	4	6	66.6
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	6	8	75.0

package AxKit::XSP::Session;
use strict;
use Apache::AxKit::Language::XSP;
use Apache::Session;
use Date::Format;
use Apache;
use Carp;

use vars qw/@ISA $NS $VERSION $SESSION/;

@ISA = ('Apache::AxKit::Language::XSP');
$NS = 'http://www.apache.org/1999/XSP/Session';

$VERSION = "0.11";

## Taglib subs

sub get_attribute
{
    my ( $attribute ) = @_;
    $attribute =~ s/^\s*//;
    $attribute =~ s/\s*$//;
    my $r = Apache->request;
    my $session = $r->pnotes('xsp_session');
    return $session->{$attribute};
}

sub get_attribute_names
{
    my $r = Apache->request;
    my $session = $r->pnotes('xsp_session');
    return keys(%$session);
}

sub get_id
{
    my $r = Apache->request;
    my $session = $r->pnotes('xsp_session');
    return $session->{_session_id};
}

# I've changed the API for this particular tag.  The Cocoon XSP definition for get-creation-time
# really stinks.  The default first of all, is "long", which is basically number of seconds since
# epoch.  It also has support for "node" output, which basically is the same as "long", except it
# outputs the value in a hard-coded XML tag.  If there's any merit to the node output, someone
# please tell me; otherwise, I'll leave it out.
sub get_creation_time
{
    my ( $as ) = @_;
    my $r = Apache->request;
    my $session = $r->pnotes('xsp_session');
    return _get_time( $as, $session->{_creation_time} );
}

# Ahh, the wonders of "Copy-Paste(tm)" technology!  Since it's late at night, and this
# XSP taglib is just a means-to-an-end for me, I'm just copying the 'get_creation_time'
# subroutine.  If anyone feels so inclined, you're welcome to clean this up. :)
sub get_last_accessed_time
{
    my ( $as ) = @_;
    my $r = Apache->request;
    # This isn't necessary anymore
    # TODO update the documentation to reflect this
    #return undef unless ( $r->dir_config( 'UseSessionAccessTimestamp' ) =~ /on/i );

    my $session = $r->pnotes('xsp_session');
    return _get_time( $as, $session->{_last_accessed_time} );
}

sub _get_time
{
    my ( $as, $time ) = @_;
    $as = 'string' unless ( $as );
    my $formatted_time = undef;
    if ( $as eq 'long' )
    {
        return $time;
    }
    elsif ( $as eq 'string' )
    {
        # Outputs a string like "Wed Jun 13 15:57:06 EDT 2001"
        return time2str('%a %b %d %H:%M:%S %Z %Y', $time);
    }
}

sub set_attribute
{
    my ( $attribute, $value ) = @_;
    $attribute =~ s/^\s*//;
    $attribute =~ s/\s*$//;
    $value =~ s/^\s*//;
    $value =~ s/\s*$//;
    # exit out if they try to set any magic keys
    return if ( $attribute =~ /^_/ );
    #print STDERR "set-attribute: \$attribute=\"$attribute\", \$value=\"$value\".\n";

    my $r = Apache->request;
    my $session = $r->pnotes('xsp_session');
    $session->{$attribute} = $value;
    return;
}

sub remove_attribute
{
    my ( $attribute ) = @_;
    $attribute =~ s/^\s*//;
    $attribute =~ s/\s*$//;
    # exit out if they try to set any magic keys
    return if ( $attribute =~ /^_/ );
    #print STDERR "remove-attribute: \$attribute=\"$attribute\".\n";

    my $r = Apache->request;
    my $session = $r->pnotes('xsp_session');
    delete $session->{$attribute};
    #print STDERR "remove-attribute: value=\"" . $session->{$attribute} . "\".\n";
    return;
}

sub invalidate
{
    my $r = Apache->request;
    my $session_obj = $r->pnotes('xsp_session_ref');
    $session_obj->delete;
    return;
}

## Parser subs

sub parse_start {
    my ($e, $tag, %attribs) = @_;
    #warn "Checking: $tag\n";

    if ($tag eq 'get-attribute')
    {
        my $code = '{ my ($name);';
        if ( $attribs{name} )
        {
            $code .= '$name = q|' . $attribs{name} . '|;';
        }
        return $code;
    }

    elsif ($tag eq 'name')
    {
        return '$name = ""';
    }

    elsif ($tag eq 'value')
    {
        return '$value = ""';
    }

    elsif ($tag eq 'get-id')
    {
        return q|{ AxKit::XSP::Session::get_id(); }|;
    }

    elsif ($tag eq 'get-creation-time')
    {
        my $code = '{ my $as = ';
        if ( defined( $attribs{as} ) )
        {
            $code .= 'q|' . $attribs{as} . '|;';
        }
        else
        {
            $code .= 'undef;';
        }
        $code .= ' AxKit::XSP::Session::get_creation_time( $as ); }';
    }

    elsif ($tag eq 'get-last-accessed-time')
    {
        my $code = '{ my $as = ';
        if ( defined( $attribs{as} ) )
        {
            $code .= 'q|' . $attribs{as} . '|;';
        }
        else
        {
            $code .= 'undef;';
        }
        $code .= ' AxKit::XSP::Session::get_last_accessed_time( $as ); }';
    }

    elsif ($tag eq 'invalidate')
    {
        return q|{ AxKit::XSP::Session::invalidate(); }|;
    }

    elsif ($tag eq 'remove-attribute')
    {
        my $code = '{ my ($name);';
        if ( $attribs{name} )
        {
            $code .= '$name = q|' . $attribs{name} . '|;';
        }
        return $code;
    }

    elsif ($tag eq 'set-attribute')
    {
        my $code = '{ my ($name, $value);';
        if ( $attribs{name} )
        {
            $code .= '$name = q|' . $attribs{name} . '|;';
        }
        if ( $attribs{value} )
        {
            $code .= '$value = q|' . $attribs{value} . '|;';
        }
        return $code;
    }

    else {
        die "Unknown session tag: $tag";
    }
}

sub parse_char {
    my ($e, $text) = @_;
    return '' unless $text =~ /\S/;

    $text =~ s/\|/\\\|/g;
    $text =~ s/\\$/\\\\/gsm;
    return " . q|$text| ";
}

sub parse_end {
    my ($e, $tag) = @_;

    if ($tag =~ /name|value/)
    {
        return ';';
    }

    elsif ($tag eq 'get-attribute')
    {
        return 'AxKit::XSP::Session::get_attribute($name);}' . "\n";
    }

    elsif ($tag eq 'remove-attribute')
    {
        return 'AxKit::XSP::Session::remove_attribute($name);}' . "\n";
    }

    elsif ($tag eq 'set-attribute')
    {
        return 'AxKit::XSP::Session::set_attribute($name, $value);}' . "\n";
    }

    return ";";
}

sub parse_comment {
    # compat only
}

sub parse_final {
   # compat only
}

1;

__END__