The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# MAPLAT  (C) 2008-2011 Rene Schickbauer
# Developed under Artistic license
# for Magna Powertrain Ilz
package Maplat::Web::SessionSettings;
use strict;
use warnings;

use base qw(Maplat::Web::BaseModule);
use Maplat::Helpers::DateStrings;
use Maplat::Helpers::DBSerialize;
use Time::HiRes qw(time);
use Carp;
use Readonly;

Readonly::Scalar my $RETRY_COUNT  => 10;
Readonly::Scalar my $RETRY_WAIT   => 0.05;

our $VERSION = 0.995;


sub new {
    my ($proto, %config) = @_;
    my $class = ref($proto) || $proto;
    
    my $self = $class->SUPER::new(%config); # Call parent NEW
    bless $self, $class; # Re-bless with our class

    $self->{lastClean} = time;

    return $self;
}

sub reload {
    my ($self) = shift;
    # Nothing to do.. in here, we only use the template and database module
    return;
}

sub register {
    my $self = shift;
    $self->register_loginitem("on_login");
    $self->register_logoutitem("on_logout");
    $self->register_sessionrefresh("on_refresh");
    return;
}

# NOTE: We have TWO sets of data for each session:
# The first data set is the used keys within a session (a hash),
# the second set of data are the actual entries.
# We don't actually have to manage something like "last access"
# right now, we depend on beeing onLogout() called by the
# login module for timed-out sessions

sub get {
    my ($self, $settingname) = @_;
    
    my $settingref;
        
    my $loginh = $self->{server}->{modules}->{$self->{login}};
    my $dbh = $self->{server}->{modules}->{$self->{db}};
    my $memh = $self->{server}->{modules}->{$self->{memcache}};

    my $sessionid = $loginh->get_sessionid;
    return 0 if(!defined($sessionid));
    
    my $keyname = "SessionSettings::" . $sessionid . "::" . $settingname;
    
    $settingref = $memh->get($keyname);
    if(defined($settingref)) {
        return (1, Maplat::Helpers::DBSerialize::dbthaw($settingref));
    }

    # Ok, try DB
    my $sth = $dbh->prepare_cached("SELECT yamldata FROM session_settings WHERE sid = ? AND skey = ?")
          or croak($dbh->errstr);
    $sth->execute($sessionid, $settingname) or croak($dbh->errstr);
    while((my @line = $sth->fetchrow_array)) {
       $settingref = $line[0];
       last;
    }
    $sth->finish;
    $dbh->rollback;
 
    # Ok, now also store data in memcached
    if(defined($settingref)) {
       $memh->set($keyname, $settingref);
        return (1, Maplat::Helpers::DBSerialize::dbthaw($settingref));
    }
    
    return 0;
}

sub set { ## no critic (NamingConventions::ProhibitAmbiguousNames)
    my ($self, $settingname, $settingref) = @_;
    
    my $loginh = $self->{server}->{modules}->{$self->{login}};
    my $dbh = $self->{server}->{modules}->{$self->{db}};
    my $memh = $self->{server}->{modules}->{$self->{memcache}};

    my $sessionid = $loginh->get_sessionid;
    return 0 if(!defined($sessionid));
    
    my $keyname = "SessionSettings::" . $sessionid . "::" . $settingname;
    
    my $yamldata = Maplat::Helpers::DBSerialize::dbfreeze($settingref);
    my $olddata = $memh->get($keyname);
    if(defined($olddata) && $olddata eq $yamldata) {
        return 1;
    }
    
    $memh->set($keyname, $yamldata);

    my $sth = $dbh->prepare_cached("SELECT merge_sessionsettings(?, ?, ?)")
            or return;
            
    my $count = 0;
    my $ok = 0;
    while($count < $RETRY_COUNT) {
        # print STDERR "SESSION: ($count) Merge $sessionid / $settingname\n";
        if(!$sth->execute($sessionid, $settingname, $yamldata)) {
            $sth->finish;
            $dbh->rollback;
            $count++;
            if($count < $RETRY_COUNT) {
                sleep($RETRY_WAIT); # sleep for a short time and try again
            }
         } else {
            $sth->finish;
            $dbh->commit;
            $ok = 1;
            last;
         }
    }
    if(!$ok) {
        croak($dbh->errstr);
    }
    
    return 1;
}

sub delete {## no critic(BuiltinHomonyms)
    my ($self, $settingname, $forcedid) = @_;
    
    my $settingref;

    my $loginh = $self->{server}->{modules}->{$self->{login}};
    my $dbh = $self->{server}->{modules}->{$self->{db}};
    my $memh = $self->{server}->{modules}->{$self->{memcache}};

    my $sessionid = $loginh->get_sessionid;
    if(defined($forcedid)) {
        $sessionid = $forcedid;
    }
    return 0 if(!defined($sessionid));

    my $keyname = "SessionSettings::" . $sessionid . "::" . $settingname;
    

    $memh->delete($keyname);

    my $sth = $dbh->prepare_cached("DELETE FROM session_settings WHERE sid = ? AND skey = ?")
         or croak($dbh->errstr);
         
    my $count = 0;
    my $ok = 0;
    while($count < $RETRY_COUNT) {
        # print STDERR "SESSION: Delete ($count) $sessionid / $settingname\n";
        if(!$sth->execute($sessionid, $settingname)) {
            $sth->finish;
            $dbh->rollback;
            $count++;
            if($count < $RETRY_COUNT) {
                sleep($RETRY_WAIT);
            }
        } else {
            $sth->finish;
            $dbh->commit;
            $ok = 1;
            last;
        }
    }
    
    if(!$ok) {
        croak($dbh->errstr);
    }
    
    return 1;
}

