view release on metacpan or  search on metacpan

lib/Apache/Session/Browseable/Store/Redis.pm  view on Meta::CPAN

package Apache::Session::Browseable::Store::Redis;

use strict;
use JSON qw(decode_json);

our $VERSION = '1.3.18';

our $redis;
our %reused_connections;

BEGIN {
    $redis = 'Redis::Fast';
    eval 'use Redis::Fast';
    if ($@) {
        require Redis;
        $redis = 'Redis';
    }
}

sub new {
    my ( $class, $session ) = @_;
    my $self;

    $self->{cache} = $class->_getRedis( $session->{args} );

    bless $self, $class;
}

sub insert {
    my ( $self, $session ) = @_;
    my $index =
      ref( $session->{args}->{Index} )
      ? $session->{args}->{Index}
      : [ split /\s+/, $session->{args}->{Index} ];

    my $id  = $session->{data}->{_session_id};
    my $ttl = $session->{args}->{TTL};
    if ($ttl) {
        $self->{cache}->set( $id, $session->{serialized}, 'EX', $ttl );
    }
    else {
        $self->{cache}->set( $id, $session->{serialized} );
    }
    foreach my $i (@$index) {
        my $t = $session->{data}->{$i};
        next unless ( defined($t) and ( length($t) > 0 ) );
        $self->{cache}->sadd( "${i}_$t", $id );
    }
}

sub update {
    my ( $self, $session ) = @_;
    my $index =
      ref( $session->{args}->{Index} )
      ? $session->{args}->{Index}
      : [ split /\s+/, $session->{args}->{Index} ];

    my $id = $session->{data}->{_session_id};

    # Read old data to clean up stale index entries
    my $old_raw = eval { $self->{cache}->get($id) };
    if ($@) {
        warn "Failed to read previous session '$id' from Redis: $@";
    }
    my $old_data;
    if ( defined $old_raw && length $old_raw ) {
        $old_data = eval { decode_json($old_raw) };
        if ($@) {
            warn "Failed to decode previous session '$id': $@";
        }
    }

    # Store new data
    my $ttl = $session->{args}->{TTL};
    if ($ttl) {
        $self->{cache}->set( $id, $session->{serialized}, 'EX', $ttl );
    }
    else {
        $self->{cache}->set( $id, $session->{serialized} );
    }

    foreach my $i (@$index) {
        my $old_val = defined($old_data) ? $old_data->{$i} : undef;
        my $new_val = $session->{data}->{$i};

        # Remove old index entry if value changed
        if ( defined($old_val) && length($old_val) > 0 ) {
            if ( !defined($new_val)
                || length($new_val) == 0
                || $old_val ne $new_val )
            {
                eval { $self->{cache}->srem( "${i}_$old_val", $id ) };
            }
        }

        # Add new index entry
        if ( defined($new_val) && length($new_val) > 0 ) {
            $self->{cache}->sadd( "${i}_$new_val", $id );
        }
    }
}

sub materialize {
    my ( $self, $session ) = @_;
    $session->{serialized} =
      $self->{cache}->get( $session->{data}->{_session_id} )
      or die 'Object does not exist in data store.';
}

sub remove {
    my ( $self, $session ) = @_;