Session.pm 4 KB
Newer Older
1 2 3 4 5 6 7 8
##@file
# Base package for LemonLDAP::NG session object

##@class
# Specify a session object, how to create/update/remove session

package Lemonldap::NG::Common::Session;

9
our $VERSION = 1.4.1;
10 11 12 13 14 15

use Mouse;
use Lemonldap::NG::Common::Apache::Session;

has 'id' => (
    is  => 'rw',
16 17 18 19 20 21 22
    isa => 'Str|Undef',
);

has 'force' => (
    is      => 'rw',
    isa     => 'Bool',
    default => 0,
23 24 25 26
);

has 'kind' => (
    is  => 'rw',
27
    isa => 'Str|Undef',
28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46
);

has 'data' => (
    is  => 'rw',
    isa => 'HashRef',
);

has 'options' => (
    is  => 'rw',
    isa => 'HashRef',
);

has 'storageModule' => (
    is       => 'ro',
    isa      => 'Str',
    required => 1,
);

has 'storageModuleOptions' => (
47 48
    is  => 'ro',
    isa => 'HashRef|Undef',
49 50 51 52
);

has 'cacheModule' => (
    is  => 'rw',
53
    isa => 'Str|Undef',
54 55 56 57
);

has 'cacheModuleOptions' => (
    is  => 'rw',
58
    isa => 'HashRef|Undef',
59 60
);

61 62 63 64 65
has 'error' => (
    is  => 'rw',
    isa => 'Str|Undef',
);

66 67 68 69 70 71 72 73 74 75 76 77
sub BUILD {
    my $self = shift;

    # Load Apache::Session module
    unless ( $self->storageModule->can('populate') ) {
        eval "require " . $self->storageModule;
        return undef if $@;
    }

    # Register options for common Apache::Session module
    my $moduleOptions = $self->storageModuleOptions || {};
    my %options = (
78
        %$moduleOptions,
79 80 81 82 83 84 85 86 87
        backend             => $self->storageModule,
        localStorage        => $self->cacheModule,
        localStorageOptions => $self->cacheModuleOptions
    );

    $self->options( \%options );

    my $data = $self->_tie_session;

88 89 90 91
    # Is it a session creation request?
    my $creation = 1
      if ( !$self->id or ( $self->id and !$data and $self->force ) );

92 93 94
    # If session id was submitted but session is not found
    # And we want to force id
    # Then use setId to create session
95
    if ( $self->id and $creation ) {
96 97 98 99 100 101
        $options{setId} = $self->id;
        $self->options( \%options );
        $self->id(undef);
        $data = $self->_tie_session;
    }

102 103 104 105 106 107 108
    # If session is created
    # Then set session kind in session
    if ( $creation and $self->kind ) {
        $data->{_session_kind} = $self->kind;
    }

    # Load session data into object
109
    if ($data) {
110
        $self->_save_data($data);
111 112
        $self->kind( $data->{_session_kind} );
        $self->id( $data->{_session_id} );
113

114 115 116 117 118 119 120 121 122 123
        untie(%$data);
    }
}

sub _tie_session {
    my $self = shift;

    my %h;

    eval {
124 125 126 127 128 129 130 131 132 133
        # SOAP session module must be directly tied
        if ( $self->storageModule =~
            /Lemonldap::NG::Common::Apache::Session::SOAP/ )
        {
            tie %h, $self->storageModule, $self->id, $self->options;
        }
        else {
            tie %h, 'Lemonldap::NG::Common::Apache::Session', $self->id,
              $self->options;
        }
134 135
    };

136 137 138 139 140 141
    if ( $@ or not tied(%h) ) {
        my $msg = "Session cannot be tied";
        $msg .= ": $@" if $@;
        $self->error($msg);
        return undef;
    }
142 143 144 145 146 147 148 149 150 151 152 153 154 155 156

    return \%h;
}

sub _save_data {
    my ( $self, $data ) = @_;

    my %saved_data = %$data;
    $self->data( \%saved_data );
}

sub update {
    my $self  = shift;
    my $infos = shift;

157 158 159 160
    unless ( ref $infos eq "HASH" ) {
        $self->error("You need to provide a HASHREF");
        return 0;
    }
161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179

    my $data = $self->_tie_session;

    if ($data) {
        foreach ( keys %$infos ) {
            if ( defined $infos->{$_} ) {
                $data->{$_} = $infos->{$_};
            }
            else {
                delete $data->{$_};
            }
        }

        $self->_save_data($data);

        untie(%$data);
        return 1;
    }

180
    $self->error("No data found in session");
181 182 183 184 185 186 187 188 189 190
    return 0;
}

sub remove {
    my $self = shift;

    my $data = $self->_tie_session;

    eval { tied(%$data)->delete(); };

191 192 193 194 195
    if ($@) {
        $self->error("Unable to delete session: $@");
        return 0;
    }

196 197 198
    return 1;
}

199
sub cacheUpdate {
Clément OUDOT's avatar
Clément OUDOT committed
200 201 202 203
    my $self = shift;

    # Update a data to force update from cache
    return $self->update( { '_session_id' => $self->id } );
204 205
}

206 207 208
no Mouse;

1;