Created
April 3, 2014 07:32
-
-
Save racke/9949856 to your computer and use it in GitHub Desktop.
Interchange5 Session Crossover Plugin
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
package Dancer::Plugin::Interchange5::SessionCrossover; | |
use warnings; | |
use strict; | |
use Dancer::Plugin; | |
use Dancer qw/:syntax/; | |
use Storable qw/thaw freeze/; | |
# this plugin nesting is not going to work with D2, until further notice :-\ | |
use Dancer::Plugin::Database; | |
our $VERSION = '0.0001'; | |
sub _get_session_id { | |
my $name = plugin_setting->{cookie_name} || 'MV_SESSION_ID'; | |
my $code = cookie $name; | |
} | |
sub _read_key { | |
my ($name, @keys) = @_; | |
debug("$name, @keys"); | |
die "Name is mandatory to read a key!" unless (defined($name) && @keys); | |
my $ref = _read_session($name); | |
debug to_dumper($ref); | |
return unless $ref; | |
my @out; | |
foreach my $k (@keys) { | |
push @out, $ref->{$k}; | |
} | |
wantarray ? return @out : return $out[0]; | |
} | |
sub _write_key { | |
my ($name, @args) = @_; | |
die "Missing name" unless $name; | |
# if no args is passed, just return without barfing | |
return unless @args; | |
# locking here | |
die "Wrong usage! You have to pass pairs of keys/values to write in $name" | |
if (@args % 2); | |
my %data = @args; | |
# get a fresh copy of the session | |
my $freshdata = _read_session($name); | |
# unlock and return | |
# no session available | |
return unless $freshdata; | |
debug to_dumper($freshdata); | |
foreach my $k (keys %data) { | |
$freshdata->{$k} = $data{$k}; | |
} | |
debug "Writing $name with above data"; | |
# replace | |
my $exit = _write_session($name, $freshdata); | |
# unlock | |
return $exit; | |
} | |
sub _read_session { | |
my ($self, @args) = plugin_args(@_); | |
# 1. check for the cookie, if it's not there, we can't do anything | |
my $code = _get_session_id; | |
return unless $code; | |
# 2. get the conf | |
my $dbconf = _get_db_conf(); | |
# 3. read the session | |
my $data = $dbconf->{dbh}->quick_select($dbconf->{table}, | |
{ $dbconf->{code_column}, $code }); | |
# no data, return, but it's fishy | |
return unless $data; | |
# 4. deserialize | |
my $session = thaw($data->{$dbconf->{session_column}}); | |
# 5. return the key if asked so, or the whole thing | |
if (@args) { | |
return $session->{$args[0]}; | |
} | |
else { | |
return $session; | |
} | |
} | |
sub _write_session { | |
my ($self, @args) = plugin_args(@_); | |
my $code = _get_session_id; | |
return unless $code; | |
die ("Wrong usage, write_ic5_session wants two arguments, key and value") | |
unless @args == 2; | |
# Locking is missing right now | |
my ($key, $val) = @args; | |
# first, get a fresh copy of the session | |
my $fresh_data = _read_session(); | |
# if we fail to get fresh data, the session is not available, so return | |
return unless $fresh_data; | |
# replace | |
$fresh_data->{$key} = $val; | |
# and store | |
my $frozen = freeze($fresh_data); | |
my $dbconf = _get_db_conf(); | |
$dbconf->{dbh}->quick_update($dbconf->{table}, | |
{ $dbconf->{code_column}, $code }, | |
{ $dbconf->{session_column}, $frozen }); | |
return $fresh_data; | |
} | |
sub _get_db_conf { | |
# look up the configuration | |
my $conf = plugin_setting || {}; | |
my %dbconf; | |
# get the handler | |
# no database key means use the default one for D::P::Database | |
if ($conf->{database}) { | |
$dbconf{dbh} = database($conf->{database}); | |
} | |
else { | |
$dbconf{dbh} = database; | |
} | |
die q{The table value } . __PACKAGE__ . " settings is mandatory" | |
unless $conf->{table}; | |
# table name | |
$dbconf{table} = $conf->{table}; | |
# hardcoded values | |
$dbconf{code_column} = $conf->{code_column} || 'code'; | |
$dbconf{session_column} = $conf->{session_column} || 'session'; | |
return \%dbconf; | |
} | |
sub _get_conf { | |
return plugin_setting() || {}; | |
} | |
register read_ic5_session => sub { | |
my ($self, @args) = plugin_args(@_); | |
return _read_session(@args); | |
}; | |
register write_ic5_session => sub { | |
my ($self, @args) = plugin_args(@_); | |
return _write_session(@args); | |
}; | |
register read_ic5_scratch => sub { | |
my ($self, @args) = plugin_args(@_); | |
return _read_key(scratch => @args) | |
}; | |
register write_ic5_scratch => sub { | |
my ($self, @args) = plugin_args(@_); | |
return _write_key(scratch => @args); | |
}; | |
register read_ic5_value => sub { | |
my ($self, @args) = plugin_args(@_); | |
return _read_key(values => @args) | |
}; | |
register write_ic5_value => sub { | |
my ($self, @args) = plugin_args(@_); | |
return _write_key(values => @args); | |
}; | |
register ic5_values => sub { | |
return _read_session('values'); | |
}; | |
register ic5_scratch => sub { | |
return _read_session('scratch'); | |
}; | |
register_plugin; | |
1; |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment