Apache-Session-Wrapper

 view release on metacpan or  search on metacpan

lib/Apache/Session/Wrapper.pm  view on Meta::CPAN

    my @missing;
    foreach my $set (@$sets)
    {
        my @matched = grep { exists $self->{$_} } @$set;

        return if @matched == @$set;

        @missing = grep { ! exists $self->{$_} } @$set;
    }

    param_error "Some or all of the required parameters for your chosen $type class ($class) were provided."
                . "  The following parameters were missing: @missing\n";
}

sub _set_session_params
{
    my $self = shift;

    my %params;

    $self->_sets_to_params
	( $ApacheSessionParams{ $self->{session_class_piece} },
	  \%params );

    $self->_sets_to_params
	( $OptionalApacheSessionParams{ $self->{session_class_piece} },
	  \%params );


    if ( $self->{session_class_piece} eq 'Flex' )
    {
	foreach my $key ( keys %ApacheSessionFlexParams )
	{
	    my $subclass = $self->{$key};
	    $params{ $StudlyForm{$key} } = $subclass;

	    $self->_sets_to_params
		( $ApacheSessionFlexParams{$key}{$subclass},
		  \%params );

	    $self->_sets_to_params
		( $OptionalApacheSessionFlexParams{$key}{$subclass},
		  \%params );
	}
    }

    $self->{params} = \%params;

    $self->_set_cookie_fields
        if $self->{use_cookie};
}

sub _set_cookie_fields
{
    my $self = shift;

    my $cookie_class;
    if ($MOD_PERL)
    {
        $cookie_class =
            $MOD_PERL == 2 ? 'Apache2::Cookie' : 'Apache::Cookie';

        eval "require $cookie_class"
            unless $cookie_class->can('new');
    }

    unless ( $cookie_class && $cookie_class->can('new' ) )
    {
        require CGI::Cookie;
        $cookie_class = 'CGI::Cookie';
    }

    $self->{cookie_class} = $cookie_class;

    if ( $self->{cookie_class} eq 'CGI::Cookie' )
    {
        $self->{new_cookie_args} = [];
        $self->{fetch_cookie_args} = [];
    }
    else
    {
        $self->{new_cookie_args} =
            [ $MOD_PERL == 2
              ? Apache2::RequestUtil->request
              : Apache->request
            ];

        $self->{fetch_cookie_args} =
            ( $MOD_PERL == 2
              ? $self->{new_cookie_args}
              : []
            );
        $self->{bake_cookie_args} =
            ( $MOD_PERL == 2
              ? $self->{new_cookie_args}
              : []
            );
    }
}

sub _sets_to_params
{
    my $self = shift;
    my $sets = shift;
    my $params = shift;

    foreach my $set (@$sets)
    {
	foreach my $key (@$set)
	{
	    if ( exists $self->{$key} )
	    {
		$params->{ $StudlyForm{$key} } =
		    $self->{$key};
	    }
	}
    }
}

sub _make_session
{
    my $self = shift;
    my $session_id = shift;

    return if
        defined $session_id && $self->_try_session_id( $session_id );

    my $id = $self->_get_session_id;
    return if defined $id && $self->_try_session_id($id);

    if ( defined $self->{param_name} )
    {
        my $id = $self->_get_session_id_from_args;

        return if defined $id && $self->_try_session_id($id);
    }

    if ( $self->{use_cookie} )
    {
        my $id = $self->_get_session_id_from_cookie;

        if ( defined $id && $self->_try_session_id($id) )
        {
            $self->{cookie_is_baked} = 1
                unless $self->{cookie_resend};

            return;
        }
    }

    # make a new session id
    $self->_try_session_id(undef);
}

# for subclasses
sub _get_session_id { return }

sub _get_session_id_from_args
{
    my $self = shift;

    return $self->{param_object}->param( $self->{param_name} );
}

