File Coverage

blib/lib/MasonX/Request/WithApacheSession.pm

Criterion	Covered	Total	%
statement	50	53	94.3
branch	13	20	65.0
condition			n/a
subroutine	14	14	100.0
pod	2	3	66.6
total	79	90	87.7

package MasonX::Request::WithApacheSession;

use 5.005;
use strict;

use vars qw($VERSION @ISA);

$VERSION = '0.31';

use Apache::Session::Wrapper 0.13;

use HTML::Mason 1.16;
use HTML::Mason::Exceptions ( abbr => [ qw( param_error error ) ] );
use HTML::Mason::Request;

use Params::Validate qw(:all);
Params::Validate::validation_options( on_fail => sub { param_error( join '', @_ ) } );

# This may change later
@ISA = qw(HTML::Mason::Request);


#
# This is a bit of a hack, ideally we could do this:
#
#   __PACKAGE__->contained_objects( class  => 'Apache::Session::Wrapper',
#                                   prefix => 'session_',
#                                 );
#
# and let Class::Container sort it all out.  We'd also need a way to
# override some of the contained class's defaults.
#
my $wrapper_p = Apache::Session::Wrapper->valid_params;

{
    my %p = map { ( "session_$_" => $wrapper_p->{$_} ) } keys %$wrapper_p;
    foreach my $k ( grep { exists $p{$_}{depends} } keys %p )
    {
        my %new = %{ $p{$k} };

        my @d = ref $new{depends} ? @{ $new{depends} } : $new{depends};
        $new{depends} = [ map { ( "session_$_" ) } @d ];

        $p{$k} = \%new;
    }

    $p{session_cookie_name}{default} = 'MasonX-Request-WithApacheSession-cookie';

    # We'll always provide this, so the user doesn't need to.
    delete $p{session_param_name}{depends};

    __PACKAGE__->valid_params
        ( # This is for backwards compatibility, it's been renamed to
          # param_name
          session_args_param =>
          { type => SCALAR,
            optional => 1,
            descr => 'Name of the parameter to use for session tracking',
          },
          %p,
        );
}

sub new
{

    my $class = shift;

    $class->alter_superclass( $HTML::Mason::ApacheHandler::VERSION ?
                              'HTML::Mason::Request::ApacheHandler' :
                              $HTML::Mason::CGIHandler::VERSION ?
                              'HTML::Mason::Request::CGI' :
                              'HTML::Mason::Request' );

    my $self = $class->SUPER::new(@_);

    return $self if $self->is_subrequest;

    # backwards compatibility
    $self->{session_param_name} =
        $self->{session_args_param} if exists $self->{session_args_param};

    my %extra;
    if ( $self->can('apache_req') )
    {
        %extra = ( header_object => $self->apache_req,
                   param_object  => $self->apache_req,
                 );
    }
    elsif ( $self->can('cgi_process') )
    {
        %extra = ( header_object => $self->cgi_request,
                   param_object  => $self->cgi_object,
                 );
    }

    $self->{apache_session_wrapper} =
        Apache::Session::Wrapper->new
            ( %extra,
              map { $_ => $self->{"session_$_"} }
              grep { exists $self->{"session_$_"} }
              keys %$wrapper_p
            );

    return $self;
}

sub wrapper
{
    $_[0]->is_subrequest
    ? $_[0]->parent_request->wrapper
    : $_[0]->{apache_session_wrapper}
}

sub exec
{
    my $self = shift;

    return $self->SUPER::exec(@_)
        if $self->is_subrequest;

    my @r;

    if (wantarray)
    {
	@r = $self->SUPER::exec(@_);
    }
    else
    {
	$r[0] = $self->SUPER::exec(@_);
    }

    $self->wrapper->cleanup_session;

    return wantarray ? @r : $r[0];
}

BEGIN
{
    foreach my $meth ( qw( session delete_session ) )
    {
        no strict 'refs';
        *{$meth} = sub { shift->wrapper->$meth(@_) };
    }
}


1;

__END__