sub list {
    my ($self, $forcedid) = @_;
    
    my @settingnames = ();
    
    my $loginh = $self->{server}->{modules}->{$self->{login}};
    my $dbh = $self->{server}->{modules}->{$self->{db}};
    my $memh = $self->{server}->{modules}->{$self->{memcache}};

    my $sessionid = $loginh->get_sessionid;

    if(defined($forcedid)) {
        $sessionid = $forcedid;
    }

    return 0 if(!defined($sessionid));

    my $sth = $dbh->prepare_cached("SELECT skey FROM session_settings WHERE sid = ?")
        or croak($dbh->errstr);
    $sth->execute($sessionid) or croak($dbh->errstr);
    while((my @line = $sth->fetchrow_array)) {
        push @settingnames, $line[0];
    }
    $sth->finish;
    $dbh->rollback;

    return (1, @settingnames);
}

sub on_login {
    my ($self, $username, $sessionid) = @_;
    
    $self->set('lastUpdate', time);
    $self->set('userName', $username);
    
    return;
}

sub on_logout {
    my ($self, $sessionid) = @_;
    
    my $memh = $self->{server}->{modules}->{$self->{memcache}};
    
    my ($status, @keys) = $self->list($sessionid);
    if($status != 0) {
        foreach my $key (@keys) {
            $self->delete($key, $sessionid);
        }
    }
    return;
}

sub on_refresh {
    my ($self, $sessionid) = @_;

    my $memh = $self->{server}->{modules}->{$self->{memcache}};
    my $dbh = $self->{server}->{modules}->{$self->{db}};
    
    my $curTime = time;
    my ($oldOk, $oldTime) = $self->get('lastUpdate');
    if(!$oldOk || ($curTime - $oldTime) > 60) {
        $self->set('lastUpdate', $curTime);
    }

    
    # Clean up stale sessions - this is only needed if the user
    # closes his/her browser without logging out first. As long as the browser
    # is open, an automatic refresh (javascript) keeps the session "fresh"
    # Only run this once an hour, automatic logout is handled by the Login module
    # by way of expiring cookies/session information. We need this just in case the
    # Login module CAN'T handle the logout because the browser was forced closed.
    #
    # We only do the cleanup every 5 minutes or so
    my $now = time;
    
    return if(($now - $self->{lastClean}) < 300);
    $self->{lastClean} = $now;

    my $liststh = $dbh->prepare("SELECT sid, yamldata
                                FROM session_settings
                                WHERE skey = 'lastUpdate'")
        or croak($dbh->errstr);
    $liststh->execute or croak($dbh->errstr);

    my @stalesessions;
    my $currTime = time;
    while((my @line = $liststh->fetchrow_array)) {
        my $soldTime = Maplat::Helpers::DBSerialize::dbthaw($line[1]);
        my $age = ($currTime - $$soldTime) / 3600;
        if($age > 2) {
            push @stalesessions, $line[0];
        }
    }
    $liststh->finish;
    $dbh->rollback;

    foreach my $session (@stalesessions) {
        # "Manually" logout users
        $self->on_logout($session);
    }

    return;
}

1;
__END__

=head1 NAME

Maplat::Web::SessionSettings - save and load session/module specific data

=head1 SYNOPSIS

This module provides handling module-specific data handling on a per session basis

=head1 DESCRIPTION

This module provides a simple interface to memcached for saving and loading module
specific data on a per session basis. It can, for example, be used to save session specific filters
to memcache. It can handle complex data structures.

Data is not permanently stored, but rather it's deleted when a user logs out or the session times out (auto
user logout). Data is backed up by a DB with its own caching stragety.

=head1 Configuration

        <module>
                <modname>sessionsettings</modname>
                <pm>SessionSettings</pm>
                <options>
                        <memcache>memcache</memcache>
                        <db>maindb</db>
                        <login>authentification</login>
                </options>
        </module>

=head1 WARNING

This module implements its own memcached-based caching strategy. Use Maplat::Web::MemCache as the memcache module,
don't use Maplat::Web::MemCachePg. While both will work and data will be stored permanently, using MemCachePg will
generate some overhead, because the data will be saved redundatly in two places.

=head2 set

This function adds or updates a setting (data structure) in memcache.

It takes two arguments, $settingname is the key name of the setting, and
$settingref is a reference to the data structure you want to store, e.g.:

  $is_ok = $us->set($settingname, $settingref);

It returns a boolean to indicate success or failure.

=head2 get

This function reads a setting from memcached and returns a reference to the data structure.

It takes one arguments, $settingname is the key name of the setting.

  $settingref = $us->get($settingname);

=head2 delete

This function deletes a setting from database and returns a boolean to indicate success or failure.

It takes one arguments, $settingname is the key name of the setting.

  $is_ok = $us->delete($settingname);

=head2 list

This function lists all available settings for a session.

  @settingnames = $us->list();

=head2 on_login

Internal function.

=head2 on_logout

Internal function.

=head2 on_refresh

Internal function.

=head1 Dependencies

This module depends on the following modules beeing configured (the 'as "somename"'
means the key name in this modules configuration):

Maplat::Web::Memcache as "memcache"
Maplat::Web::Login as "login"

=head1 SEE ALSO

Maplat::Web
Maplat::Web::Memcache
Maplat::Web::Login

=head1 AUTHOR

Rene Schickbauer, E<lt>rene.schickbauer@gmail.comE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2008-2011 by Rene Schickbauer

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.10.0 or,
at your option, any later version of Perl 5 you may have available.

=cut