sub _get_session_id_from_cookie
{
    my $self = shift;

    if ( $MOD_PERL == 2 )
    {
        my $jar = Apache2::Cookie::Jar->new( @{ $self->{fetch_cookie_args} } );
        my $c   = $jar->cookies( $self->{cookie_name} );
        return $c->value if $c;
    }
    else
    {
        my %c = $self->{cookie_class}->fetch( @{ $self->{fetch_cookie_args} } );

        return $c{ $self->{cookie_name} }->value
            if exists $c{ $self->{cookie_name} };
    }
    return undef;
}

sub _try_session_id
{
    my $self = shift;
    my $session_id = shift;

    return 1 if ( $self->{session} &&
                  defined $session_id &&
                  $self->{session_id} eq $session_id );

    my %s;
    {
	local $SIG{__DIE__};
	eval
	{
	    tie %s, "Apache::Session::$self->{session_class_piece}",
                $session_id, $self->{params};
	};

        if ( $@ || ! tied %s || ! $s{_session_id} )
        {
            $self->_handle_tie_error( $@, $session_id );
            return;
        }
    }

    untie %{ $self->{session} } if $self->{session};

    $self->{session} = \%s;
    $self->{session_id} = $s{_session_id};

    $self->{cookie_is_baked} = 0;

    return 1;
}

sub _handle_tie_error
{
    my $self = shift;
    my $err = shift;
    my $session_id = shift;

    if ( $err =~ /Object does not exist/ && defined $session_id )
    {
        return if $self->{allow_invalid_id};

        Apache::Session::Wrapper::Exception::NonExistentSessionID->throw
            ( error => "Invalid session id: $session_id",
              session_id => $session_id );
    }
    else
    {
        my $error =
            $err ? $err : "Tying to Apache::Session::$self->{session_class_piece} failed but did not throw an exception";
        die $error;
    }
}

sub _bake_cookie
{
    my $self = shift;

    my $expires = shift || $self->{cookie_expires};
    $expires = undef if defined $expires && $expires =~ /^session$/i;

    my $domain = $self->{cookie_domain};

    my $cookie =
        $self->{cookie_class}->new
            ( @{ $self->{new_cookie_args} },
              -name    => $self->{cookie_name},
              # Apache2::Cookie will return undef if we pass undef for
              # -value.
              -value   => ( $self->{session_id} || '' ),
              ( defined $expires
                ? ( -expires => $expires )
                : ()
              ),
              ( defined $domain
                ? ( -domain  => $domain )
                : ()
              ),
              -path    => $self->{cookie_path},
              -secure  => $self->{cookie_secure},
            );

    # If not running under mod_perl, CGI::Cookie->bake() will call
    # print() to send a cookie header right now, which may not be what
    # the user wants.
    if ( $cookie->can('bake') && ! $cookie->isa('CGI::Cookie') )
    {
        $cookie->bake( @{ $self->{bake_cookie_args} } );
    }
    else
    {
        my $header_object = $self->{header_object};
        for my $meth (@HeaderMethods)
        {
            if ( $header_object->can($meth) )
            {
                $header_object->$meth->add( 'Set-Cookie' => $cookie );
                last;
            }
        }
    }

    # always set this even if we skipped actually setting the cookie
    # to avoid resending it.  this keeps us from entering this method
    # over and over
    $self->{cookie_is_baked} = 1
        unless $self->{cookie_resend};
}

sub session
{
    my $self = shift;
    my %p = validate( @_,
		      { session_id =>
			{ type => SCALAR,
                          optional => 1,
			},
		      } );

    if ( ! $self->{session} || %p )
    {
        $self->_make_session( $p{session_id} );

        $self->_bake_cookie
            if $self->{use_cookie} && ! $self->{cookie_is_baked};
    }

    return $self->{session};
}

sub delete_session
{
    my $self = shift;

    return unless $self->{session};

    my $session = delete $self->{session};

    (tied %$session)->delete;

    delete $self->{session_id};

    $self->_bake_cookie('-1d') if $self->{use_cookie};
}

