view release on metacpan or  search on metacpan

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

sub RegisterClass {
    my $class = shift;
    my %p = validate( @_, { name => { type => SCALAR },
                            required => { type => SCALAR | ARRAYREF, default => [ [ ] ] },
                            optional => { type => SCALAR | ARRAYREF, default => [ ] },
                          },
                    );

    $p{name} =~ s/^Apache::Session:://;

    $ApacheSessionParams{ $p{name} } =
        ( ref $p{required}
          ? $p{required}
          : $ApacheSessionParams{ $p{required} }
        );

    $OptionalApacheSessionParams{ $p{name} } =
        ( ref $p{optional}
          ? [ $p{optional} ]
          : $OptionalApacheSessionParams{ $p{optional} }
        );

    $class->_SetValidParams();
}

sub RegisterFlexClass {
    my $class = shift;
    my %p = validate( @_, { type => { type => SCALAR,
                                      regex => qr/^(?:store|lock|generate|serialize)/,
                                    },
                            name => { type => SCALAR },
                            required => { type => SCALAR | ARRAYREF, default => [ [ ] ] },
                            optional => { type => SCALAR | ARRAYREF, default => [ ]  },
                          },
                    );

    $p{name} =~ s/^Apache::Session:://;
    $p{name} =~ s/^\Q$p{type}\E:://i;

    $ApacheSessionFlexParams{ $p{type} }{ $p{name} } =
        ( ref $p{required}
          ? $p{required}
          : $ApacheSessionFlexParams{ $p{type} }{ $p{required} }
        );

    $OptionalApacheSessionFlexParams{ $p{type} }{ $p{name} } =
        ( ref $p{optional}
          ? [ $p{optional} ]
          : $OptionalApacheSessionFlexParams{ $p{type} }{ $p{optional} }
        );

    $class->_SetValidParams();
}

sub new
{
    my $class = shift;
    my %p = @_;

    my $self = $class->SUPER::new(%p);

    $self->_check_session_params;
    $self->_set_session_params;

    if ( $self->{use_cookie} && ! ( $ENV{MOD_PERL} || $self->{header_object} ) )
    {
        param_error
            "The header_object parameter is required in order to use cookies outside of mod_perl";
    }

    my $session_class = "Apache::Session::$self->{session_class_piece}";
    unless ( $session_class->can('TIEHASH') )
    {
        eval "require $session_class";
        die $@ if $@;
    }

    $self->_make_session( $p{session_id} );

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

    return $self;
}

sub _check_session_params
{
    my $self = shift;

    $self->{session_class_piece} = $self->{class};
    $self->{session_class_piece} =~ s/^Apache::Session:://;

    my $sets = $ApacheSessionParams{ $self->{session_class_piece} }
	or param_error "Invalid session class: $self->{class}";

    $self->_check_sets( $sets, 'session', $self->{class} )
        if grep { @$_ } @$sets;

    if ( $self->{session_class_piece} eq 'Flex' )
    {
	foreach my $key ( keys %ApacheSessionFlexParams )
	{
	    my $subclass = $self->{$key};
	    my $sets = $ApacheSessionFlexParams{$key}{$subclass}
		or param_error "Invalid class for $key: $self->{$key}";

            $self->_check_sets( $sets, $key, $subclass )
                if grep { @$_ } @$sets;
	}
    }
}

sub _check_sets
{
    my $self = shift;
    my $sets = shift;
    my $type = shift;
    my $class = shift;

    my @missing;