sub cleanup_session
{
    my $self = shift;

    if ( $self->{always_write} )
    {
	if ( $self->{session}->{___force_a_write___} )
	{
	    $self->{session}{___force_a_write___} = 0;
	}
	else
	{

lib/Apache/Session/Wrapper.pm  view on Meta::CPAN


=item * Apache::Session::Lock::File

=item * Apache::Session::Lock::Null

=item * Apache::Session::Lock::Semaphore

=item * Apache::Session::Generate::MD5

=item * Apache::Session::Generate::ModUsertrack

=item * Apache::Session::Serialize::Storable

=item * Apache::Session::Serialize::Base64

=item * Apache::Session::Serialize::Sybase

=item * Apache::Session::Serialize::UUEncode

=item * Apache::Session::Serialize::PHP

=back

=head2 Generic Parameters

=over 4

=item * class  =>  class name

The name of the C<Apache::Session> subclass you would like to use.

This module will load this class for you if necessary.

This parameter is required.

=item * always_write  =>  boolean

If this is true, then this module will ensure that C<Apache::Session>
writes the session.  If it is false, the default C<Apache::Session>
behavior is used instead.

This defaults to true.

=item * allow_invalid_id  =>  boolean

If this is true, an attempt to create a session with a session id that
does not exist in the session storage will be ignored, and a new
session will be created instead.  If it is false, a
C<Apache::Session::Wrapper::Exception::NonExistentSessionID> exception
will be thrown instead.

This defaults to true.

=item * session_id  =>  string

Try this session id first and use it if it exist. If the session does
not exist, it will ignore this parameter and make a new session.

=back

=head2 Cookie-Related Parameters

=over 4

=item * use_cookie  =>  boolean

If true, then this module will use one of C<Apache::Cookie>,
C<Apache2::Cookie> or C<CGI::Cookie> (as appropriate) to set and read
cookies that contain the session id.

=item * cookie_name  =>  name

This is the name of the cookie that this module will set.  This
defaults to "Apache-Session-Wrapper-cookie".
Corresponds to the C<Apache::Cookie> "-name" constructor parameter.

=item * cookie_expires  =>  expiration

How long before the cookie expires.  This defaults to 1 day, "+1d".
Corresponds to the "-expires" parameter.

As a special case, you can set this value to "session" to have the
"-expires" parameter set to undef, which gives you a cookie that
expires at the end of the session.

=item * cookie_domain  =>  domain

This corresponds to the "-domain" parameter.  If not given this will
not be set as part of the cookie.

If it is undefined, then no "-domain" parameter will be given.

=item * cookie_path  =>  path

Corresponds to the "-path" parameter.  It defaults to "/".

=item * cookie_secure  =>  boolean

Corresponds to the "-secure" parameter.  It defaults to false.

=item * cookie_resend  =>  boolean

By default, this parameter is true, and the cookie will be sent for
I<every request>.  If it is false, then the cookie will only be sent
when the session is I<created>.  This is important as resending the
cookie has the effect of updating the expiration time.

=item * header_object => object

When running outside of mod_perl, you must provide an object to which
the cookie header can be added.  This object must provide an
C<err_headers_out()> or C<headers_out()> method.

Under mod_perl 1, this will default to the object returned by C<<
Apache->request() >>. Under mod_perl 2 we call C<<
Apache2::RequestUtil->request() >>

=back

=head2 Query/POST-Related Parameters

=over 4

=item * param_name  =>  name

If set, then this module will first look for the session id in the
object specified via "param_object".  This parameter determines the
name of the parameter that is checked.

If you are also using cookies, then the module checks the param object
I<first>, and then it checks for a cookie.

=item * param_object  =>  object

This should be an object that provides a C<param()> method.  This

lib/Apache/Session/Wrapper.pm  view on Meta::CPAN


Corresponds to the C<Transaction> parameter.

=item * directory  =>  directory

Corresponds to the C<Directory> parameter passed to
C<Apache::Session::File>.

=item * lock_directory  =>  directory

Corresponds to the C<LockDirectory> parameter passed to
C<Apache::Session::File>.

=item * file_name  =>  file name

Corresponds to the C<FileName> parameter passed to
C<Apache::Session::DB_File>.

=item * store  =>  class

Corresponds to the C<Store> parameter passed to
C<Apache::Session::Flex>.

=item * lock  =>  class

Corresponds to the C<Lock> parameter passed to
C<Apache::Session::Flex>.

=item * generate  =>  class

Corresponds to the C<Generate> parameter passed to
C<Apache::Session::Flex>.

=item * serialize  =>  class

Corresponds to the C<Serialize> parameter passed to
C<Apache::Session::Flex>.

=item * textsize  =>  size

Corresponds to the C<textsize> parameter passed to
C<Apache::Session::Sybase>.

=item * long_read_len  =>  size

Corresponds to the C<LongReadLen> parameter passed to
C<Apache::Session::MySQL>.

=item * n_sems  =>  number

Corresponds to the C<NSems> parameter passed to
C<Apache::Session::Lock::Semaphore>.

=item * semaphore_key  =>  key

Corresponds to the C<SemaphoreKey> parameter passed to
C<Apache::Session::Lock::Semaphore>.

=item * mod_usertrack_cookie_name  =>  name

Corresponds to the C<ModUsertrackCookieName> parameter passed to
C<Apache::Session::Generate::ModUsertrack>.

=item * save_path  =>  path

Corresponds to the C<SavePath> parameter passed to
C<Apache::Session::PHP>.

=back

=head1 HOW COOKIES ARE HANDLED

When run under mod_perl, this module attempts to first use
C<Apache::Cookie> for cookie-handling.  Otherwise it uses
C<CGI::Cookie> as a fallback.

If it ends up using C<CGI::Cookie> then you must provide a
"header_object" parameter. This object must have an
C<err_headers_out()> or C<headers_out()> method. It looks for these
methods in that order. The method is expected to return an object with
an API like C<Apache::Table>. It calls C<add()> on the returned method
to add a "Set-Cookie" header.

=head1 REGISTERING CLASSES

In order to support any C<Apache::Session> subclasses, this module
provides a simple registration mechanism.

You can register an C<Apache::Session> subclass, or a class intended
to provide a class that implements something required by
C<Apache::Session::Flex>.

=head2 Registering a Complete Subclass

This is done by calling C<< Apache::Session::Wrapper->RegisterClass() >>:

  Apache::Session::Wrapper->RegisterClass
      ( name     => 'MyClass',
        required => [ [ qw( param1 param2 ) ],
                      [ qw( param3 param4 ) ] ],
        optional => [ 'optional_p' ],
      );

  Apache::Session::Wrapper->RegisterClass
      ( name     => 'Apache::Session::MyFile',
        required => 'File',
        optional => 'File',
      );

The C<RegisterClass()> method takes the following options:

=over 4

=item * name

This should be the name of the class you are registering. The actual
class must start with "Apache::Session::", but this part does not need
to be included when registering the class (it's optional).

=item * required

These are the required parameters for this class.

The value of this parameter can either be a string or a reference to
an array of array references.

If it is a string, then it identifies an existing C<Apache::Session>
subclass which is already registered or built-in, like "File" or
"Postgres".

If it an array reference, then I<that reference> should in turn
contain one or more array references. Each of those contained
references represents one set of required parameters. When an
C<Apache::Session::Wrapper> object is constructed, only one of these
sets must be passed in. For example:

  required => [ [ qw( p1 p2 ) ],
                [ qw( p2 p3 p4 ) ] ]

This says that either "p1" and "p2" must be provided, I<or> "p2",
"p3", and "p4".



( run in 1.702 second using v1.01-cache-2.11-cpan-7fcb06a456a )