Bugzilla – Attachment 153036 Details for
Bug 17427
Replace CGI::Session with Data::Session
Home
|
New
|
Browse
|
Search
|
[?]
|
Reports
|
Help
|
New Account
|
Log In
[x]
|
Forgot Password
Login:
[x]
[patch]
Bug 17427: Embed Data::Session
Bug-17427-Embed-DataSession.patch (text/plain), 203.07 KB, created by
Jonathan Druart
on 2023-07-05 08:04:24 UTC
(
hide
)
Description:
Bug 17427: Embed Data::Session
Filename:
MIME Type:
Creator:
Jonathan Druart
Created:
2023-07-05 08:04:24 UTC
Size:
203.07 KB
patch
obsolete
>From f7cca36b6822299e0b74292a1dea6c2440cbf5ef Mon Sep 17 00:00:00 2001 >From: Jonathan Druart <jonathan.druart@bugs.koha-community.org> >Date: Thu, 4 May 2023 09:41:30 +0200 >Subject: [PATCH] Bug 17427: Embed Data::Session > >Test plan: >Install libdata-session-perl and make sure our lib has priority >over the installed version >--- > lib/Data/Session.pm | 2672 ++++++++++++++++++++++ > lib/Data/Session/Base.pm | 114 + > lib/Data/Session/CGISession.pm | 440 ++++ > lib/Data/Session/Driver.pm | 224 ++ > lib/Data/Session/Driver/BerkeleyDB.pm | 260 +++ > lib/Data/Session/Driver/File.pm | 379 +++ > lib/Data/Session/Driver/Memcached.pm | 227 ++ > lib/Data/Session/Driver/ODBC.pm | 269 +++ > lib/Data/Session/Driver/Oracle.pm | 269 +++ > lib/Data/Session/Driver/Pg.pm | 363 +++ > lib/Data/Session/Driver/SQLite.pm | 330 +++ > lib/Data/Session/Driver/mysql.pm | 296 +++ > lib/Data/Session/ID.pm | 75 + > lib/Data/Session/ID/AutoIncrement.pm | 221 ++ > lib/Data/Session/ID/MD5.pm | 137 ++ > lib/Data/Session/ID/SHA1.pm | 130 ++ > lib/Data/Session/ID/SHA256.pm | 132 ++ > lib/Data/Session/ID/SHA512.pm | 132 ++ > lib/Data/Session/ID/Static.pm | 145 ++ > lib/Data/Session/ID/UUID16.pm | 156 ++ > lib/Data/Session/ID/UUID34.pm | 149 ++ > lib/Data/Session/ID/UUID36.pm | 147 ++ > lib/Data/Session/ID/UUID64.pm | 154 ++ > lib/Data/Session/SHA.pm | 77 + > lib/Data/Session/Serialize/DataDumper.pm | 265 +++ > lib/Data/Session/Serialize/FreezeThaw.pm | 127 + > lib/Data/Session/Serialize/JSON.pm | 125 + > lib/Data/Session/Serialize/Storable.pm | 129 ++ > lib/Data/Session/Serialize/YAML.pm | 125 + > 29 files changed, 8269 insertions(+) > create mode 100644 lib/Data/Session.pm > create mode 100644 lib/Data/Session/Base.pm > create mode 100644 lib/Data/Session/CGISession.pm > create mode 100644 lib/Data/Session/Driver.pm > create mode 100644 lib/Data/Session/Driver/BerkeleyDB.pm > create mode 100644 lib/Data/Session/Driver/File.pm > create mode 100644 lib/Data/Session/Driver/Memcached.pm > create mode 100644 lib/Data/Session/Driver/ODBC.pm > create mode 100644 lib/Data/Session/Driver/Oracle.pm > create mode 100644 lib/Data/Session/Driver/Pg.pm > create mode 100644 lib/Data/Session/Driver/SQLite.pm > create mode 100644 lib/Data/Session/Driver/mysql.pm > create mode 100644 lib/Data/Session/ID.pm > create mode 100644 lib/Data/Session/ID/AutoIncrement.pm > create mode 100644 lib/Data/Session/ID/MD5.pm > create mode 100644 lib/Data/Session/ID/SHA1.pm > create mode 100644 lib/Data/Session/ID/SHA256.pm > create mode 100644 lib/Data/Session/ID/SHA512.pm > create mode 100644 lib/Data/Session/ID/Static.pm > create mode 100644 lib/Data/Session/ID/UUID16.pm > create mode 100644 lib/Data/Session/ID/UUID34.pm > create mode 100644 lib/Data/Session/ID/UUID36.pm > create mode 100644 lib/Data/Session/ID/UUID64.pm > create mode 100644 lib/Data/Session/SHA.pm > create mode 100644 lib/Data/Session/Serialize/DataDumper.pm > create mode 100644 lib/Data/Session/Serialize/FreezeThaw.pm > create mode 100644 lib/Data/Session/Serialize/JSON.pm > create mode 100644 lib/Data/Session/Serialize/Storable.pm > create mode 100644 lib/Data/Session/Serialize/YAML.pm > >diff --git a/lib/Data/Session.pm b/lib/Data/Session.pm >new file mode 100644 >index 00000000000..0035c692b49 >--- /dev/null >+++ b/lib/Data/Session.pm >@@ -0,0 +1,2672 @@ >+package Data::Session; >+ >+use parent 'Data::Session::Base'; >+no autovivification; >+use strict; >+use warnings; >+ >+use Class::Load ':all'; # For try_load_class() and is_class_loaded(). >+ >+use File::Spec; # For catdir. >+use File::Slurper 'read_dir'; >+ >+use Hash::FieldHash ':all'; >+ >+use Try::Tiny; >+ >+fieldhash my %my_drivers => 'my_drivers'; >+fieldhash my %my_id_generators => 'my_id_generators'; >+fieldhash my %my_serializers => 'my_serializers'; >+ >+our $errstr = ''; >+our $VERSION = '1.18'; >+ >+# ----------------------------------------------- >+ >+sub atime >+{ >+ my($self, $atime) = @_; >+ my($data) = $self -> session; >+ >+ # This is really only for use by load_session(). >+ >+ if (defined $atime) >+ { >+ $$data{_SESSION_ATIME} = $atime; >+ >+ $self -> session($data); >+ $self -> modified(1); >+ } >+ >+ return $$data{_SESSION_ATIME}; >+ >+} # End of atime. >+ >+# ----------------------------------------------- >+ >+sub check_expiry >+{ >+ my($self) = @_; >+ >+ if ($self -> etime && ( ($self -> atime + $self -> etime) < time) ) >+ { >+ ($self -> verbose) && $self -> log('Expiring id: ' . $self -> id); >+ >+ $self -> delete; >+ $self -> expired(1); >+ } >+ >+} # End of check_expiry. >+ >+# ----------------------------------------------- >+ >+sub clear >+{ >+ my($self, $name) = @_; >+ my($data) = $self -> session; >+ >+ if (! $name) >+ { >+ $name = [$self -> param]; >+ } >+ elsif (ref($name) ne 'ARRAY') >+ { >+ $name = [$name]; >+ } >+ else >+ { >+ $name = [grep{! /^_/} @$name]; >+ } >+ >+ for my $key (@$name) >+ { >+ delete $$data{$key}; >+ delete $$data{_SESSION_PTIME}{$key}; >+ >+ $self -> modified(1); >+ } >+ >+ $self -> session($data); >+ >+ return 1; >+ >+} # End of clear. >+ >+# ----------------------------------------------- >+ >+sub cookie >+{ >+ my($self) = shift; >+ my($q) = $self -> query; >+ my(@param) = ('-name' => $self -> name, '-value' => $self -> id, @_); >+ my($cookie) = ''; >+ >+ if (! $q -> can('cookie') ) >+ { >+ } >+ elsif ($self -> expired) >+ { >+ $cookie = $q -> cookie(@param, -expires => '-1d'); >+ } >+ elsif (my($t) = $self -> expire) >+ { >+ $cookie = $q -> cookie(@param, -expires => "+${t}s"); >+ } >+ else >+ { >+ $cookie = $q -> cookie(@param); >+ } >+ >+ return $cookie; >+ >+} # End of cookie. >+ >+# ----------------------------------------------- >+ >+sub ctime >+{ >+ my($self) = @_; >+ my($data) = $self -> session; >+ >+ return $$data{_SESSION_CTIME}; >+ >+} # End of ctime. >+ >+# ----------------------------------------------- >+ >+sub delete >+{ >+ my($self) = @_; >+ my($result) = $self -> driver_class -> remove($self -> id); >+ >+ $self -> clear; >+ $self -> deleted(1); >+ >+ return $result; >+ >+} # End of delete. >+ >+# ----------------------------------------------- >+ >+sub DESTROY >+{ >+ my($self) = @_; >+ >+ $self -> flush; >+ >+} # End of DESTROY. >+ >+# ----------------------------------------------- >+ >+sub dump >+{ >+ my($self, $heading) = @_; >+ my($data) = $self -> session; >+ >+ ($heading) && $self -> log($heading); >+ >+ for my $key (sort keys %$data) >+ { >+ if (ref($$data{$key}) eq 'HASH') >+ { >+ $self -> log("$key: " . join(', ', map{"$_: $$data{$key}{$_}"} sort keys %{$$data{$key} }) ); >+ } >+ else >+ { >+ $self -> log("$key: $$data{$key}"); >+ } >+ } >+ >+} # End of dump. >+ >+# ----------------------------------------------- >+ >+sub etime >+{ >+ my($self) = @_; >+ my($data) = $self -> session; >+ >+ return $$data{_SESSION_ETIME}; >+ >+} # End of etime. >+ >+# ----------------------------------------------- >+ >+sub expire >+{ >+ my($self, @arg) = @_; >+ >+ if (! @arg) >+ { >+ return $self -> etime; >+ } >+ >+ if ($#arg == 0) >+ { >+ # Set the expiry time of the session. >+ >+ my($data) = $self -> session; >+ my($time) = $self -> validate_time($arg[0]); >+ >+ if ($$data{_SESSION_ETIME} != $time) >+ { >+ $$data{_SESSION_ETIME} = $time; >+ >+ $self -> session($data); >+ $self -> modified(1); >+ } >+ } >+ else >+ { >+ # Set the expiry times of session parameters. >+ >+ my($data) = $self -> session; >+ my($modified) = 0; >+ my(%arg) = @arg; >+ >+ my($time); >+ >+ # Warning: The next line ignores 'each %{@arg}'. >+ >+ while (my($key, $value) = each %arg) >+ { >+ $time = $self -> validate_time($value); >+ >+ ($time == 0) && next; >+ >+ if (! $$data{_SESSION_PTIME}{$key} || ($$data{_SESSION_PTIME}{$key} ne $time) ) >+ { >+ $$data{_SESSION_PTIME}{$key} = $time; >+ >+ $modified = 1; >+ } >+ } >+ >+ if ($modified) >+ { >+ $self -> session($data); >+ $self -> modified(1); >+ } >+ } >+ >+ return 1; >+ >+} # End of expire. >+ >+# ----------------------------------------------- >+ >+sub flush >+{ >+ my($self) = @_; >+ >+ if ($self -> modified && ! $self -> deleted) >+ { >+ $self -> driver_class -> store >+ ( >+ $self -> id, >+ $self -> serializer_class -> freeze($self -> session), >+ $self -> etime >+ ); >+ } >+ >+ ($self -> verbose > 1) && $self -> dump('Flushing. New: ' . $self -> is_new . '. Modified: ' . $self -> modified . '. Deleted: ' . $self -> deleted); >+ >+ return 1; >+ >+} # End of flush. >+ >+# ----------------------------------------------- >+ >+sub get_my_drivers >+{ >+ my($self) = @_; >+ my($path) = $self -> _get_pm_path('Driver'); >+ >+ # Warning: Use sort map{} read_dir, not map{} sort read_dir. But, why? >+ >+ my(@driver) = sort map{s/.pm//; $_} read_dir($path); >+ >+ ($#driver < 0) && die __PACKAGE__ . '. No drivers available'; >+ >+ ($self -> verbose > 1) && $self -> log('Drivers: ' . join(', ', @driver) ); >+ >+ $self -> my_drivers(\@driver); >+ >+} # End of get_my_drivers. >+ >+# ----------------------------------------------- >+ >+sub get_my_id_generators >+{ >+ my($self) = @_; >+ my($path) = $self -> _get_pm_path('ID'); >+ >+ # Warning: Use sort map{} read_dir, not map{} sort read_dir. But, why? >+ >+ my(@id_generator) = sort map{s/.pm//; $_} read_dir($path); >+ >+ ($#id_generator < 0) && die __PACKAGE__ . '. No id generators available'; >+ >+ ($self -> verbose > 1) && $self -> log('Id generators: ' . join(', ', @id_generator) ); >+ >+ $self -> my_id_generators(\@id_generator); >+ >+} # End of get_my_id_generators. >+ >+# ----------------------------------------------- >+ >+sub get_my_serializers >+{ >+ my($self) = @_; >+ my($path) = $self -> _get_pm_path('Serialize'); >+ >+ # Warning: Use sort map{} read_dir, not map{} sort read_dir. But, why? >+ >+ my(@serializer) = sort map{s/.pm//; $_} read_dir($path); >+ >+ ($#serializer < 0) && die __PACKAGE__ . '. No serializers available'; >+ >+ ($self -> verbose > 1) && $self -> log('Serializers: ' . join(', ', @serializer) ); >+ >+ $self -> my_serializers(\@serializer); >+ >+} # End of get_my_serializers. >+ >+# ----------------------------------------------- >+ >+sub _get_pm_path >+{ >+ my($self, $subdir) = @_; >+ my($path) = $INC{'Data/Session.pm'}; >+ $path =~ s/\.pm$//; >+ >+ return File::Spec -> catdir($path, $subdir); >+} >+ >+# ----------------------------------------------- >+ >+sub http_header >+{ >+ my($self) = shift; >+ my($cookie) = $self -> cookie; >+ >+ my($header); >+ >+ if ($cookie) >+ { >+ $header = $self -> query -> header(-cookie => $cookie, @_); >+ } >+ else >+ { >+ $header = $self -> query -> header(@_); >+ } >+ >+ return $header; >+ >+} # End of http_header. >+ >+# ----------------------------------------------- >+ >+sub load_driver >+{ >+ my($self, $arg) = @_; >+ my($class) = join('::', __PACKAGE__, 'Driver', $self -> driver_option); >+ >+ try_load_class($class); >+ >+ die __PACKAGE__ . ". Unable to load class '$class'" if (! is_class_loaded($class) ); >+ >+ ($self -> verbose > 1) && $self -> log("Loaded driver_option: $class"); >+ >+ $self -> driver_class($class -> new(%$arg) ); >+ >+ ($self -> verbose > 1) && $self -> log("Initialized driver_class: $class"); >+ >+} # End of load_driver. >+ >+# ----------------------------------------------- >+ >+sub load_id_generator >+{ >+ my($self, $arg) = @_; >+ my($class) = join('::', __PACKAGE__, 'ID', $self -> id_option); >+ >+ try_load_class($class); >+ >+ die __PACKAGE__ . ". Unable to load class '$class'" if (! is_class_loaded($class) ); >+ >+ ($self -> verbose > 1) && $self -> log("Loaded id_option: $class"); >+ >+ $self -> id_class($class -> new(%$arg) ); >+ >+ ($self -> verbose > 1) && $self -> log("Initialized id_class: $class"); >+ >+} # End of load_id_generator. >+ >+# ----------------------------------------------- >+ >+sub load_param >+{ >+ my($self, $q, $name) = @_; >+ >+ if (! defined $q) >+ { >+ $q = $self -> load_query_class; >+ } >+ >+ my($data) = $self -> session; >+ >+ if (! $name) >+ { >+ $name = [sort keys %$data]; >+ } >+ elsif (ref($name) ne 'ARRAY') >+ { >+ $name = [$name]; >+ } >+ >+ for my $key (grep{! /^_/} @$name) >+ { >+ $q -> param($key => $$data{$key}); >+ } >+ >+ return $q; >+ >+} # End of load_param. >+ >+# ----------------------------------------------- >+ >+sub load_query_class >+{ >+ my($self) = @_; >+ >+ if (! $self -> query) >+ { >+ my($class) = $self -> query_class; >+ >+ try_load_class($class); >+ >+ die __PACKAGE__ . ". Unable to load class '$class'" if (! is_class_loaded($class) ); >+ >+ ($self -> verbose > 1) && $self -> log('Loaded query_class: ' . $class); >+ >+ $self -> query($class -> new); >+ >+ ($self -> verbose > 1) && $self -> log('Called query_class -> new: ' . $class); >+ } >+ >+ return $self -> query; >+ >+} # End of load_query_class. >+ >+# ----------------------------------------------- >+ >+sub load_serializer >+{ >+ my($self, $arg) = @_; >+ my($class) = join('::', __PACKAGE__, 'Serialize', $self -> serializer_option); >+ >+ try_load_class($class); >+ >+ die __PACKAGE__ . ". Unable to load class '$class'" if (! is_class_loaded($class) ); >+ >+ ($self -> verbose > 1) && $self -> log("Loaded serializer_option: $class"); >+ >+ $self -> serializer_class($class -> new(%$arg) ); >+ >+ ($self -> verbose > 1) && $self -> log("Initialized serializer_class: $class"); >+ >+} # End of load_serializer. >+ >+# ----------------------------------------------- >+ >+sub load_session >+{ >+ my($self) = @_; >+ my($id) = $self -> user_id; >+ >+ ($self -> verbose > 1) && $self -> log("Loading session for id: $id"); >+ >+ if ($id) >+ { >+ my($raw_data) = $self -> driver_class -> retrieve($id); >+ >+ ($self -> verbose > 1) && $self -> log("Tried to retrieve session for id: $id. Length of raw data: @{[length($raw_data)]}"); >+ >+ if (! $raw_data) >+ { >+ $self -> new_session($id); >+ } >+ else >+ { >+ # Retrieved an old session, so flag it as accessed, and not-new. >+ >+ my($data) = $self -> serializer_class -> thaw($raw_data); >+ >+ if ($self -> verbose > 1) >+ { >+ for my $key (sort keys %{$$data{_SESSION_PTIME} }) >+ { >+ $self -> log("Recovered session parameter expiry time: $key: $$data{_SESSION_PTIME}{$key}"); >+ } >+ } >+ >+ $self -> id($id); >+ $self -> is_new(0); >+ $self -> session($data); >+ >+ ($self -> verbose > 1) && $self -> dump('Loaded'); >+ >+ # Check for session expiry. >+ >+ $self -> check_expiry; >+ >+ ($self -> verbose > 1) && $self -> dump('Loaded and checked expiry'); >+ >+ # Check for session parameter expiry. >+ # Stockpile keys to be cleared. We can't call $self -> clear($key) inside the loop, >+ # because it updates $$data{_SESSION_PTIME}, which in turns confuses 'each'. >+ >+ my(@stack); >+ >+ while (my($key, $time) = each %{$$data{_SESSION_PTIME} }) >+ { >+ if ($time && ( ($self -> atime + $time) < time) ) >+ { >+ push @stack, $key; >+ } >+ } >+ >+ $self -> clear($_) for @stack; >+ >+ # We can't do this above, just after my($data)..., since it's used just above, as $self -> atime(). >+ >+ $self -> atime(time); >+ >+ ($self -> verbose > 1) && $self -> dump('Loaded and checked parameter expiry'); >+ } >+ } >+ else >+ { >+ $self -> new_session(0); >+ } >+ >+ ($self -> verbose > 1) && $self -> log("Loaded session for id: " . $self -> id); >+ >+ return 1; >+ >+} # End of load_session. >+ >+# ----------------------------------------------- >+ >+sub new >+{ >+ my($class, %arg) = @_; >+ $arg{debug} ||= 0; # new(...). >+ $arg{deleted} = 0; # Internal. >+ $arg{expired} = 0; # Internal. >+ $arg{id} ||= 0; # new(...). >+ $arg{modified} = 0; # Internal. >+ $arg{name} ||= 'CGISESSID'; # new(...). >+ $arg{query} ||= ''; # new(...). >+ $arg{query_class} ||= 'CGI'; # new(...). >+ $arg{session} = {}; # Internal. >+ $arg{type} ||= ''; # new(...). >+ $arg{verbose} ||= 0; # new(...). >+ >+ my($self); >+ >+ try >+ { >+ $self = from_hash(bless({}, $class), \%arg); >+ >+ $self -> get_my_drivers; >+ $self -> get_my_id_generators; >+ $self -> get_my_serializers; >+ $self -> parse_options; >+ $self -> validate_options; >+ $self -> load_driver(\%arg); >+ $self -> load_id_generator(\%arg); >+ $self -> load_serializer(\%arg); >+ $self -> load_session; # Calls user_id() which calls load_query_class() if necessary. >+ } >+ catch >+ { >+ $errstr = $_; >+ $self = undef; >+ }; >+ >+ return $self; >+ >+} # End of new. >+ >+# ----------------------------------------------- >+ >+sub new_session >+{ >+ my($self, $id) = @_; >+ $id = $id ? $id : $self -> id_class -> generate; >+ my($time) = time; >+ >+ $self -> session >+ ({ >+ _SESSION_ATIME => $time, # Access time. >+ _SESSION_CTIME => $time, # Create time. >+ _SESSION_ETIME => 0, # Session expiry time. >+ _SESSION_ID => $id, # Session id. >+ _SESSION_PTIME => {}, # Parameter expiry times. >+ }); >+ >+ $self -> id($id); >+ $self -> is_new(1); >+ >+} # End of new_session. >+ >+# ----------------------------------------------- >+ >+sub param >+{ >+ my($self, @arg) = @_; >+ my($data) = $self -> session; >+ >+ if ($#arg < 0) >+ { >+ return grep{! /^_/} sort keys %$data; >+ } >+ elsif ($#arg == 0) >+ { >+ # If only 1 name is supplied, return the session's data for that name. >+ >+ return $$data{$arg[0]}; >+ } >+ >+ # Otherwise, loop over all the supplied data. >+ >+ my(%arg) = @arg; >+ >+ for my $key (keys %arg) >+ { >+ next if ($key =~ /^_/); >+ >+ # Don't update a value if it's the same as the original value. >+ # That way we don't update the last-access-time. >+ # We're effectively testing $x == $y, but we're not testing to ensure: >+ # o undef == undef >+ # o 0 == 0 >+ # o '' == '' >+ # So changing undef to 0 or visa versa, etc, will all be ignored. >+ >+ (! $$data{$key} && ! $arg{$key}) && next; >+ >+ if ( (! $$data{$key} && $arg{$key}) || ($$data{$key} && ! $arg{$key}) || ($$data{$key} ne $arg{$key}) ) >+ { >+ $$data{$key} = $arg{$key}; >+ >+ $self -> modified(1); >+ } >+ } >+ >+ $self -> session($data); >+ >+ return 1; >+ >+} # End of param. >+ >+# ----------------------------------------------- >+# Format expected: new(type => 'driver:File;id:MD5;serialize:DataDumper'). >+ >+sub parse_options >+{ >+ my($self) = @_; >+ my($options) = $self -> type || ''; >+ >+ ($self -> verbose > 1) && $self -> log("Parsing type '$options'"); >+ >+ $options =~ tr/ //d; >+ my(%options) = map{split(/:/, $_)} split(/;/, lc $options); # lc! >+ my(%default) = >+ ( >+ driver => 'File', >+ id => 'MD5', >+ serialize => 'DataDumper', >+ ); >+ >+ for my $key (keys %options) >+ { >+ (! $default{$key}) && die __PACKAGE__ . ". Error in type: Unexpected component '$key'"; >+ } >+ >+ my(%driver) = map{(lc $_ => $_)} @{$self -> my_drivers}; >+ my(%id_generator) = map{(lc $_ => $_)} @{$self -> my_id_generators}; >+ my(%serializer) = map{(lc $_ => $_)} @{$self -> my_serializers}; >+ >+ # The sort is just to make the warnings ($required) appear in alphabetical order. >+ >+ for my $required (sort keys %default) >+ { >+ # Set default if user does not supply the key:value pair. >+ >+ if (! exists $options{$required}) >+ { >+ $options{$required} = $default{$required}; >+ >+ ($self -> verbose) && $self -> log("Warning for type: Defaulting '$required' to '$default{$required}'"); >+ } >+ >+ # Ensure the value is set. >+ >+ (! $options{$required}) && die __PACKAGE__ . ". Error in type: Missing value for option '$required'"; >+ >+ # Ensure the case of the value is correct. >+ >+ if ($required eq 'driver') >+ { >+ if ($driver{lc $options{$required} }) >+ { >+ $options{$required} = $driver{lc $options{$required} }; >+ } >+ else >+ { >+ die __PACKAGE__ . ". Unknown driver '$options{$required}'"; >+ } >+ } >+ elsif ($required eq 'id') >+ { >+ if ($id_generator{lc $options{$required} }) >+ { >+ $options{$required} = $id_generator{lc $options{$required} }; >+ } >+ else >+ { >+ die __PACKAGE__ . ". Unknown id generator '$options{$required}'"; >+ } >+ } >+ elsif ($required eq 'serialize') >+ { >+ if ($serializer{lc $options{$required} }) >+ { >+ $options{$required} = $serializer{lc $options{$required} }; >+ } >+ else >+ { >+ die __PACKAGE__ . ". Unknown serialize '$options{$required}'"; >+ } >+ } >+ } >+ >+ $self -> driver_option($options{driver}); >+ $self -> id_option($options{id}); >+ $self -> serializer_option($options{serialize}); >+ $self -> type(join(';', map{"$_:$options{$_}"} sort keys %default)); >+ >+ if ($self -> verbose > 1) >+ { >+ $self -> log('type: ' . $self -> type); >+ $self -> log('driver_option: ' . $self -> driver_option); >+ $self -> log('id_option: ' . $self -> id_option); >+ $self -> log('serializer_option: ' . $self -> serializer_option); >+ } >+ >+} # End of parse_options. >+ >+# ----------------------------------------------- >+# Warning: Returns a hashref. >+ >+sub ptime >+{ >+ my($self) = @_; >+ my($data) = $self -> session; >+ >+ return $$data{_SESSION_PTIME}; >+ >+} # End of ptime. >+ >+# ----------------------------------------------- >+ >+sub save_param >+{ >+ my($self, $q, $name) = @_; >+ >+ if (! defined $q) >+ { >+ $q = $self -> load_query_class; >+ } >+ >+ my($data) = $self -> session; >+ >+ if (! $name) >+ { >+ $name = [$q -> param]; >+ } >+ elsif (ref($name) ne 'ARRAY') >+ { >+ $name = [grep{! /^_/} $name]; >+ } >+ else >+ { >+ $name = [grep{! /^_/} @$name]; >+ } >+ >+ for my $key (@$name) >+ { >+ $$data{$key} = $q -> param($key); >+ >+ $self -> modified(1); >+ } >+ >+ $self -> session($data); >+ >+ return 1; >+ >+} # End of save_param. >+ >+# ----------------------------------------------- >+ >+sub traverse >+{ >+ my($self, $sub) = @_; >+ >+ return $self -> driver_class -> traverse($sub); >+ >+} # End of traverse. >+ >+# ----------------------------------------------- >+ >+sub user_id >+{ >+ my($self) = @_; >+ >+ # Sources of id: >+ # o User supplied one in $session -> new(id => $id). >+ # o User didn't, so we try $self -> query -> cookie and/or $self -> query -> param. >+ >+ my($id) = $self -> id; >+ >+ if (! $id) >+ { >+ $self -> load_query_class; >+ >+ my($name) = $self -> name; >+ my($q) = $self -> query; >+ >+ if ($q -> can('cookie') ) >+ { >+ $id = $q -> cookie($name) || $q -> param($name); >+ >+ ($self -> verbose > 1) && $self -> log('query can cookie(). id from cookie or param: ' . ($id || '') ); >+ } >+ else >+ { >+ $id = $q -> param($name); >+ >+ ($self -> verbose > 1) && $self -> log("query can't cookie(). id from param: " . ($id || '') ); >+ } >+ >+ if (! $id) >+ { >+ $id = 0; >+ } >+ } >+ >+ return $id; >+ >+} # End of user_id. >+ >+# ----------------------------------------------- >+ >+sub validate_options >+{ >+ my($self) = @_; >+ >+ if ( ($self -> id_option eq 'Static') && ! $self -> id) >+ { >+ die __PACKAGE__ . '. When using id:Static, you must provide a (true) id to new(id => ...)'; >+ } >+ >+} # End of validate_options. >+ >+# ----------------------------------------------- >+ >+sub validate_time >+{ >+ my($self, $time) = @_; >+ >+ (! $time) && return 0; >+ >+ $time = "${time}s" if ($time =~ /\d$/); >+ >+ ($time !~ /^([-+]?\d+)([smhdwMy])$/) && die __PACKAGE__ . ". Can't parse time: $time"; >+ >+ my(%scale) = >+ ( >+ s => 1, >+ m => 60, >+ h => 3600, >+ d => 86400, >+ w => 604800, >+ M => 2592000, >+ y => 31536000, >+ ); >+ >+ return $scale{$2} * $1; >+ >+} # End of validate_time. >+ >+# ----------------------------------------------- >+ >+1; >+ >+=pod >+ >+=head1 NAME >+ >+Data::Session - Persistent session data management >+ >+=head1 Synopsis >+ >+1: A self-contained CGI script (scripts/cgi.demo.cgi): >+ >+ #!/usr/bin/perl >+ >+ use CGI; >+ >+ use Data::Session; >+ >+ use File::Spec; >+ >+ # ---------------------------------------------- >+ >+ sub generate_html >+ { >+ my($name, $id, $count) = @_; >+ $id ||= ''; >+ my($title) = "CGI demo for Data::Session"; >+ return <<EOS; >+ <html> >+ <head><title>$title</title></head> >+ <body> >+ Number of times this script has been run: $count.<br/> >+ Current value of $name: $id.<br/> >+ <form id='sample' method='post' name='sample'> >+ <button id='submit'>Click to submit</button> >+ <input type='hidden' name='$name' id='$name' value='$id' /> >+ </form> >+ </body> >+ </html> >+ EOS >+ >+ } # End of generate_html. >+ >+ # ---------------------------------------------- >+ >+ my($q) = CGI -> new; >+ my($name) = 'sid'; # CGI form field name. >+ my($sid) = $q -> param($name); >+ my($dir_name) = '/tmp'; >+ my($type) = 'driver:File;id:MD5;serialize:JSON'; >+ my($session) = Data::Session -> new >+ ( >+ directory => $dir_name, >+ name => $name, >+ query => $q, >+ type => $type, >+ ); >+ my($id) = $session -> id; >+ >+ # First entry ever? >+ >+ my($count); >+ >+ if ($sid) # Not $id, which always has a value... >+ { >+ # No. The CGI form field called sid has a (true) value. >+ # So, this is the code for the second and subsequent entries. >+ # Count the # of times this CGI script has been run. >+ >+ $count = $session -> param('count') + 1; >+ } >+ else >+ { >+ # Yes. There is no CGI form field called sid (with a true value). >+ # So, this is the code for the first entry ever. >+ # Count the # of times this CGI script has been run. >+ >+ $count = 0; >+ } >+ >+ $session -> param(count => $count); >+ >+ print $q -> header, generate_html($name, $id, $count); >+ >+ # Calling flush() is good practice, rather than hoping 'things just work'. >+ # In a persistent environment, this call is mandatory... >+ # But you knew that, because you'd read the docs, right? >+ >+ $session -> flush; >+ >+2: A basic session. See scripts/sqlite.pl: >+ >+ # The EXLOCK is for BSD-based systems. >+ my($directory) = File::Temp::newdir('temp.XXXX', CLEANUP => 1, EXLOCK => 0, TMPDIR => 1); >+ my($data_source) = 'dbi:SQLite:dbname=' . File::Spec -> catdir($directory, 'sessions.sqlite'); >+ my($type) = 'driver:SQLite;id:SHA1;serialize:DataDumper'; # Case-sensitive. >+ my($session) = Data::Session -> new >+ ( >+ data_source => $data_source, >+ type => $type, >+ ) || die $Data::Session::errstr; >+ >+3: Using BerkeleyDB as a cache manager. See scripts/berkeleydb.pl: >+ >+ # The EXLOCK is for BSD-based systems. >+ my($file_name) = File::Temp -> new(EXLOCK => 0, SUFFIX => '.bdb'); >+ my($env) = BerkeleyDB::Env -> new >+ ( >+ Home => File::Spec -> tmpdir, >+ Flags => DB_CREATE | DB_INIT_CDB | DB_INIT_MPOOL, >+ ); >+ if (! $env) >+ { >+ print "BerkeleyDB is not responding. \n"; >+ exit; >+ } >+ my($bdb) = BerkeleyDB::Hash -> new(Env => $env, Filename => $file_name, Flags => DB_CREATE); >+ if (! $bdb) >+ { >+ print "BerkeleyDB is not responding. \n"; >+ exit; >+ } >+ my($type) = 'driver:BerkeleyDB;id:SHA1;serialize:DataDumper'; # Case-sensitive. >+ my($session) = Data::Session -> new >+ ( >+ cache => $bdb, >+ type => $type, >+ ) || die $Data::Session::errstr; >+ >+4: Using memcached as a cache manager. See scripts/memcached.pl: >+ >+ my($memd) = Cache::Memcached -> new >+ ({ >+ namespace => 'data.session.id', >+ servers => ['127.0.0.1:11211'], >+ }); >+ my($test) = $memd -> set(time => time); >+ if (! $test || ($test != 1) ) >+ { >+ print "memcached is not responding. \n"; >+ exit; >+ } >+ $memd -> delete('time'); >+ my($type) = 'driver:Memcached;id:SHA1;serialize:DataDumper'; # Case-sensitive. >+ my($session) = Data::Session -> new >+ ( >+ cache => $memd, >+ type => $type, >+ ) || die $Data::Session::errstr; >+ >+5: Using a file to hold the ids. See scripts/file.autoincrement.pl: >+ >+ # The EXLOCK is for BSD-based systems. >+ my($directory) = File::Temp::newdir('temp.XXXX', CLEANUP => 1, EXLOCK => 0, TMPDIR => 1); >+ my($file_name) = 'autoinc.session.dat'; >+ my($id_file) = File::Spec -> catfile($directory, $file_name); >+ my($type) = 'driver:File;id:AutoIncrement;serialize:DataDumper'; # Case-sensitive. >+ my($session) = Data::Session -> new >+ ( >+ id_base => 99, >+ id_file => $id_file, >+ id_step => 2, >+ type => $type, >+ ) || die $Data::Session::errstr; >+ >+6: Using a file to hold the ids. See scripts/file.sha1.pl (non-CGI context): >+ >+ my($directory) = '/tmp'; >+ my($file_name) = 'session.%s.dat'; >+ my($type) = 'driver:File;id:SHA1;serialize:DataDumper'; # Case-sensitive. >+ >+ # Create the session: >+ my($session) = Data::Session -> new >+ ( >+ directory => $directory, >+ file_name => $file_name, >+ type => $type, >+ ) || die $Data::Session::errstr; >+ >+ # Time passes... >+ >+ # Retrieve the session: >+ my($id) = $session -> id; >+ my($session) = Data::Session -> new >+ ( >+ directory => $directory, >+ file_name => $file_name, >+ id => $id, # <== Look! You must supply the id for retrieval. >+ type => $type, >+ ) || die $Data::Session::errstr; >+ >+7: As a variation on the above, see scripts/cgi.sha1.pl (CGI context but command line program): >+ >+ # As above (scripts/file.sha1.pl), for creating the session. Then... >+ >+ # Retrieve the session: >+ my($q) = CGI -> new; # CGI form data provides the id. >+ my($session) = Data::Session -> new >+ ( >+ directory => $directory, >+ file_name => $file_name, >+ query => $q, # <== Look! You must supply the id for retrieval. >+ type => $type, >+ ) || die $Data::Session::errstr; >+ >+Also, much can be gleaned from t/basic.t and t/Test.pm. See L</Test Code>. >+ >+=head1 Description >+ >+L<Data::Session> is typically used by a CGI script to preserve state data between runs of the >+script. This gives the end user the illusion that the script never exits. >+ >+It can also be used to communicate between 2 scripts, as long as they agree beforehand what session >+id to use. >+ >+See L<Data::Session::CGISession> for an extended discussion of the design changes between >+L<Data::Session> and L<CGI::Session>. >+ >+L<Data::Session> stores user data internally in a hashref, and the module reserves key names >+starting with '_'. >+ >+The current list of reserved keys is documented under L</flush()>. >+ >+Of course, the module also has a whole set of methods to help manage state. >+ >+=head1 Methods >+ >+=head2 new() >+ >+Calling new() returns a object of type L<Data::Session>, or - if new() fails - it returns undef. >+For details see L</Trouble with Errors>. >+ >+new() takes a hash of key/value pairs, some of which might mandatory. Further, some combinations >+might be mandatory. >+ >+The keys are listed here in alphabetical order. >+ >+They are lower-case because they are (also) method names, meaning they can be called to set or get >+the value at any time. >+ >+But a warning: In some cases, setting them after this module has used the previous value, will have >+no effect. All such cases should be documented. >+ >+Beginners understandably confused by the quantity of options should consult the L</Synopsis> for >+example code. >+ >+The questions of combinations of options, and which option has priority over other options, >+are addressed in the section, L</Combinations of Options>. >+ >+=over 4 >+ >+=item o cache => $cache >+ >+Specifies an object of type L<BerkeleyDB> or L<Cache::Memcached> to use for storage. >+ >+Only needed if you use 'type' like 'driver:BerkeleyDB ...' or 'driver:Memcached ...'. >+ >+See L<Data::Session::Driver::BerkeleyDB> and L<Data::Session::Driver::Memcached>. >+ >+Default: '' (the empty string). >+ >+=item o data_col_name => $string >+ >+Specifies the name of the column holding the session data, in the session table. >+ >+This key is optional. >+ >+Default: 'a_session'. >+ >+=item o data_source => $string >+ >+Specifies a value to use as the 1st parameter in the call to L<DBI>'s connect() method. >+ >+A typical value would be 'dbi:Pg:dbname=project'. >+ >+This key is optional. It is only used if you do not supply a value for the 'dbh' key. >+ >+Default: '' (the empty string). >+ >+=item o data_source_attrs => $hashref >+ >+Specify a hashref of options to use as the last parameter in the call to L<DBI>'s connect() method. >+ >+This key is optional. It is only used if you do not supply a value for the 'dbh' key. >+ >+Default: {AutoCommit => 1, PrintError => 0, RaiseError => 1}. >+ >+=item o dbh => $dbh >+ >+Specifies a database handle to use to access the session table. >+ >+This key is optional. >+ >+However, if not specified, you must specify a value for 'data_source', and perhaps also 'username' >+and 'password', so that this module can create a database handle. >+ >+If this module does create a database handle, it will also destroy it, whereas if you supply a database >+handle, you are responsible for destroying it. >+ >+=item o debug => $Boolean >+ >+Specifies that debugging should be turned on (1) or off (0) in L<Data::Session::File::Driver> and >+L<Data::Session::ID::AutoIncrement>. >+ >+When debug is 1, $! is included in error messages, but because this reveals directory names, it is >+0 by default. >+ >+This key is optional. >+ >+Default: 0. >+ >+=item o directory => $string >+ >+Specifies the directory in which session files are stored, when each session is stored in a separate >+file (by using 'driver:File ...' as the first component of the 'type'). >+ >+This key is optional. >+ >+Default: Your temp directory as determined by L<File::Spec>. >+ >+See L</Specifying Session Options> for details. >+ >+=item o file_name => $string_containing_%s >+ >+Specifies the syntax for the names of session files, when each session is stored in a separate file >+(by using 'driver:File ...' as the first component of the 'type'). >+ >+This key is optional. >+ >+Default: 'cgisess_%s', where the %s is replaced at run-time by the session id. >+ >+The directory in which these files are stored is specified by the 'directory' option above. >+ >+See L</Specifying Session Options> for details. >+ >+=item o host => $string >+ >+Specifies a host, typically for use with a data_source referring to MySQL. >+ >+This key is optional. >+ >+Default: '' (the empty string). >+ >+=item o id => $string >+ >+Specifies an id to retrieve from storage. >+ >+This key is optional. >+ >+Default: 0. >+ >+Note: If you do not provide an id here, the module calls L</user_id()> to determine whether or not >+an id is available from a cookie or a form field. >+ >+This complex topic is discussed in the section L<Specifying an Id>. >+ >+=item o id_col_name => $string >+ >+Specifies the name of the column holding the session id, in the session table. >+ >+This key is optional. >+ >+Default: 'id'. >+ >+=item o id_base => $integer >+ >+Specifies the base from which to start ids when using the '... id:AutoIncrement ...' component in >+the 'type'. >+ >+Note: The first id returned by L<Data::Session::ID::AutoIncrement> will be id_base + id_step. >+So, if id_base is 1000 and id_step is 10, then the lowest id will be 1010. >+ >+This key is optional. >+ >+Default: 0. >+ >+=item o id_file => $file_path_and_name >+ >+Specifies the file path and name in which to store the last used id, as calculated from C<id_base + >+id_step>, when using the '... id:AutoIncrement ...' component in the 'type'. >+ >+This value must contain a path because the 'directory' option above is only used for session files >+(when using L<Data::Session::Driver::File>). >+ >+This key is optional. >+ >+Default: File::Spec -> catdir(File::Spec -> tmpdir, 'data.session.id'). >+ >+=item o id_step => $integer >+ >+Specifies the step size between ids when using the '... id:AutoIncrement ...' component of the >+'type'. >+ >+This key is optional. >+ >+Default: 1. >+ >+=item o name => $string >+ >+Specifies the name of the cookie or form field which holds the session id. >+ >+This key is optional. >+ >+Default: 'CGISESSID'. >+ >+Usage of 'name' is discussed in the sections L</Specifying an Id> and L</user_id()>. >+ >+=item o no_flock => $boolean >+ >+Specifies (no_flock => 1) to not use flock() to obtain a lock on a session file before processing >+it, or (no_flock => 0) to use flock(). >+ >+This key is optional. >+ >+Default: 0. >+ >+This value is used in these cases: >+ >+=over 4 >+ >+=item o type => 'driver:File ...' >+ >+=item o type => '... id:AutoIncrement ...' >+ >+=back >+ >+=item o no_follow => $boolean >+ >+Influences the mode to use when calling sysopen() on session files. >+ >+'Influences' means the value is bit-wise ored with O_RDWR for reading and with O_WRONLY for writing. >+ >+This key is optional. >+ >+Default: eval { O_NOFOLLOW } || 0. >+ >+This value is used in this case: >+ >+=over 4 >+ >+=item o type => 'driver:File ...' >+ >+=back >+ >+=item o password => $string >+ >+Specifies a value to use as the 3rd parameter in the call to L<DBI>'s connect() method. >+ >+This key is optional. It is only used if you do not supply a value for the 'dbh' key. >+ >+Default: '' (the empty string). >+ >+=item o pg_bytea => $boolean >+ >+Specifies that you're using a Postgres-specific column type of 'bytea' to hold the session data, >+in the session table. >+ >+This key is optional, but see the section, L</Combinations of Options> for how it interacts with >+the pg_text key. >+ >+Default: 0. >+ >+Warning: Columns of type bytea can hold null characters (\x00), whereas columns of type text cannot. >+ >+=item o pg_text => $boolean >+ >+Specifies that you're using a Postgres-specific column type of 'text' to hold the session data, in >+the session table. >+ >+This key is optional, but see the section, L</Combinations of Options> for how it interacts with the >+pg_bytea key. >+ >+Default: 0. >+ >+Warning: Columns of type bytea can hold null characters (\x00), whereas columns of type text cannot. >+ >+=item o port => $string >+ >+Specifies a port, typically for use with a data_source referring to MySQL. >+ >+This key is optional. >+ >+Default: '' (the empty string). >+ >+=item o query => $q >+ >+Specifies the query object. >+ >+If not specified, the next option - 'query_class' - will be used to create a query object. >+ >+Either way, the object will be accessible via the $session -> query() method. >+ >+This key is optional. >+ >+Default: '' (the empty string). >+ >+=item o query_class => $class_name >+ >+Specifies the class of query object to create if a value is not provided for the 'query' option. >+ >+This key is optional. >+ >+Default: 'CGI'. >+ >+=item o socket => $string >+ >+Specifies a socket, typically for use with a data_source referring to MySQL. >+ >+The reason this key is called socket and not mysql_socket is in case other drivers permit a socket >+option. >+ >+This key is optional. >+ >+Default: '' (the empty string). >+ >+=item o table_name => $string >+ >+Specifies the name of the table holding the session data. >+ >+This key is optional. >+ >+Default: 'sessions'. >+ >+=item o type => $string >+ >+Specifies the type of L<Data::Session> object you wish to create. >+ >+This key is optional. >+ >+Default: 'driver:File;id:MD5;serialize:DataDumper'. >+ >+This complex topic is discussed in the section L</Specifying Session Options>. >+ >+=item o umask => $octal_number >+ >+Specifies the mode to use when calling sysopen() on session files. >+ >+This value is used in these cases: >+ >+=over 4 >+ >+=item o type => 'driver:File ...' >+ >+=item o type => '... id:AutoIncrement ...' >+ >+=back >+ >+Default: 0660 (octal). >+ >+=item o username => $string >+ >+Specifies a value to use as the 2nd parameter in the call to L<DBI>'s connect() method. >+ >+This key is optional. It is only used if you do not supply a value for the 'dbh' key. >+ >+Default: '' (the empty string). >+ >+=item o verbose => $integer >+ >+Print to STDERR more or less information. >+ >+Typical values are 0, 1 and 2. >+ >+This key is optional. >+ >+Default: 0, meaings nothing is printed. >+ >+See L</dump([$heading])> for what happens when verbose is 2. >+ >+=back >+ >+=head3 Specifying Session Options >+ >+See also L</Case-sensitive Options>. >+ >+The default 'type' string is 'driver:File;id:MD5;serialize:DataDumper'. It consists of 3 optional >+components separated by semi-colons. >+ >+Each of those 3 components consists of 2 fields (a key and a value) separated by a colon. >+ >+The keys: >+ >+=over 4 >+ >+=item o driver >+ >+This specifies what type of persistent storage you wish to use for session data. >+ >+Values for 'driver': >+ >+=over 4 >+ >+=item o BerkeleyDB >+ >+Use L<BerkeleyDB> for storage. In this case, you must pass an object of type L<BerkeleyDB> >+to new() as the value of the 'cache' option. >+ >+See L<Data::Session::Driver::BerkeleyDB>. >+ >+=item o File >+ >+The default, 'File', says sessions are each stored in a separate file. >+ >+The directory for these files is specified with the 'directory' option to new(). >+ >+If a directory is not specified in that way, L<File::Spec> is used to find your temp directory. >+ >+The names of the session files are generated from the 'file_name' option to new(). >+ >+The default file name (pattern) is 'cgisess_%s', where the %s is replaced by the session id. >+ >+See L<Data::Session::Driver::File>. >+ >+=item o Memcached >+ >+Use C<memcached> for storage. In this case, you must pass an object of type L<Cache::Memcached> to >+new() as the value of the 'cache' option. >+ >+See L<Data::Session::Driver::Memcached>. >+ >+=item o mysql >+ >+This says each session is stored in a separate row of a database table using the L<DBD::mysql> >+database server. >+ >+These rows have a unique primary id equal to the session id. >+ >+See L<Data::Session::Driver::mysql>. >+ >+=item o ODBC >+ >+This says each session is stored in a separate row of a database table using the L<DBD::ODBC> >+database connector. >+ >+These rows have a unique primary id equal to the session id. >+ >+See L<Data::Session::Driver::ODBC>. >+ >+=item o Oracle >+ >+This says each session is stored in a separate row of a database table using the L<DBD::Oracle> >+database server. >+ >+These rows have a unique primary id equal to the session id. >+ >+See L<Data::Session::Driver::Oracle>. >+ >+=item o Pg >+ >+This says each session is stored in a separate row of a database table using the L<DBD::Pg> database >+server. >+ >+These rows have a unique primary id equal to the session id. >+ >+See L<Data::Session::Driver::Pg>. >+ >+=item o SQLite >+ >+This says each session is stored in a separate row of a database table using the SQLite database >+server. >+ >+These rows have a unique primary id equal to the session id. >+ >+The advantage of SQLite is that a client I<and server> are shipped with all recent versions of Perl. >+ >+See L<Data::Session::Driver::SQLite>. >+ >+=back >+ >+=item o id >+ >+This specifies what type of id generator you wish to use. >+ >+Values for 'id': >+ >+=over 4 >+ >+=item o AutoIncrement >+ >+This says ids are generated starting from a value specified with the 'id_base' option to new(), >+and the last-used id is stored in the file name given by the 'id_file' option to new(). >+ >+This file name must include a path, since the 'directory' option to new() is I<not> used here. >+ >+When a new id is required, the value in the file is incremented by the value of the 'id_step' option >+to new(), with the new value both written back to the file and returned as the new session id. >+ >+The default value of id_base is 0, and the default value of id_step is 1. Together, the first id >+available as a session id is id_base + id_step = 1. >+ >+The sequence starts when the module cannot find the given file, or when its contents are not >+numeric. >+ >+See L<Data::Session::ID::AutoIncrement>. >+ >+=item o MD5 >+ >+The default, 'MD5', says ids are to be generated by L<Digest::MD5>. >+ >+See L<Data::Session::ID::MD5>. >+ >+=item o SHA1 >+ >+This says ids are to be generated by L<Digest::SHA>, using a digest algorithm of 1. >+ >+See L<Data::Session::ID::SHA1>. >+ >+=item o SHA256 >+ >+This says ids are to be generated by L<Digest::SHA>, using a digest algorithm of 256. >+ >+See L<Data::Session::ID::SHA256>. >+ >+=item o SHA512 >+ >+This says ids are to be generated by L<Digest::SHA>, using a digest algorithm of 512. >+ >+See L<Data::Session::ID::SHA512>. >+ >+=item o Static >+ >+This says that the id passed in to new(), as the value of the 'id' option, will be used as the >+session id for every session. >+ >+Of course, this id must have a true value. L<Data::Session> dies on all values Perl regards as >+false. >+ >+See L<Data::Session::ID::Static>. >+ >+=item o UUID16 >+ >+This says ids are to be generated by L<Data::UUID>, to generate a 16 byte long binary UUID. >+ >+See L<Data::Session::ID::UUID16>. >+ >+=item o UUID34 >+ >+This says ids are to be generated by L<Data::UUID>, to generate a 34 byte long string UUID. >+ >+See L<Data::Session::ID::UUID34>. >+ >+=item o UUID36 >+ >+This says ids are to be generated by L<Data::UUID>, to generate a 36 byte long string UUID. >+ >+See L<Data::Session::ID::UUID36>. >+ >+=item o UUID64 >+ >+This says ids are to be generated by L<Data::UUID>, to generate a 24 (sic) byte long, base-64 >+encoded, UUID. >+ >+See L<Data::Session::ID::UUID64>. >+ >+=back >+ >+See scripts/digest.pl which prints the length of each type of digest. >+ >+=item o serialize >+ >+The specifies what type of mechanism you wish to use to convert the in-memory session data into a >+form appropriate for your chosen storage type. >+ >+Values for 'serialize': >+ >+=over 4 >+ >+=item o DataDumper >+ >+Use L<Data::Dumper> to freeze/thaw sessions. >+ >+See L<Data::Session::Serialize::DataDumper>. >+ >+=item o FreezeThaw >+ >+Use L<FreezeThaw> to freeze/thaw sessions. >+ >+See L<Data::Session::Serialize::FreezeThaw>. >+ >+=item o JSON >+ >+Use L<JSON> to freeze/thaw sessions. >+ >+See L<Data::Session::Serialize::JSON>. >+ >+=item o Storable >+ >+Use L<Storable> to freeze/thaw sessions. >+ >+See L<Data::Session::Serialize::Storable>. >+ >+Warning: Storable should be avoided until this problem is fixed: >+L<http://rt.cpan.org/Public/Bug/Display.html?id=36087>. >+ >+=item o YAML >+ >+Use L<YAML::Tiny> to freeze/thaw sessions. >+ >+See L<Data::Session::Serialize::YAML>. >+ >+=back >+ >+=back >+ >+=head3 Case-sensitive Options >+ >+Just to emphasize: The names of drivers, etc follow the DBD::* (or similar) style of >+case-sensitivity. >+ >+The following classes for drivers, id generators and serializers, are shipped with this package. >+ >+Drivers: >+ >+=over 4 >+ >+=item o L<Data::Session::Driver::BerkeleyDB> >+ >+This name comes from L<BerkeleyDB>. >+ >+And yes, the module uses L<BerkeleyDB> and not L<DB_File>. >+ >+=item o L<Data::Session::Driver::File> >+ >+=item o L<Data::Session::Driver::Memcached> >+ >+This name comes from L<Cache::Memcached> even though the external program you run is called >+memcached. >+ >+=item o L<Data::Session::Driver::mysql> >+ >+=item o L<Data::Session::Driver::ODBC> >+ >+=item o L<Data::Session::Driver::Oracle> >+ >+=item o L<Data::Session::Driver::Pg> >+ >+=item o L<Data::Session::Driver::SQLite> >+ >+=back >+ >+ID generators: >+ >+=over 4 >+ >+=item o L<Data::Session::ID::AutoIncrement> >+ >+=item o L<Data::Session::ID::MD5> >+ >+=item o L<Data::Session::ID::SHA1> >+ >+=item o L<Data::Session::ID::SHA256> >+ >+=item o L<Data::Session::ID::SHA512> >+ >+=item o L<Data::Session::ID::Static> >+ >+=item o L<Data::Session::ID::UUID16> >+ >+=item o L<Data::Session::ID::UUID34> >+ >+=item o L<Data::Session::ID::UUID36> >+ >+=item o L<Data::Session::ID::UUID64> >+ >+=back >+ >+Serializers: >+ >+=over 4 >+ >+=item o L<Data::Session::Serialize::DataDumper> >+ >+=item o L<Data::Session::Serialize::FreezeThaw> >+ >+=item o L<Data::Session::Serialize::JSON> >+ >+=item o L<Data::Session::Serialize::Storable> >+ >+Warning: Storable should be avoided until this problem is fixed: >+L<http://rt.cpan.org/Public/Bug/Display.html?id=36087> >+ >+=item o L<Data::Session::Serialize::YAML> >+ >+=back >+ >+=head3 Specifying an Id >+ >+L</user_id()> is called to determine if an id is available from a cookie or a form field. >+ >+There are several cases to consider: >+ >+=over 4 >+ >+=item o You specify an id which exists in storage >+ >+You can check this with the call $session -> is_new, which will return 0. >+ >+$session -> id will return the old id. >+ >+=item o You do not specify an id >+ >+The module generates a new session and a new id. >+ >+You can check this with the call $session -> is_new, which will return 1. >+ >+$session -> id will return the new id. >+ >+=item o You specify an id which does not exist in storage >+ >+You can check this with the call $session -> is_new, which will return 1. >+ >+$session -> id will return the old id. >+ >+=back >+ >+So, how to tell the difference between the last 2 cases? Like this: >+ >+ if ($session -> id == $session -> user_id) >+ { >+ # New session using user-supplied id. >+ } >+ else >+ { >+ # New session with new id. >+ } >+ >+=head3 Combinations of Options >+ >+See also L</Specifying Session Options>, for options-related combinations. >+ >+=over 4 >+ >+=item o dbh >+ >+If you don't specify a value for the 'dbh' key, this module must create a database handle in those >+cases when you specify a database driver of some sort in the value for 'type'. >+ >+To create that handle, we needs a value for 'data_source', and that in turn may require values for >+'username' and 'password'. >+ >+When using SQLite, just specify a value for 'data_source'. The default values for 'username' and >+'password' - empty strings - will work. >+ >+=item o file_name and id_file >+ >+When using new(type => 'driver:File;id:AutoIncrement;...'), then file_name is ignored and id_file is >+used. >+ >+If id_file is not supplied, it defaults to File::Spec -> catdir(File::Spec -> tmpdir, >+'data.session.id'). >+ >+When using new(type => 'driver:File;id:<Not AutoIncrement>;...'), then id_file is ignored and >+file_name is used. >+ >+If file_name is not supplied, it defaults to 'cgisess_%s'. Note the mandatory %s. >+ >+=item o pg_bytea and pg_text >+ >+If you set 'pg_bytea' to 1, then 'pg_text' will be set to 0. >+ >+If you set 'pg_text' to 1, then 'pg_bytea' will be set to 0. >+ >+If you set them both to 0 (i.e. the default), then 'pg_bytea' will be set to 1. >+ >+If you set them both to 1, 'pg_bytea' will be left as 1 and 'pg_text' will be set to 0. >+ >+This choice was made because you really should be using a column type of 'bytea' for a_session >+in the sessions table, since the type 'text' does not handle null (\x00) characters. >+ >+=back >+ >+=head2 atime([$atime]) >+ >+The [] indicates an optional parameter. >+ >+Returns the last access time of the session. >+ >+By default, the value comes from calling Perl's time() function, or you may pass in a time, >+which is then used to set the last access time of the session. >+ >+This latter alternative is used by L</load_session()>. >+ >+See also L</ctime()>, L</etime()> and L</ptime()>. >+ >+=head2 check_expiry() >+ >+Checks that there is an expiry time set for the session, and, if (atime + etime) < time(): >+ >+=over 4 >+ >+=item o Deletes the session >+ >+See L</delete()> for precisely what this means. >+ >+=item o Sets the expired flag >+ >+See L</expired()>. >+ >+=back >+ >+This is used when the session is loaded, when you call L</http_header([@arg])>, and by >+scripts/expire.pl. >+ >+=head2 clear([$name]) >+ >+The [] indicates an optional parameter. >+ >+Returns 1. >+ >+Specifies that you wish to delete parameters stored in the session, i.e. stored by previous calls to >+param(). >+ >+$name is a parameter name or an arrayref of parameter names. >+ >+If $name is not specified, it is set to the list of all unreserved keys (parameter names) in the >+session. >+ >+See L</param([@arg])> for details. >+ >+=head2 cookie([@arg]) >+ >+The [] indicates an optional parameter. >+ >+Returns a cookie, or '' (the empty string) if the query object does not have a cookie() method. >+ >+Use the @arg parameter to pass any extra parameters to the query object's cookie() method. >+ >+Warning: Parameters which are handled by L<Data::Session>, and hence should I<not> be passed in, >+are: >+ >+=over 4 >+ >+=item o -expires >+ >+=item o -name >+ >+=item o -value >+ >+=back >+ >+See L</http_header([@arg])> and scripts/cookie.pl. >+ >+=head2 ctime() >+ >+Returns the creation time of the session. >+ >+The value comes from calling Perl's time() function when the session was created. >+ >+This is not the creation time of the session I<object>, except for new sessions. >+ >+See also L</atime()>, L</etime()> and L</ptime()>. >+ >+=head2 delete() >+ >+Returns the result of calling the driver's remove() method. >+ >+Specifies that you want to delete the session. Here's what it does: >+ >+=over 4 >+ >+=item o Immediately deletes the session from storage >+ >+=item o Calls clear() >+ >+This deletes all non-reserved parameters from the session object, and marks it as modified. >+ >+=item o Marks the session object as deleted >+ >+=back >+ >+The latter step means that when (or if) the session object goes out of scope, it will not be flushed >+to storage. >+ >+Likewise, if you call flush(), the call will be ignored. >+ >+Nevertheless, the session object is still fully functional - it just can't be saved or retrieved. >+ >+See also L</deleted()> and L</expire([@arg])>. >+ >+=head2 deleted() >+ >+Returns a Boolean (0/1) indicating whether or not the session has been deleted. >+ >+See also L</delete()> and L</expire([@arg])>. >+ >+=head2 dump([$heading]) >+ >+The [] indicates an optional parameter. >+ >+Dumps the session's contents to STDERR, with a prefix of '# '. >+ >+The $heading, if any, is written first, on a line by itself, with the same prefix. >+ >+This is especially useful for testing, since it fits in with the L<Test::More> method diag(). >+ >+When verbose is 2, dump is called at these times: >+ >+=over 4 >+ >+=item o When a session is flushed >+ >+=item o As soon as a session is loaded >+ >+=item o As soon as expiry is checked on a just-loaded session >+ >+=item o As soon as parameter expiry is checked on a just-loaded session >+ >+=back >+ >+=head2 etime() >+ >+Returns the expiry time of the session. >+ >+This is the same as calling $session -> expiry(). In fact, this just calls $session -> etime. >+ >+See also L</atime()>, L</ctime()> and L</ptime()>. >+ >+=head2 expire([@arg]) >+ >+The [] indicates an optional parameter. >+ >+Specifies that you wish to set or retrieve the session's expiry time, or set the expiry times of >+session parameters. >+ >+Integer time values ($time below) are assumed to be seconds. The value may be positive or 0 or >+negative. >+ >+These expiry times are relative to the session's last access time, not the session's creation time. >+ >+In all cases, a time of 0 disables expiry. >+ >+This affects users of L<Cache::Memcached>. See below and L<Data::Session::Driver::Memcached>. >+ >+When a session expires, it is deleted from storage. See L</delete()> for details. >+ >+The test for whether or not a session has expired only takes place when a session is loaded from >+storage. >+ >+When a session parameter expires, it is deleted from the session object. See L</clear([$name])> >+for details. >+ >+The test for whether or not a session parameter has expired only takes place when a session is >+loaded from storage. >+ >+=over 4 >+ >+=item o $session -> expire() >+ >+Use $session -> expire() to return the session's expiry time. This just calls $session -> etime. >+ >+The default expiry time is 0, meaning the session will never expire. Likewise, by default, session >+parameters never expire. >+ >+=item o $session -> expire($time) >+ >+Use $session -> expire($time) to set the session's expiry time. >+ >+Use these suffixes to change the interpretation of the integer you specify: >+ >+ +-----------+---------------+ >+ | Suffix | Meaning | >+ +-----------+---------------+ >+ | s | Second | >+ | m | Minute | >+ | h | Hour | >+ | d | Day | >+ | w | Week | >+ | M | Month | >+ | y | Year | >+ +-----------+---------------+ >+ >+Hence $session -> expire('2h') means expire the session in 2 hours. >+ >+expire($time) calls validate_time($time) to perform the conversion from '2h' to seconds, >+so L</validate_time($time)> is available to you too. >+ >+If setting a time like this, expire($time) returns 1. >+ >+Note: The time set here is passed as the 3rd parameter to the storage driver's store() method (for >+all types of storage), and from there as the 3rd parameter to the set() method of >+L<Cache::Memcached>. Of course, this doesn't happen immediately - it only happens when the session >+is saved. >+ >+=item o $session -> expire($key_1 => $time_1[, $key_2 => $time_2...]) >+ >+Use $session -> expire($key_1 => $time_1[, $key_2 => $time_2...]) to set the expiry times of >+session parameters. >+ >+=back >+ >+Special cases: >+ >+=over 4 >+ >+=item o To expire the session immediately, call delete() >+ >+=item o To expire a session parameter immediately, call clear($key) >+ >+=back >+ >+See also L</atime()>, L</ctime()>, L</etime()>, L</delete()> and >+L</deleted()>. >+ >+=head2 expired() >+ >+Returns a Boolean (0/1) indicating whether or not the session has expired. >+ >+See L</delete()>. >+ >+=head2 flush() >+ >+Returns 1. >+ >+Specifies that you want the session object immediately written to storage. >+ >+If you have previously called delete(), the call to flush() is ignored. >+ >+If the object has not been modified, the call to flush() is ignored. >+ >+Warning: With persistent environments, you object may never go out of scope that way you think it >+does.See L</Trouble with Exiting> for details. >+ >+These reserved session parameters are included in what's written to storage: >+ >+=over 4 >+ >+=item o _SESSION_ATIME >+ >+The session's last access time. >+ >+=item o _SESSION_CTIME >+ >+The session's creation time. >+ >+=item o _SESSION_ETIME >+ >+The session's expiry time. >+ >+A time of 0 means there is no expiry time. >+ >+This affect users of L<Cache::Memcached>. See L</expire([@arg])> and >+L<Data::Session::Driver::Memcached>. >+ >+=item o _SESSION_ID >+ >+The session's id. >+ >+=item o _SESSION_PTIME >+ >+A hashref of session parameter expiry times. >+ >+=back >+ >+=head2 http_header([@arg]) >+ >+The [] indicate an optional parameter. >+ >+Returns a HTTP header. This means it does I<not> print the header. You have to do that, when >+appropriate. >+ >+Unlike L<CGI::Session>, L<Data::Session> does I<not> force the document type to be 'text/html'. >+ >+You must pass in a document type to http_header(), as >+C<< $session -> http_header('-type' => 'text/html') >>, or use the query object's default. >+ >+Both L<CGI> and L<CGI::Simple> default to 'text/html'. >+ >+L<Data::Session> handles the case where the query object does not have a cookie() method, by calling >+$session -> cookie() to generate either a cookie, or '' (the empty string). >+ >+The @arg parameter, if any, is passed to the query object's header() method, after the cookie >+parameter, if any. >+ >+=head2 id() >+ >+Returns the id of the session. >+ >+=head2 is_new() >+ >+Returns a Boolean (0/1). >+ >+Specifies you want to know if the session object was created from scratch (1) or was retrieved >+from storage (0). >+ >+=head2 load_param([$q][, $name]) >+ >+The [] indicate optional parameters. >+ >+Returns $q. >+ >+Loads (copies) all non-reserved parameters from the session object into the query object. >+ >+L</save_param([$q][, $name])> performs the opposite operation. >+ >+$q is a query object, and $name is a parameter name or an arrayref of names. >+ >+If the query object is not specified, generates one by calling $session -> load_query_class, >+and stores it in the internal 'query' attribute. >+ >+If you don't provide $q, use undef, don't just omit the parameter. >+ >+If $name is specified, only the session parameters named in the arrayref are processed. >+ >+If $name is not specified, copies all parameters belonging to the query object. >+ >+=head2 load_query_class() >+ >+Returns the query object. >+ >+This calls $session -> query_class -> new if the session object's query object is not defined. >+ >+=head2 load_session() >+ >+Returns a session. >+ >+Note: This method does not take any parameters, and hence does not function in the same way as >+load(...) in L<CGI::Session>. >+ >+Algorithm: >+ >+=over 4 >+ >+=item o If user_id() returns a session id, try to load that session >+ >+If that succeeds, return the session. >+ >+If it fails, generate a new session, and return it. >+ >+You can call is_new() to tell the difference between these 2 cases. >+ >+=item o If user_id() returns 0, generate a new session, and return it >+ >+=back >+ >+=head2 modified() >+ >+Returns a Boolean (0/1) indicating whether or not the session's parameters have been modified. >+ >+However, changing a value from one form of not-defined, e.g. undef, to another form of not-defined, >+e.g. 0, is ignored, meaning the modified flag is not set. In such cases, you could set the flag >+yourself. >+ >+Note: Loading a session from storage changes the session's last access time, which means the session >+has been modified. >+ >+If you wish to stop the session being written to storage, without deleting it, you can reset the >+modified flag with $session -> modified(0). >+ >+=head2 param([@arg]) >+ >+The [] indicates an optional parameter. >+ >+Specifies that you wish to retrieve data stored in the session, or you wish to store data in the >+session. >+ >+Data is stored in the session object as in a hash, via a set of $key => $value relationships. >+ >+Use $session -> param($key_1 => $value_1[, $key_2 => $value_2...]) to store data in the session. >+ >+If storing data, param() returns 1. >+ >+The values stored in the session may be undef. >+ >+Note: If the value being stored is the same as the pre-existing value, the value in the session is >+not updated, which means the last access time does not change. >+ >+Use $session -> param() to return a sorted list of all keys. >+ >+That call returns a list of the keys you have previously stored in the session. >+ >+Use $session -> param('key') to return the value associated with the given key. >+ >+See also L</clear([$name])>. >+ >+=head2 ptime() >+ >+Returns the hashref of session parameter expiry times. >+ >+Keys are parameter names and values are expiry times in seconds. >+ >+These expiry times are set by calling L</expire([@arg])>. >+ >+See also L</atime()>, L</ctime()> and L</etime()>. >+ >+=head2 save_param([$q][, $name]) >+ >+The [] indicate optional parameters. >+ >+Returns 1. >+ >+Loads (copies) all non-reserved parameters from the query object into the session object. >+ >+L</load_param([$q][, $name])> performs the opposite operation. >+ >+$q is a query object, and $name is a parameter name or an arrayref of names. >+ >+If the query object is not specified, generates one by calling $session -> load_query_class, >+and stores it in the internal 'query' attribute. This means you can retrieve it with >+$session -> query. >+ >+If you don't provide $q, use undef, don't just omit the parameter. >+ >+If $name is specified, only the session parameters named in the arrayref are processed. >+ >+If $name is not specified, copies all parameters. >+ >+=head2 traverse($sub) >+ >+Returns 1. >+ >+Specifies that you want the $sub called for each session id found in storage, with one (1) id as >+the only parameter in each call. >+ >+Note: traverse($sub) does not load the sessions, and hence has no effect on the session's last >+access time. >+ >+See scripts/expire.pl. >+ >+=head2 user_id() >+ >+Returns either a session id, or 0. >+ >+Algorithm: >+ >+=over 4 >+ >+=item o If $session -> id() returns a true value, return that >+ >+E.g. The user supplied one in $session -> new(id => $id). >+ >+Return this id. >+ >+=item o Try to recover an id from the cookie object or the query object. >+ >+If the query object supports the cookie method, call >+$self -> query -> cookie and (if that doesn't find an id), $self -> query -> param. >+ >+If the query object does not support the cookie method, just call $self -> query -> param. >+ >+Return any id found, or 0. >+ >+Note: The name of the cookie, and the name of the CGI form field, is passed to new() by the 'name' >+option. >+ >+=back >+ >+=head2 validate_options() >+ >+Cross-check a few things. >+ >+E.g. When using type => '... id:Static ...', you must supply a (true) id to new(id => ...'). >+ >+=head2 validate_time($time) >+ >+Dies for an invalid time string, or returns the number of seconds corresponding to $time, >+which may be positive or negative. >+ >+See L</expire([@arg])> for details on the time string format. >+ >+=head1 Test Code >+ >+t/basic.ini and t/bulk.ini contain DSNs for BerkeleyDB, File, Memcache, MySQL, Pg and SQLite. >+Actually, they're the same file, just with different DSNs activated. >+ >+So, you can use t/basic.t to run minimal tests (with only File and SQLite activated) like this: >+ >+ perl -Ilib t/basic.t >+ >+or you can edit t/bulk.ini as desired, and pass it in like this: >+ >+ perl -Ilib t/basic.t t/bulk.ini >+ >+Simple instructions for installing L<BerkeleyDB> (Oracle and Perl) are in >+L<Data::Session::Driver::Berkeley>. >+ >+Simple instructions for installing L<Cache::Memcached> and memcached are in >+L<Data::Session::Driver::Memcached>. >+ >+=head1 FAQ >+ >+=head2 Guidelines re Sources of Confusion >+ >+This section discusses various issues which confront beginners: >+ >+=over 4 >+ >+=item o 1: Both Data::Session and L<CGI::Snapp> have a I<param()> method >+ >+Let's say your L<CGI> script sub-classes L<CGI::Application> or it's successor L<CGI::Snapp>. >+ >+Then inside your sub-class's methods, this works: >+ >+ $self -> param(a_key => 'a_value'); >+ >+ Time passes... >+ >+ my($value) = $self -> param('a_key'); >+ >+because those 2 modules each implement a method called I<param()>. Basically, you're storing a value >+(via 'param') inside $self. >+ >+But when you store an object of type Data::Session using I<param()>, it looks like this: >+ >+ $self -> param(session => Data::Session -> new(...) ); >+ >+Now, Data::Session itself I<also> implements a method called I<param()>. So, to store something in >+the session (but not in $self), you must do: >+ >+ $self -> param('session') -> param(a_key => 'a_value'); >+ >+ Time passes... >+ >+ my($value) = $self -> param('session') -> param('a_key'); >+ >+It should be obvious that confusion can arise here because the 2 objects represented by $self and >+$self -> param('session') both have I<param()> methods. >+ >+=item o 2: How exactly should a L<CGI> script save a session? >+ >+The first example in the Synopsis shows a very simple L<CGI> script doing the right thing by >+calling I<flush()> just before it exits. >+ >+Alternately, if you sub-class L<CGI::Snapp>, the call to I<flush()> is best placed in your >+I<teardown()> method, which is where you override L<CGI::Snapp/teardown()>. The point here is that >+your I<teardown()> is called automatically at the end of each run mode. >+ >+This important matter is also discussed in L</General Questions> below. >+ >+=item o 3: Storing array and hashes >+ >+Put simply: Don't do that! >+ >+This will fail: >+ >+ $self -> param('session') -> param(my_hash => %my_hash); >+ >+ Time passes... >+ >+ my(%my_hash) = $self -> param('session') -> param('my_hash'); >+ >+Likewise for an array instead of a hash. >+ >+But why? Because the part 'param(my_hash => %my_hash)' is basically assigning a list (%my_hash) to >+a scalar (my_hash). Hence, only 1 element of the list (the 'first' key in some unknown order) will >+be assigned. >+ >+So, when you try to restore the hash with 'my(%my_hash) ...', all you'll get back is a scalar, which >+will generate the classic error message 'Odd number of elements in hash assignment...'. >+ >+The solution is to use arrayrefs and hashrefs: >+ >+ $self -> param('session') -> param(my_hash => {%my_hash}); >+ >+ Time passes... >+ >+ my(%my_hash) = %{$self -> param('session') -> param('my_hash')}; >+ >+Likewise for an array: >+ >+ $self -> param('session') -> param(my_ara => [@my_ara]); >+ >+ Time passes... >+ >+ my(@my_ara) = @{$self -> param('session') -> param('my_ara')}; >+ >+=back >+ >+=head2 General Questions >+ >+=over 4 >+ >+=item o My sessions are not getting written to disk! >+ >+This is because you haven't stored anything in them. You're probably thinking sessions are saved >+just because they exist. >+ >+Actually, sessions are only saved if they have at least 1 parameter set. The session id and >+access/etc times are not enough to trigger saving. >+ >+Just do something like $session -> param(ok => 1); if you want a session saved just to indicate it >+exists. Code like this sets the modified flag on the session, so that flush() actually does the >+save. >+ >+Also, see L</Trouble with Exiting>, below, to understand why flush() must be called explicitly in >+persistent environments. >+ >+=item o Why don't the test scripts use L<Test::Database>? >+ >+I decided to circumvent it by using L<DBIx::Admin::DSNManager> and adopting the wonders of nested >+testing. But, since V 1.11, I've replaced that module with L<Config::Tiny>, to reduce dependencies, >+and hence to make it easier to get L<Data::Session> into Debian. >+ >+See t/basic.t, and in particular this line: subtest $driver => sub. >+ >+=item o Why didn't you use OSSP::uuid as did L<CGI::Session::ID::uuid>? >+ >+Because when I tried to build that module (under Debian), ./configure died, saying I had set 2 >+incompatible options, even though I hadn't set either of them. >+ >+=item o What happens when 2 processes write sessions with the same id? >+ >+The last-to-write wins, by overwriting what the first wrote. >+ >+=item o Params::Validate be adopted to validate parameters? >+ >+Not yet. >+ >+=back >+ >+=head1 Troubleshooting >+ >+=head2 Trouble with Errors >+ >+When object construction fails, new() sets $Data::Session::errstr and returns undef. >+This means you can use this idiom: >+ >+ my($session) = Data::Session -> new(...) || process_error($Data::Session::errstr); >+ >+However, when methods detect errors they die, so after successful object construction, you can do: >+ >+ use Try::Tiny; >+ >+ try >+ { >+ $session -> some_method_which_may_die; >+ } >+ catch >+ { >+ process_error($_); # Because $_ holds the error message. >+ }; >+ >+=head2 Trouble with Exiting >+ >+If the session object's clean-up code is called, in DESTROY(), the session data is automatically >+flushed to storage (except when it's been deleted, or has not been modified). >+ >+However, as explained below, there can be problems with your code (i.e. not with L<Data::Session>) >+such that this clean-up code is not called, or, if called, it cannot perform as expected. >+ >+The general guideline, then, is that you should explicitly call C<flush()> on the session object >+before your program exits. >+ >+Common traps for beginners: >+ >+=over 4 >+ >+=item o Creating 2 CGI-like objects >+ >+If your code creates an object of type L<CGI> or similar, but you don't pass that object into >+L<Data::Session> via the 'query' parameter to new(), this module will create one for you, >+which can be very confusing. >+ >+The solution is to always create such a object yourself, and to always pass that into >+L<Data::Session>. >+ >+In the case that the user of a CGI script runs your code for the first time, there will be no >+session id, either from a cookie or from a form field. >+ >+In such a case, L<Data::Session> will do what you expect, which is to generate a session id. >+ >+=item o Letting your database handle go out of scope too early >+ >+When your script is exiting, and you're trying to save session data to storage via a database >+handle, the save will fail if the handle goes out of scope before the session data is flushed to >+storage. >+ >+So, don't do that. >+ >+=item o Assuming your session object goes out of scope when it doesn't >+ >+In persistent environments such as L<Plack>, FastCGI and mod_perl, your code exits as expected, but >+the session object does not go out of scope in the normal way. >+ >+In cases like this, it is mandatory for you to call flush() on the session object before your >+code exits, since persistent environments operate in such a way that the session object's clean-up >+code does not get called. This means that flush() is not called automatically by DESTROY() as you >+would expect, because DESTROY() is not being called. >+ >+=item o Creating circular references anywhere in your code >+ >+In these cases, Perl's clean-up code may not run to completion, which means the session object may >+not have its clean-up code called at all. As above, flush() may not get called. >+ >+If you must create circular references, it's vital you debug the exit logic using a module such as >+L<Devel::Cycle> before assuming the fault is with L<Data::Session>. >+ >+=item o Using signal handlers >+ >+Write your code defensively, if you wish to call the session object's flush() method when a signal >+might affect program exit logic. >+ >+=back >+ >+=head2 Trouble with IDs >+ >+The module uses code like if (! $self -> id), which means ids must be (Perl) true values, so undef, >+0 and '' will not work. >+ >+=head2 Trouble with UUID16 >+ >+While testing with UUID16 as the id generator, I got this message: >+... invalid byte sequence for encoding "UTF8" ... >+ >+That's because when I create a database (in Postgres) I use "create database d_name owner d_owner >+encoding 'UTF8';" and UUID16 simply produces a 16 byte binary value, which is not guaranteed to be >+or contain a valid UTF8 character. >+ >+This also means you should never try to use 'driver:File;id:UUID16 ...', since the ids generated by >+this module would rarely if ever be valid as a part of a file name. >+ >+=head2 Trouble with UUID64 >+ >+While testing with UUID64 as the id generator, I got this message: >+... Session ids cannot contain \ or / ... >+ >+That's because I was using a File driver, and UUID's encoded in base 64 can contain /. >+ >+So, don't do that. >+ >+=head1 Version Numbers >+ >+Version numbers < 1.00 represent development versions. From 1.00 up, they are production versions. >+ >+=head1 Repository >+ >+L<https://github.com/ronsavage/Data-Session.git> >+ >+=head1 Support >+ >+LBugs should be reported via the CPAN bug tracker at >+ >+L<https://github.com/ronsavage/Data-Session/issues> >+ >+=head1 Thanks >+ >+Many thanks are due to all the people who contributed to both L<Apache::Session> and >+L<CGI::Session>. >+ >+Likewise, many thanks to the implementors of nesting testing. See L<Test::Simple>. >+ >+=head1 Author >+ >+L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010. >+ >+Home page: L<http://savage.net.au/index.html>. >+ >+=head1 Copyright >+ >+Australian copyright (c) 2010, Ron Savage. >+ >+ All Programs of mine are 'OSI Certified Open Source Software'; >+ you can redistribute them and/or modify them under the terms of >+ The Artistic License, a copy of which is available at: >+ http://www.opensource.org/licenses/index.html >+ >+=cut >diff --git a/lib/Data/Session/Base.pm b/lib/Data/Session/Base.pm >new file mode 100644 >index 00000000000..056b304ad92 >--- /dev/null >+++ b/lib/Data/Session/Base.pm >@@ -0,0 +1,114 @@ >+package Data::Session::Base; >+ >+no autovivification; >+use strict; >+use warnings; >+ >+use Hash::FieldHash ':all'; >+ >+fieldhash my %cache => 'cache'; >+fieldhash my %data_col_name => 'data_col_name'; >+fieldhash my %data_source => 'data_source'; >+fieldhash my %data_source_attr => 'data_source_attr'; >+fieldhash my %dbh => 'dbh'; >+fieldhash my %debug => 'debug'; >+fieldhash my %deleted => 'deleted'; >+fieldhash my %directory => 'directory'; >+fieldhash my %driver_cless => 'driver_class'; >+fieldhash my %driver_option => 'driver_option'; >+fieldhash my %expired => 'expired'; >+fieldhash my %file_name => 'file_name'; >+fieldhash my %host => 'host'; >+fieldhash my %id => 'id'; >+fieldhash my %id_base => 'id_base'; >+fieldhash my %id_col_name => 'id_col_name'; >+fieldhash my %id_file => 'id_file'; >+fieldhash my %id_class => 'id_class'; >+fieldhash my %id_option => 'id_option'; >+fieldhash my %id_step => 'id_step'; >+fieldhash my %is_new => 'is_new'; >+fieldhash my %modified => 'modified'; >+fieldhash my %name => 'name'; >+fieldhash my %no_flock => 'no_flock'; >+fieldhash my %no_follow => 'no_follow'; >+fieldhash my %password => 'password'; >+fieldhash my %pg_bytea => 'pg_bytea'; >+fieldhash my %pg_text => 'pg_text'; >+fieldhash my %port => 'port'; >+fieldhash my %query => 'query'; >+fieldhash my %query_class => 'query_class'; >+fieldhash my %serializer_class => 'serializer_class'; >+fieldhash my %serializer_option => 'serializer_option'; >+fieldhash my %session => 'session'; >+fieldhash my %socket => 'socket'; >+fieldhash my %table_name => 'table_name'; >+fieldhash my %type => 'type'; >+fieldhash my %umask => 'umask'; >+fieldhash my %username => 'username'; >+fieldhash my %verbose => 'verbose'; >+ >+our $errstr = ''; >+our $VERSION = '1.18'; >+ >+# ----------------------------------------------- >+ >+sub log >+{ >+ my($self, $s) = @_; >+ $s ||= ''; >+ >+ print STDERR "# $s\n"; >+ >+} # End of log. >+ >+# ----------------------------------------------- >+ >+1; >+ >+=pod >+ >+=head1 NAME >+ >+L<Data::Session::Base> - A persistent session manager >+ >+=head1 Synopsis >+ >+See L<Data::Session> for details. >+ >+=head1 Description >+ >+Provide a set of methods for all derived classes, including log(). >+ >+=head1 Method: new() >+ >+This class is never used on its own. >+ >+=head1 Method: log($s) >+ >+Print the string to STDERR. >+ >+If $s is empty, use '' (the empty string), to avoid a warning message. >+ >+Lastly, the string is output preceeded by a '#', so it does not interfere with test output. >+That is, log($s) emulates diag $s. >+ >+=head1 Support >+ >+Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>. >+ >+=head1 Author >+ >+L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010. >+ >+Home page: L<http://savage.net.au/index.html>. >+ >+=head1 Copyright >+ >+Australian copyright (c) 2010, Ron Savage. >+ >+ All Programs of mine are 'OSI Certified Open Source Software'; >+ you can redistribute them and/or modify them under the terms of >+ The Artistic License, a copy of which is available at: >+ http://www.opensource.org/licenses/index.html >+ >+=cut >diff --git a/lib/Data/Session/CGISession.pm b/lib/Data/Session/CGISession.pm >new file mode 100644 >index 00000000000..e5870d0d803 >--- /dev/null >+++ b/lib/Data/Session/CGISession.pm >@@ -0,0 +1,440 @@ >+package Data::Session::CGISession; >+ >+our $VERSION = '1.18'; >+ >+# ----------------------------------------------- >+ >+1; >+ >+=pod >+ >+=head1 NAME >+ >+L<Data::Session> - A persistent session manager >+ >+=head1 The Design of Data::Session, contrasted with CGI::Session >+ >+For background, read the docs (including the Changes files) and bug reports for both >+L<Apache::Session> and L<CGI::Session>. >+ >+The interface to L<Data::Session> is not quite compatible with that of L<CGI::Session>, hence the >+new namespace. >+ >+The purpose of L<Data::Session> is to be a brand-new alternative to both L<Apache::Session> and >+L<CGI::Session>. >+ >+=head1 Aliases for Method Names >+ >+Aliases for method names are not supported. >+ >+In L<CGI::Session>, methods etime() and expires() were aliased to expire(). This is not supported >+in L<Data::Session>. >+ >+L<Data::Session> does have an etime() method, L<Data::Session/Method: etime()>, which is different. >+ >+In L<CGI::Session>, method header() was aliased to http_header(). Only the latter method is >+supported in L<Data::Session>. See L</Method: cookie()> and L</Method: http_header([@arg])>. >+ >+In L<CGI::Session>, id generators had a method generate_id() aliased to generate(). This is not >+supported in L<Data::Session>. >+ >+In L<CGI::Session>, method param_dataref() was aliased to dataref(). Neither of these methods is >+supported in L<Data::Session>. If you want to access the session data, use >+my($hashref) = $session -> session. >+ >+=head1 Backwards-compatibility >+ >+This topic is sometimes used as a form of coercion, which is unacceptable, and sometimes leads to >+a crippled design. >+ >+So, by design, L<Data::Session> is not I<exactly> backwards-compatible with L<CGI::Session>, but >+does retain it's major features: >+ >+=over 4 >+ >+=item o Specify the basic operating parameters with new(type => $string) >+ >+This determines the type of session object you wish to create. >+ >+Default: 'driver:File;id:MD5;serialize:DataDumper'. >+ >+And specifically, the format of that case-sensitive string is as expected. See >+L<Data::Session/Specifying Session Options> for details. >+ >+=item o Retrieve the session id with the id() method >+ >+=item o Set and get parameters with the param() method >+ >+=item o Ensure session data is saved to disk with the flush() method >+ >+Call this just before your program exits. >+ >+In particular, as with L<CGI::Session>, persistent environments stop your program exiting in the way >+you are used to. This matter is discussed in L<Data::Session/Trouble with Exiting>. >+ >+=back >+ >+=head1 CGI::Session::ExpireSessions is obsolete >+ >+Instead, consider using scripts/expire.pl, which ships with L<Data::Session>. >+ >+=head1 Code refs as database handles >+ >+Being able to supply a code ref as the value of the 'dbh' parameter to new() is supported. >+ >+This mechanism is used to delay creation of a database handle until it is actually needed, >+which means if it is not needed it is not created. >+ >+=head1 Class 'v' Object >+ >+Calling methods on the class is not supported. You must always create an object. >+ >+The reason for this is to ensure every method call, without exception, has access to the per-object >+data supplied by you, or by default, in the call to new(). >+ >+=head1 The type of the Data::Session object >+ >+Controlling the capabilities of the L<Data::Session> object is determined by the 'type' parameter >+passed in to new, as Data::Session -> new(type => $string). >+ >+A sample string looks like 'driver:BerkeleyDB;id:SHA1;serialize:DataDumper'. >+ >+Abbreviation of component key names ('driver', 'id', 'serialize') is not supported. >+ >+Such abbreviations were previously handled by L<Text::Abbrev>. Now, these must be named in full. >+ >+The decision to force corresponding class names to lower case is not supported. >+ >+Nevertheless, lower-cased input will be accepted. Such input is converted to the case you expect. >+ >+This affects the names of various sub-classes. See L</ID Generators>, L</Serialization Drivers> and >+L</Storage Drivers>. >+ >+For example, driver:pg is now driver:Pg, which actually means L<Data::Session::Driver::Pg>, based on >+the class name L<DBD::Pg>. >+ >+=head1 Exceptions >+ >+Exceptions are caught with L<Try::Tiny>. Errors cause L<Data::Session> to die. >+ >+The only exception to this is the call to new(), which can return undef. In that case, check >+$Data::Session::errstr. >+ >+=head1 Global Variables >+ >+Global variables are not supported. This includes: >+ >+=over 4 >+ >+=item o $CGI::Session::Driver::DBI::TABLE_NAME >+ >+=item o $CGI::Session::Driver::DBI::*::TABLE_NAME >+ >+=item o $CGI::Session::Driver::file::FileName >+ >+=item o $CGI::Session::IP_MATCH >+ >+=item o $CGI::Session::NAME >+ >+=back >+ >+=head1 ID Generators >+ >+Id generator classes have been renamed: >+ >+=over 4 >+ >+=item o CGI::Session::ID::incr becomes L<Data::Session::ID::AutoIncrement> >+ >+=item o CGI::Session::ID::md5 becomes L<Data::Session::ID::MD5> >+ >+=item o CGI::Session::ID::sha becomes L<Data::Session::ID::SHA1> >+ >+=item o CGI::Session::ID::sha256 becomes L<Data::Session::ID::SHA256> >+ >+=item o CGI::Session::ID::sha512 becomes L<Data::Session::ID::SHA512> >+ >+=item o CGI::Session::ID::static becomes L<Data::Session::ID::Static> >+ >+=item o CGI::Session::ID::uuid becomes L<Data::Session::ID::UUID16> or UUID34 or UUID36 or UUD64 >+ >+=back >+ >+=head1 JSON >+ >+L<Data::Session::Serialize::JSON> uses L<JSON>, not L<JSON::Syck>. >+ >+=head2 Managing Object Attributes >+ >+The light-weight L<Hash::FieldHash> is used to manage object attributes. >+ >+So, neither L<Mouse> nor L<Moose>, nor any other such class helper, is used. >+ >+=head1 Method: cookie() >+ >+Forcing the query object to have a cookie method is not supported. You may now use a query class >+which does not provide a cookie method. >+ >+The logic of checking the cookie (if any) first (i.e. before checking for a form field of the same >+name) is supported. >+ >+See L</Method: http_header([@arg])>. >+ >+=head1 Method: http_header([@arg]) >+ >+The [] indicate an optional parameter. >+ >+Returns a HTTP header. This means it does not print the header. You have to do that, when >+appropriate. >+ >+Forcing the document type to be 'text/html' when calling http_header() is not supported. You must >+pass in a document type to http_header(), as $session -> http_header('-type' => 'text/html'), or >+use the query object's default. Both L<CGI> and L<CGI::Simple> default to 'text/html'. >+ >+L<Data::Session> handles the case where the query object does not have a cookie() method. >+ >+The @arg parameter, if any, is passed to the query object's header() method, after the cookie >+parameter, if any. >+ >+=head1 Method: load() >+ >+The new load() takes no parameters. >+ >+=head1 Method: new() >+ >+Excess versions of new() are not supported. >+ >+The new new() takes a hash of parameters. >+ >+This hash will include all options previously passed in in different parameters to new(), including >+$dsn, $query, $sid, \%dsn_args and \%session_params. >+ >+=head1 Name Changes >+ >+Class name changes are discussed in L</ID Generators>, L</Serialization Drivers> and >+L</Storage Drivers>. >+ >+As discussed in L<Data::Session/Method: new()>, these name changes are both the result of cleaning >+up all the options to new(), and because the option names are now also method names. >+ >+=over 4 >+ >+=item o DataColName becomes data_col_name >+ >+This is used in the call to new(). >+ >+=item o DataSource becomes data_source >+ >+This is used in the call to new(). >+ >+=item o generate_id becomes generate >+ >+This is used in various id generator classes, some of which provided generate as an alias. >+ >+=item o Handle becomes dbh >+ >+This is used in the call to new(). >+ >+=item o IdColName becomes id_col_name >+ >+This is used in the call to new(). >+ >+=item o IDFile becomes id_file >+ >+This is used in the call to new(), and in the '... id:AutoIncrement ...' id generator. >+ >+=item o IDIncr becomes id_step >+ >+This is used in the call to new(), and in the '... id:AutoIncrement ...' id generator. >+ >+=item o IDInit becomes id_base >+ >+This is used in the call to new(), and in the '... id:AutoIncrement ...' id generator. >+ >+=back >+ >+=head1 param() >+ >+Excess versions of param() will not be supported. >+ >+Use param($key => $value) to set and param($key) to get. >+ >+param() may be passed a hash, to set several key/value pairs in 1 call. >+ >+=head1 POD >+ >+All POD has been re-written. >+ >+=head1 Race Conditions >+ >+The race handling code in L<CGI::Session::Driver::postgresql> has been incorporated into other >+L<Data::Session::Driver::*> drivers. >+ >+=head1 Serialization Drivers >+ >+Serializing classes have been renamed: >+ >+=over 4 >+ >+=item o CGI::Session::Serialize::default becomes L<Data::Session::Serialize::DataDumper> >+ >+=item o CGI::Session::Serialize::freezethaw becomes L<Data::Session::Serialize::FreezeThaw> >+ >+=item o CGI::Session::Serialize::json becomes L<Data::Session::Serialize::JSON> >+ >+The latter will use L<JSON>. In the past L<JSON::Syck> was used. >+ >+=item o CGI::Session::Serialize::storable becomes L<Data::Session::Serialize::Storable> >+ >+=item o CGI::Session::Serialize::yaml becomes L<Data::Session::Serialize::YAML> >+ >+The latter uses L<YAML::Tiny>. In the past either L<YAML::Syck> or L<YAML> was used. >+ >+=back >+ >+=head1 Session ids will be mandatory >+ >+The ability to create a Perl object without a session id is not supported. >+ >+Every time a object of type L<Data::Session> is created, it must have an id. >+ >+This id is either supplied by the caller, taken from the query object, or one is generated. >+ >+See L<Data::Session/Specifying an Id> for details. >+ >+=head1 Session modification >+ >+L<CGI::Session> tracks calls to param() to set a flag if the object is modified, so as to avoid >+writing the session to disk if nothing has been modified. >+ >+This includes checking if setting a param's value to the value it already has. >+ >+The behaviour is supported. >+ >+=head1 Session Parameters >+ >+L<CGI::Session> had these internal object attributes (parameters) not available to the user: >+ >+=over 4 >+ >+=item o _DATA >+ >+Hashref: Keys: _SESSION_ATIME, _SESSION_CTIME, _SESSION_ID and _SESSION_REMOTE_ADDR. >+ >+=item o _DSN >+ >+Hashref. >+ >+=item o _OBJECTS >+ >+Hashref. >+ >+=item o _DRIVER_ARGS >+ >+Hashref. >+ >+=item o _CLAIMED_ID >+ >+Scalar. >+ >+=item o _STATUS >+ >+Scalar (bitmap). >+ >+=item o _QUERY >+ >+Scalar. >+ >+=back >+ >+L<Data::Session> has these internal object attributes (parameters): >+ >+=over 4 >+ >+=item o _SESSION_ATIME >+ >+Scalar: Last access time. >+ >+=item o _SESSION_CTIME >+ >+Scalar: Creation time. >+ >+=item o _SESSION_ETIME >+ >+Scalar: Expiry time. >+ >+=item o _SESSION_ID >+ >+Scalar: The id. >+ >+=item o _SESSION_PTIME >+ >+Hashref: Expiry times of parameters. >+ >+=back >+ >+L<Data::Session> stores user data internally in a hashref, and the module reserves keys starting >+with '_'. >+ >+Of course, it has a whole set of methods to manage state. >+ >+=head1 Session States >+ >+L<CGI::Session> objects can be one of 6 states. Every attempt has been made to simplify this design. >+ >+=head1 Storage Drivers >+ >+Classes related to DBI/DBD will use DBD::* style names, to help beginners. >+ >+Hence (with special cases): >+ >+=over 4 >+ >+=item o CGI::Session::Driver::db_file becomes L<Data::Session::Driver::BerkeleyDB> >+ >+The latter no longer uses DB_File. >+ >+=item o CGI::Session::Driver::file becomes L<Data::Session::Driver::File> >+ >+=item o CGI::Session::Driver::memcached becomes L<Data::Session::Driver::Memcached> >+ >+=item o CGI::Session::Driver::mysql becomes L<Data::Session::Driver::mysql> >+ >+=item o CGI::Session::Driver::odbc becomes L<Data::Session::Driver::ODBC> >+ >+=item o CGI::Session::Driver::oracle becomes L<Data::Session::Driver::Oracle> >+ >+=item o CGI::Session::Driver::postgresql becomes L<Data::Session::Driver::Pg> >+ >+=item o CGI::Session::Driver::sqlite becomes L<Data::Session::Driver::SQLite> >+ >+=back >+ >+=head1 Tests >+ >+All tests have been re-written. >+ >+=head1 The Version of Perl >+ >+Perl 5 code will be used. >+ >+=head1 YAML >+ >+L<Data::Session::Serialize::YAML> uses L<YAML::Tiny>, not L<YAML::Syck> or L<YAML>. >+ >+=head1 Author >+ >+L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010. >+ >+Home page: L<http://savage.net.au/index.html>. >+ >+=head1 Copyright >+ >+Australian copyright (c) 2010, Ron Savage. >+ >+ All Programs of mine are 'OSI Certified Open Source Software'; >+ you can redistribute them and/or modify them under the terms of >+ The Artistic License, a copy of which is available at: >+ http://www.opensource.org/licenses/index.html >+ >+=cut >diff --git a/lib/Data/Session/Driver.pm b/lib/Data/Session/Driver.pm >new file mode 100644 >index 00000000000..a50cf8371ed >--- /dev/null >+++ b/lib/Data/Session/Driver.pm >@@ -0,0 +1,224 @@ >+package Data::Session::Driver; >+ >+use parent 'Data::Session::Base'; >+no autovivification; >+use strict; >+use warnings; >+ >+use DBI; >+ >+use Hash::FieldHash ':all'; >+ >+fieldhash my %created_dbh => 'created_dbh'; >+ >+our $errstr = ''; >+our $VERSION = '1.18'; >+ >+# ----------------------------------------------- >+ >+sub DESTROY >+{ >+ my($self) = @_; >+ >+ (! $self -> dbh) && return; >+ >+ (! $self -> dbh -> ping) && die __PACKAGE__ . '. Database handle fails to ping'; >+ >+ (! ${$self -> dbh}{AutoCommit}) && $self -> dbh -> commit; >+ >+ if ($self -> created_dbh) >+ { >+ $self -> dbh -> disconnect; >+ $self -> created_dbh(0); >+ } >+ >+ $self -> dbh(''); >+ >+} # End of DESTROY. >+ >+# ----------------------------------------------- >+ >+sub get_dbh >+{ >+ my($self, $arg) = @_; >+ >+ if ($self -> dbh) >+ { >+ (ref $self -> dbh eq 'CODE') && $self -> dbh($self -> dbh -> () ); >+ } >+ else >+ { >+ $self -> dbh >+ ( >+ DBI -> connect >+ ( >+ $self -> data_source, >+ $self -> username, >+ $self -> password, >+ $self -> data_source_attr, >+ ) || die __PACKAGE__ . ". Can't connect to database with dsn '" . $self -> data_source . "'" >+ ); >+ $self -> created_dbh(1); >+ } >+ >+} # End of get_dbh. >+ >+# ----------------------------------------------- >+ >+sub init >+{ >+ my($class, $arg) = @_; >+ $$arg{created_dbh} = 0; >+ $$arg{data_col_name} ||= 'a_session'; >+ $$arg{data_source} ||= ''; >+ $$arg{data_source_attr} ||= {AutoCommit => 1, PrintError => 0, RaiseError => 1}; >+ $$arg{dbh} ||= ''; >+ $$arg{host} ||= ''; >+ $$arg{id} ||= 0; >+ $$arg{id_col_name} ||= 'id'; >+ $$arg{password} ||= ''; >+ $$arg{port} ||= ''; >+ $$arg{socket} ||= ''; >+ $$arg{table_name} ||= 'sessions'; >+ $$arg{username} ||= ''; >+ $$arg{verbose} ||= 0; >+ >+} # End of init. >+ >+# ----------------------------------------------- >+ >+sub remove >+{ >+ my($self, $id) = @_; >+ my($dbh) = $self -> dbh; >+ local $$dbh{RaiseError} = 1; >+ my($id_col_name) = $self -> id_col_name; >+ my($table_name) = $self -> table_name; >+ my($sql) = "delete from $table_name where $id_col_name = ?"; >+ >+ $dbh -> do($sql, {}, $id) || die __PACKAGE__ . ". Can't delete $id_col_name '$id' from table '$table_name'"; >+ >+ return 1; >+ >+} # End of remove. >+ >+# ----------------------------------------------- >+ >+sub retrieve >+{ >+ my($self, $id) = @_; >+ my($data_col_name) = $self -> data_col_name; >+ my($dbh) = $self -> dbh; >+ local $$dbh{RaiseError} = 1; >+ my($id_col_name) = $self -> id_col_name; >+ my($table_name) = $self -> table_name; >+ my($sql) = "select $data_col_name from $table_name where $id_col_name = ?"; >+ my($message) = __PACKAGE__ . "Can't %s in retrieve(). SQL: $sql"; >+ my($sth) = $dbh -> prepare_cached($sql, {}, 3) || die sprintf($message, 'prepare_cached'); >+ >+ $sth -> execute($id) || die sprintf($message, 'execute'); >+ >+ my($row) = $sth -> fetch; >+ >+ $sth -> finish; >+ >+ # Return '' for failure. >+ >+ return $row ? $$row[0] : ''; >+ >+} # End of retrieve. >+ >+# ----------------------------------------------- >+ >+sub traverse >+{ >+ my($self, $sub) = @_; >+ >+ if (! $sub || ref($sub) ne 'CODE') >+ { >+ die __PACKAGE__ . '. traverse() called without subref'; >+ } >+ >+ my($dbh) = $self -> dbh; >+ local $$dbh{RaiseError} = 1; >+ my($id_col_name) = $self -> id_col_name; >+ my($table_name) = $self -> table_name; >+ my($sql) = "select $id_col_name from $table_name"; >+ my($message) = __PACKAGE__ . "Can't %s in traverse(). SQL: $sql"; >+ my($id) = $dbh -> selectall_arrayref($sql, {}) || die sprintf($message, 'selectall_arrayref'); >+ >+ for my $i (0 .. $#$id) >+ { >+ $sub -> ($$id[$i][0]); >+ } >+ >+ return 1; >+ >+} # End of traverse. >+ >+# ----------------------------------------------- >+ >+1; >+ >+=pod >+ >+=head1 NAME >+ >+L<Data::Session::Driver> - A persistent session manager >+ >+=head1 Synopsis >+ >+See L<Data::Session> for details. >+ >+=head1 Description >+ >+L<Data::Session::Driver> is the parent of all L<Data::Session::Driver::*> modules. >+ >+=head1 Case-sensitive Options >+ >+See L<Data::Session/Case-sensitive Options> for important information. >+ >+=head1 Method: new() >+ >+Creates a new object of type L<Data::Session::Driver>. >+ >+C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations >+might be mandatory. >+ >+=head1 Method: remove($id) >+ >+Deletes from storage the session identified by $id, or dies if it can't. >+ >+Returns 1. >+ >+=head1 Method: retrieve($id) >+ >+Retrieve from storage the session identified by $id, or dies if it can't. >+ >+Returns the session. >+ >+This is a frozen session. This value must be thawed by calling the appropriate serialization >+driver's thaw() method. >+ >+L<Data::Session> calls the right thaw() automatically. >+ >+=head1 Support >+ >+Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>. >+ >+=head1 Author >+ >+L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010. >+ >+Home page: L<http://savage.net.au/index.html>. >+ >+=head1 Copyright >+ >+Australian copyright (c) 2010, Ron Savage. >+ >+ All Programs of mine are 'OSI Certified Open Source Software'; >+ you can redistribute them and/or modify them under the terms of >+ The Artistic License, a copy of which is available at: >+ http://www.opensource.org/licenses/index.html >+ >+=cut >diff --git a/lib/Data/Session/Driver/BerkeleyDB.pm b/lib/Data/Session/Driver/BerkeleyDB.pm >new file mode 100644 >index 00000000000..62df9629fe4 >--- /dev/null >+++ b/lib/Data/Session/Driver/BerkeleyDB.pm >@@ -0,0 +1,260 @@ >+package Data::Session::Driver::BerkeleyDB; >+ >+use parent 'Data::Session::Base'; >+no autovivification; >+use strict; >+use warnings; >+ >+use BerkeleyDB; >+ >+use Hash::FieldHash ':all'; >+ >+use Try::Tiny; >+ >+our $VERSION = '1.18'; >+ >+# ----------------------------------------------- >+ >+sub init >+{ >+ my($self, $arg) = @_; >+ $$arg{cache} ||= ''; >+ $$arg{verbose} ||= 0; >+ >+} # End of init. >+ >+# ----------------------------------------------- >+ >+sub new >+{ >+ my($class, %arg) = @_; >+ >+ $class -> init(\%arg); >+ >+ (! $arg{cache}) && die __PACKAGE__ . '. No cache supplied to new(...)'; >+ >+ return from_hash(bless({}, $class), \%arg); >+ >+} # End of new. >+ >+# ----------------------------------------------- >+ >+sub remove >+{ >+ my($self, $id) = @_; >+ my($lock) = $self -> cache -> cds_lock; >+ my($status) = $self -> cache -> db_del($id); >+ >+ $lock -> cds_unlock; >+ >+ # Return '' for failure. >+ >+ return $status ? '' : 1; >+ >+} # End of remove. >+ >+# ----------------------------------------------- >+ >+sub retrieve >+{ >+ my($self, $id) = @_; >+ my($lock) = $self -> cache -> cds_lock; >+ my($data) = ''; >+ my($status) = $self -> cache -> db_get($id => $data); >+ >+ $lock -> cds_unlock; >+ >+ # Return '' for failure. >+ >+ return $status ? '' : $data; >+ >+} # End of retrieve. >+ >+# ----------------------------------------------- >+ >+sub store >+{ >+ my($self, $id, $data) = @_; >+ my($lock) = $self -> cache -> cds_lock; >+ my($status) = $self -> cache -> db_put($id => $data); >+ >+ $lock -> cds_unlock; >+ >+ return $status ? '' : 1; >+ >+} # End of store. >+ >+# ----------------------------------------------- >+ >+sub traverse >+{ >+ my($self, $sub) = @_; >+ my($id, $data) = ('', ''); >+ my($cursor) = $self -> cache -> db_cursor; >+ >+ while ($cursor -> c_get($id, $data, DB_NEXT) == 0) >+ { >+ $sub -> ($id); >+ } >+ >+ undef $cursor; >+ >+ return 1; >+ >+} # End of traverse. >+ >+# ----------------------------------------------- >+ >+1; >+ >+=pod >+ >+=head1 NAME >+ >+L<Data::Session::Driver::BerkeleyDB> - A persistent session manager >+ >+=head1 Synopsis >+ >+See L<Data::Session> for details. >+ >+=head1 Description >+ >+L<Data::Session::Driver::BerkeleyDB> allows L<Data::Session> to manipulate sessions via >+L<BerkeleyDB>. >+ >+To use this module do both of these: >+ >+=over 4 >+ >+=item o Specify a driver of type BerkeleyDB, as >+Data::Session -> new(type => 'driver:BerkeleyDB ...') >+ >+=item o Specify a cache object of type L<BerkeleyDB> as Data::Session -> new(cache => $object) >+ >+Also, $object must have been created with a Env parameter of type L<BerkeleyDB::Env>. See below. >+ >+=back >+ >+See scripts/berkeleydb.pl. >+ >+=head1 Case-sensitive Options >+ >+See L<Data::Session/Case-sensitive Options> for important information. >+ >+=head1 Method: new() >+ >+Creates a new object of type L<Data::Session::Driver::BerkeleyDB>. >+ >+C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations >+might be mandatory. >+ >+The keys are listed here in alphabetical order. >+ >+They are lower-case because they are (also) method names, meaning they can be called to set or get >+the value at any time. >+ >+=over 4 >+ >+=item o cache => $object >+ >+Specifies the object of type L<BerkeleyDB> to use for session storage. >+ >+This key is normally passed in as Data::Session -> new(cache => $object). >+ >+Warning: This cache object must have been set up both as an object of type L<BerkeleyDB>, and with >+that object having an Env parameter of type L<Berkeley::Env>, because this module - >+L<Data::Session::Driver::BerkeleyDB> - uses the L<BerkeleyDB> method cds_lock(). >+ >+This key is mandatory. >+ >+=item o verbose => $integer >+ >+Print to STDERR more or less information. >+ >+Typical values are 0, 1 and 2. >+ >+This key is normally passed in as Data::Session -> new(verbose => $integer). >+ >+This key is optional. >+ >+=back >+ >+=head1 Method: remove($id) >+ >+Deletes from storage the session identified by $id. >+ >+Returns the result of calling the L<BerkeleyDB> method delete($id). >+ >+This result is a Boolean value indicating 1 => success or 0 => failure. >+ >+=head1 Method: retrieve($id) >+ >+Retrieve from storage the session identified by $id. >+ >+Returns the result of calling the L<BerkeleyDB> method get($id). >+ >+This result is a frozen session. This value must be thawed by calling the appropriate serialization >+driver's thaw() method. >+ >+L<Data::Session> calls the right thaw() automatically. >+ >+=head1 Method: store($id => $data) >+ >+Writes to storage the session identified by $id, together with its data $data. >+ >+Returns the result of calling the L<BerkeleyDB> method set($id => $data). >+ >+This result is a Boolean value indicating 1 => success or 0 => failure. >+ >+=head1 Method: traverse() >+ >+Retrieves all ids via a cursor, and for each id calls the supplied subroutine with the id as the >+only parameter. >+ >+The database is not locked during this process. >+ >+Returns 1. >+ >+=head1 Installing BerkeleyDB >+ >+ Get Oracle's BerkeleyDB from >+ http://www.oracle.com/technetwork/database/berkeleydb/overview/index.html >+ I used V 5.1.19 >+ tar xvzf db-5.1.19.tar.gz >+ cd db-5.1.19/build_unix >+ ../dist/configure >+ make >+ sudo make install >+ It installs into /usr/local/BerkeleyDB.5.1 >+ >+ Get Perl's BerkeleyDB from http://search.cpan.org >+ I used V 0.43 >+ tar xvzf BerkeleyDB-0.43.tar.gz >+ cd BerkeleyDB-0.43 >+ Edit 2 lines in config.in: >+ INCLUDE = /usr/local/BerkeleyDB.5.1/include >+ LIB = /usr/local/BerkeleyDB.5.1/lib >+ perl Makefile.PL >+ make && make test >+ sudo make install >+ >+=head1 Support >+ >+Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>. >+ >+=head1 Author >+ >+L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010. >+ >+Home page: L<http://savage.net.au/index.html>. >+ >+=head1 Copyright >+ >+Australian copyright (c) 2010, Ron Savage. >+ >+ All Programs of mine are 'OSI Certified Open Source Software'; >+ you can redistribute them and/or modify them under the terms of >+ The Artistic License, a copy of which is available at: >+ http://www.opensource.org/licenses/index.html >+ >+=cut >diff --git a/lib/Data/Session/Driver/File.pm b/lib/Data/Session/Driver/File.pm >new file mode 100644 >index 00000000000..8f8a7138cba >--- /dev/null >+++ b/lib/Data/Session/Driver/File.pm >@@ -0,0 +1,379 @@ >+package Data::Session::Driver::File; >+ >+use parent 'Data::Session::Base'; >+no autovivification; >+use strict; >+use warnings; >+ >+use Fcntl qw/:DEFAULT :flock :mode/; >+ >+use File::Path; >+use File::Spec; >+ >+use Hash::FieldHash ':all'; >+ >+use Try::Tiny; >+ >+our $VERSION = '1.18'; >+ >+# ----------------------------------------------- >+ >+sub get_file_path >+{ >+ my($self, $sid) = @_; >+ (my $id = $sid) =~ s|\\|/|g; >+ >+ ($id =~ m|/|) && die __PACKAGE__ . ". Session ids cannot contain \\ or /: '$sid'"; >+ >+ return File::Spec -> catfile($self -> directory, sprintf($self -> file_name, $sid) ); >+ >+} # End of get_file_path. >+ >+# ----------------------------------------------- >+ >+sub init >+{ >+ my($self, $arg) = @_; >+ $$arg{debug} ||= 0; >+ $$arg{directory} ||= File::Spec -> tmpdir; >+ $$arg{file_name} ||= 'cgisess_%s'; >+ $$arg{id} ||= 0; >+ $$arg{no_flock} ||= 0; >+ $$arg{no_follow} ||= eval { O_NOFOLLOW } || 0; >+ $$arg{umask} ||= 0660; >+ $$arg{verbose} ||= 0; >+ >+} # End of init. >+ >+# ----------------------------------------------- >+ >+sub new >+{ >+ my($class, %arg) = @_; >+ >+ $class -> init(\%arg); >+ >+ my($self) = from_hash(bless({}, $class), \%arg); >+ >+ ($self -> file_name !~ /%s/) && die __PACKAGE__ . ". file_name must contain %s"; >+ >+ if (! -d $self -> directory) >+ { >+ if (! File::Path::mkpath($self -> directory) ) >+ { >+ die __PACKAGE__ . ". Can't create directory '" . $self -> directory . "'"; >+ } >+ } >+ >+ return $self; >+ >+} # End of new. >+ >+# ----------------------------------------------- >+ >+sub remove >+{ >+ my($self, $id) = @_; >+ my($file_path) = $self -> get_file_path($id); >+ >+ unlink $file_path || die __PACKAGE__ . ". Can't unlink file '$file_path'. " . ($self -> debug ? $! : ''); >+ >+ return 1; >+ >+} # End of remove. >+ >+# ----------------------------------------------- >+ >+sub retrieve >+{ >+ my($self, $id) = @_; >+ my($file_path) = $self -> get_file_path($id); >+ my($message) = __PACKAGE__ . ". Can't %s file '$file_path'. %s"; >+ >+ (! -e $file_path) && return ''; >+ >+ # Remove symlinks if possible. >+ >+ if (-l $file_path) >+ { >+ unlink($file_path) || die sprintf($message, 'unlink', $self -> debug ? $! : ''); >+ } >+ >+ my($mode) = (O_RDWR | $self -> no_follow); >+ >+ my($fh); >+ >+ sysopen($fh, $file_path, $mode, $self -> umask) || die sprintf($message, 'open', $self -> debug ? $! : ''); >+ >+ # Sanity check. >+ >+ (-l $file_path) && die sprintf($message, "open it. It's a link, not a", ''); >+ >+ if (! $self -> no_flock) >+ { >+ flock($fh, LOCK_EX) || die sprintf($message, 'lock', $self -> debug ? $! : ''); >+ } >+ >+ my($data) = ''; >+ >+ while (<$fh>) >+ { >+ $data .= $_; >+ } >+ >+ close($fh) || die sprintf($message, 'close', $self -> debug ? $! : ''); >+ >+ return $data; >+ >+} # End of retrieve. >+ >+# ----------------------------------------------- >+ >+sub store >+{ >+ my($self, $id, $data) = @_; >+ my($file_path) = $self -> get_file_path($id); >+ my($message) = __PACKAGE__ . ". Can't %s file '$file_path'. %s"; >+ >+ # Remove symlinks if possible. >+ >+ if (-l $file_path) >+ { >+ unlink($file_path) || die sprintf($message, 'unlink', $self -> debug ? $! : ''); >+ } >+ >+ my($mode) = -e $file_path ? (O_WRONLY | $self -> no_follow) : (O_RDWR | O_CREAT | O_EXCL); >+ >+ my($fh); >+ >+ sysopen($fh, $file_path, $mode, $self -> umask) || die sprintf($message, 'open', $self -> debug ? $! : ''); >+ >+ # Sanity check. >+ >+ (-l $file_path) && die sprintf($message, "create it. It's a link, not a", ''); >+ >+ if (! $self -> no_flock) >+ { >+ flock($fh, LOCK_EX) || die sprintf($message, 'lock', $self -> debug ? $! : ''); >+ } >+ >+ seek($fh, 0, 0) || die sprintf($message, 'seek', $self -> debug ? $! : ''); >+ truncate($fh, 0) || die sprintf($message, 'truncate', $self -> debug ? $! : ''); >+ print $fh $data; >+ close($fh) || die sprintf($message, 'close', $self -> debug ? $! : ''); >+ >+ return 1; >+ >+} # End of store. >+ >+# ----------------------------------------------- >+ >+sub traverse >+{ >+ my($self, $sub) = @_; >+ >+ if (! $sub || ref($sub) ne 'CODE') >+ { >+ die __PACKAGE__ . '. traverse() called without subref'; >+ } >+ >+ my($pattern) = $self -> file_name; >+ $pattern =~ s/\./\\./g; # Or /\Q.../. >+ $pattern =~ s/%s/(\.\+)/; >+ my($message) = __PACKAGE__ . ". Can't %s dir '" . $self -> directory . "' in traverse. %s"; >+ >+ opendir(INX, $self -> directory) || die sprintf($message, 'open', $self -> debug ? $! : ''); >+ >+ my($entry); >+ >+ # I do not use readdir(INX) || die .. here because I could not get it to work, >+ # even with: while ($entry = (readdir(INX) || die sprintf($message, 'read', $!) ) ). >+ # Every attempt triggered the call to die. >+ >+ while ($entry = readdir(INX) ) >+ { >+ next if ($entry =~ /^\.\.?/ || -d $entry); >+ >+ ($entry =~ /$pattern/) && $sub -> ($1); >+ } >+ >+ closedir(INX) || die sprintf($message, 'close', $self -> debug ? $! : ''); >+ >+ return 1; >+ >+} # End of traverse. >+ >+# ----------------------------------------------- >+ >+1; >+ >+=pod >+ >+=head1 NAME >+ >+L<Data::Session::Driver::File> - A persistent session manager >+ >+=head1 Synopsis >+ >+See L<Data::Session> for details. >+ >+=head1 Description >+ >+L<Data::Session::Driver::File> allows L<Data::Session> to manipulate sessions via files. >+ >+To use this module do this: >+ >+=over 4 >+ >+=item o Specify a driver of type File, as Data::Session -> new(type => 'driver:File ...') >+ >+=back >+ >+=head1 Case-sensitive Options >+ >+See L<Data::Session/Case-sensitive Options> for important information. >+ >+=head1 Method: new() >+ >+Creates a new object of type L<Data::Session::Driver::File>. >+ >+C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations >+might be mandatory. >+ >+The keys are listed here in alphabetical order. >+ >+They are lower-case because they are (also) method names, meaning they can be called to set or get >+the value at any time. >+ >+=over 4 >+ >+=item o debug => $Boolean >+ >+Specifies that debugging should be turned on (1) or off (0) in L<Data::Session::File::Driver> and >+L<Data::Session::ID::AutoIncrement>. >+ >+When debug is 1, $! is included in error messages, but because this reveals directory names, it is 0 >+by default. >+ >+This key is optional. >+ >+Default: 0. >+ >+=item o directory => $string >+ >+Specifies the path to the directory which will contain the session files. >+ >+This key is normally passed in as Data::Session -> new(directory => $string). >+ >+Default: File::Spec -> tmpdir. >+ >+This key is optional. >+ >+=item o file_name => $string_containing_%s >+ >+Specifies the pattern to use for session file names. It must contain 1 '%s', which will be replaced >+by the session id before the pattern is used as a file name. >+ >+This key is normally passed in as Data::Session -> new(file_name => $string_containing_%s). >+ >+Default: 'cgisess_%s'. >+ >+This key is optional. >+ >+=item o no_flock => $boolean >+ >+Specifies (no_flock => 1) to not use flock() to obtain a lock on a session file before processing >+it, or (no_flock => 0) to use flock(). >+ >+This key is normally passed in as Data::Session -> new(no_flock => $boolean). >+ >+Default: 0. >+ >+This key is optional. >+ >+=item o no_follow => $value >+ >+Influences the mode to use when calling sysopen() on session files. >+ >+'Influences' means the value is bit-wise ored with O_RDWR for reading and with O_WRONLY for writing. >+ >+This key is normally passed in as Data::Session -> new(no_follow => $boolean). >+ >+Default: eval{O_NOFOLLOW} || 0. >+ >+This key is optional. >+ >+=item o umask => $octal_value >+ >+Specifies the mode to use when calling sysopen() on session files. >+ >+This key is normally passed in as Data::Session -> new(umask => $octal_value). >+ >+Default: 0660. >+ >+This key is optional. >+ >+=item o verbose => $integer >+ >+Print to STDERR more or less information. >+ >+Typical values are 0, 1 and 2. >+ >+This key is normally passed in as Data::Session -> new(verbose => $integer). >+ >+This key is optional. >+ >+=back >+ >+=head1 Method: remove($id) >+ >+Deletes from storage the session identified by $id. >+ >+Returns 1 if it succeeds, and dies if it can't. >+ >+=head1 Method: retrieve($id) >+ >+Retrieves from storage the session identified by $id, or dies if it can't. >+ >+Returns the result of reading the session from the file identified by $id. >+ >+This result is a frozen session. This value must be thawed by calling the appropriate serialization >+driver's thaw() method. >+ >+L<Data::Session> calls the right thaw() automatically. >+ >+=head1 Method: store($id => $data) >+ >+Writes to storage the session identified by $id, together with its data $data. >+ >+Storage is a file identified by $id. >+ >+Returns 1 if it succeeds, and dies if it can't. >+ >+=head1 Method: traverse($sub) >+ >+Retrieves all ids via their file names, and for each id calls the supplied subroutine with the id as >+the only parameter. >+ >+Returns 1. >+ >+=head1 Support >+ >+Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>. >+ >+=head1 Author >+ >+L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010. >+ >+Home page: L<http://savage.net.au/index.html>. >+ >+=head1 Copyright >+ >+Australian copyright (c) 2010, Ron Savage. >+ >+ All Programs of mine are 'OSI Certified Open Source Software'; >+ you can redistribute them and/or modify them under the terms of >+ The Artistic License, a copy of which is available at: >+ http://www.opensource.org/licenses/index.html >+ >+=cut >diff --git a/lib/Data/Session/Driver/Memcached.pm b/lib/Data/Session/Driver/Memcached.pm >new file mode 100644 >index 00000000000..0322d3a5fe6 >--- /dev/null >+++ b/lib/Data/Session/Driver/Memcached.pm >@@ -0,0 +1,227 @@ >+package Data::Session::Driver::Memcached; >+ >+use parent 'Data::Session::Base'; >+no autovivification; >+use strict; >+use warnings; >+ >+use Hash::FieldHash ':all'; >+ >+use Try::Tiny; >+ >+our $VERSION = '1.18'; >+ >+# ----------------------------------------------- >+ >+sub init >+{ >+ my($self, $arg) = @_; >+ $$arg{cache} ||= ''; >+ $$arg{verbose} ||= 0; >+ >+} # End of init. >+ >+# ----------------------------------------------- >+ >+sub new >+{ >+ my($class, %arg) = @_; >+ >+ $class -> init(\%arg); >+ >+ (! $arg{cache}) && die __PACKAGE__ . '. No cache supplied to new(...)'; >+ >+ return from_hash(bless({}, $class), \%arg); >+ >+} # End of new. >+ >+# ----------------------------------------------- >+ >+sub remove >+{ >+ my($self, $id) = @_; >+ >+ return $self -> cache -> delete($id); >+ >+} # End of remove. >+ >+# ----------------------------------------------- >+ >+sub retrieve >+{ >+ my($self, $id) = @_; >+ >+ # Return undef for failure. >+ >+ return $self -> cache -> get($id); >+ >+} # End of retrieve. >+ >+# ----------------------------------------------- >+ >+sub store >+{ >+ my($self, $id, $data, $time) = @_; >+ >+ return $self -> cache -> set($id, $data, $time); >+ >+} # End of store. >+ >+# ----------------------------------------------- >+ >+sub traverse >+{ >+ my($self, $sub) = @_; >+ >+ return 1; >+ >+} # End of traverse. >+ >+# ----------------------------------------------- >+ >+1; >+ >+=pod >+ >+=head1 NAME >+ >+L<Data::Session::Driver::Memcached> - A persistent session manager >+ >+=head1 Synopsis >+ >+See L<Data::Session> for details. >+ >+=head1 Description >+ >+L<Data::Session::Driver::Memcached> allows L<Data::Session> to manipulate sessions >+L<Cache::Memcached>. >+ >+To use this module do both of these: >+ >+=over 4 >+ >+=item o Specify a driver of type Memcached, as Data::Session -> new(type => 'driver:Memcached ...') >+ >+=item o Specify a cache object of type L<Cache::Memcached> as Data::Session -> new(cache => $object) >+ >+=back >+ >+See scripts/memcached.pl. >+ >+=head1 Case-sensitive Options >+ >+See L<Data::Session/Case-sensitive Options> for important information. >+ >+=head1 Method: new() >+ >+Creates a new object of type L<Data::Session::Driver::Memcached>. >+ >+C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations >+might be mandatory. >+ >+The keys are listed here in alphabetical order. >+ >+They are lower-case because they are (also) method names, meaning they can be called to set or get >+the value at any time. >+ >+=over 4 >+ >+=item o cache => $object >+ >+Specifies the object of type L<Cache::Memcached> to use for session storage. >+ >+This key is normally passed in as Data::Session -> new(cache => $object). >+ >+This key is mandatory. >+ >+=item o verbose => $integer >+ >+Print to STDERR more or less information. >+ >+Typical values are 0, 1 and 2. >+ >+This key is normally passed in as Data::Session -> new(verbose => $integer). >+ >+This key is optional. >+ >+=back >+ >+=head1 Method: remove($id) >+ >+Deletes from storage the session identified by $id. >+ >+Returns the result of calling the L<Cache::Memcached> method delete($id). >+ >+This result is a Boolean value indicating 1 => success or 0 => failure. >+ >+=head1 Method: retrieve($id) >+ >+Retrieve from storage the session identified by $id. >+ >+Returns the result of calling the L<Cache::Memcached> method get($id). >+ >+This result is a frozen session. This value must be thawed by calling the appropriate serialization >+driver's thaw() method. >+ >+L<Data::Session> calls the right thaw() automatically. >+ >+=head1 Method: store($id, $data, $time) >+ >+Writes to storage the session identified by $id, together with its data $data. The expiry time of >+the object is passed into the set() method of L<Cache::Memcached>, too. >+ >+Returns the result of calling the L<Cache::Memcached> method set($id, $data, $time). >+ >+This result is a Boolean value indicating 1 => success or 0 => failure. >+ >+Note: $time is 0 for sessions which don't expire. If you wish to pass undef or 'never', as per the >+L<Cache::Memcached> documentation, you will have to subclass L<Cache::Memcached> and override the >+set() method to change 0 to 'never'. >+ >+=head1 Method: traverse() >+ >+There is no mechanism (apart from memcached's debug code) to get a list of all keys in a cache >+managed by memcached, so there is no way to traverse them via this module. >+ >+Returns 1. >+ >+=head1 Installing memcached >+ >+ Get libevent from http://www.monkey.org/~provos/libevent/ >+ I used V 2.0.8-rc >+ ./configure >+ make && make verify >+ sudo make install >+ It installs into /usr/local/lib, so tell memcached where to look: >+ LD_LIBRARY_PATH=/usr/local/lib >+ export LD_LIBRARY_PATH >+ >+ Get memcached from http://memcached.org/ >+ I used V 1.4.5 >+ ./configure --with-libevent=/usr/local/lib >+ make && make test >+ sudo make install >+ >+ Running memcached: >+ memcached -m 5 & >+ >+=head1 Support >+ >+Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>. >+ >+=head1 Author >+ >+L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010. >+ >+Home page: L<http://savage.net.au/index.html>. >+ >+=head1 Copyright >+ >+Australian copyright (c) 2010, Ron Savage. >+ >+ All Programs of mine are 'OSI Certified Open Source Software'; >+ you can redistribute them and/or modify them under the terms of >+ The Artistic License, a copy of which is available at: >+ http://www.opensource.org/licenses/index.html >+ >+=cut >diff --git a/lib/Data/Session/Driver/ODBC.pm b/lib/Data/Session/Driver/ODBC.pm >new file mode 100644 >index 00000000000..e8b710ae675 >--- /dev/null >+++ b/lib/Data/Session/Driver/ODBC.pm >@@ -0,0 +1,269 @@ >+package Data::Session::Driver::ODBC; >+ >+use parent 'Data::Session::Driver'; >+no autovivification; >+use strict; >+use warnings; >+ >+use Hash::FieldHash ':all'; >+ >+use Try::Tiny; >+ >+our $VERSION = '1.18'; >+ >+# ----------------------------------------------- >+ >+sub new >+{ >+ my($class, %arg) = @_; >+ >+ $class -> init(\%arg); >+ >+ my($self) = from_hash(bless({}, $class), \%arg); >+ >+ $self -> get_dbh(\%arg); >+ >+ return $self; >+ >+} # End of new. >+ >+# ----------------------------------------------- >+ >+sub store >+{ >+ my($self, $id, $data) = @_; >+ my($data_col_name) = $self -> data_col_name; >+ my($dbh) = $self -> dbh; >+ local $$dbh{RaiseError} = 1; >+ my($id_col_name) = $self -> id_col_name; >+ my($table_name) = $self -> table_name; >+ my($sql) = "insert into $table_name ($data_col_name, $id_col_name) select ?, ? " . >+ "on duplicate key update $data_col_name = ?"; >+ >+ $dbh -> do($sql, {}, $data, $id, $data) || die __PACKAGE__ . ". $DBI::errstr"; >+ >+ return 1; >+ >+} # End of store. >+ >+# ----------------------------------------------- >+ >+1; >+ >+=pod >+ >+=head1 NAME >+ >+L<Data::Session::Driver::ODBC> - A persistent session manager >+ >+=head1 Synopsis >+ >+See L<Data::Session> for details. >+ >+=head1 Description >+ >+L<Data::Session::Driver::ODBC> allows L<Data::Session> to store sessions via L<DBD::ODBC>. >+ >+To use this module do both of these: >+ >+=over 4 >+ >+=item o Specify a driver of type ODBC, as Data::Session -> new(type => 'driver:ODBC ...') >+ >+=item o Specify a database handle as Data::Session -> new(dbh => $dbh), or a data source as >+Data::Session -> new(data_source => $string) >+ >+=back >+ >+=head1 Case-sensitive Options >+ >+See L<Data::Session/Case-sensitive Options> for important information. >+ >+=head1 Method: new() >+ >+Creates a new object of type L<Data::Session::Driver::ODBC>. >+ >+C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations >+might be mandatory. >+ >+The keys are listed here in alphabetical order. >+ >+They are lower-case because they are (also) method names, meaning they can be called to set or get >+the value at any time. >+ >+=over 4 >+ >+=item o data_col_name => $string >+ >+Specifes the name of the column in the sessions table which holds the session data. >+ >+This key is normally passed in as Data::Session -> new(data_col_name => $string). >+ >+Default: 'a_session'. >+ >+This key is optional. >+ >+=item o data_source => $string >+ >+Specifies the data source (as used by >+DBI -> connect($data_source, $username, $password, $data_source_attr) ) to obtain a database handle. >+ >+This key is normally passed in as Data::Session -> new(data_source => $string). >+ >+Default: ''. >+ >+This key is optional, as long as a value is supplied for 'dbh'. >+ >+=item o data_source_attr => $string >+ >+Specifies the attributes (as used by >+DBI -> connect($data_source, $username, $password, $data_source_attr) ) to obtain a database handle. >+ >+This key is normally passed in as Data::Session -> new(data_source_attr => $string). >+ >+Default: {AutoCommit => 1, PrintError => 0, RaiseError => 1}. >+ >+This key is optional. >+ >+=item o dbh => $dbh >+ >+Specifies the database handle to use to access the sessions table. >+ >+This key is normally passed in as Data::Session -> new(dbh => $dbh). >+ >+If not specified, this module will use the values of these keys to obtain a database handle: >+ >+=over 4 >+ >+=item o data_source >+ >+=item o data_source_attr >+ >+=item o username >+ >+=item o password >+ >+=back >+ >+Default: ''. >+ >+This key is optional. >+ >+=item o host => $string >+ >+Not used. >+ >+=item o id_col_name => $string >+ >+Specifes the name of the column in the sessions table which holds the session id. >+ >+This key is normally passed in as Data::Session -> new(id_col_name => $string). >+ >+Default: 'id'. >+ >+This key is optional. >+ >+=item o password => $string >+ >+Specifies the password (as used by >+DBI -> connect($data_source, $username, $password, $data_source_attr) ) to obtain a database handle. >+ >+This key is normally passed in as Data::Session -> new(password => $string). >+ >+Default: ''. >+ >+This key is optional. >+ >+=item o port => $string >+ >+Not used. >+ >+=item o socket => $string >+ >+Not used. >+ >+=item o table_name => $string >+ >+Specifes the name of the sessions table. >+ >+This key is normally passed in as Data::Session -> new(table_name => $string). >+ >+Default: 'sessions'. >+ >+This key is optional. >+ >+=item o username => $string >+ >+Specifies the username (as used by >+DBI -> connect($data_source, $username, $password, $data_source_attr) ) to obtain a database handle. >+ >+This key is normally passed in as Data::Session -> new(username => $string). >+ >+Default: ''. >+ >+This key is optional. >+ >+=item o verbose => $integer >+ >+Print to STDERR more or less information. >+ >+Typical values are 0, 1 and 2. >+ >+This key is normally passed in as Data::Session -> new(verbose => $integer). >+ >+This key is optional. >+ >+=back >+ >+=head1 Method: remove($id) >+ >+Deletes from storage the session identified by $id, or dies if it can't. >+ >+Returns 1. >+ >+=head1 Method: retrieve($id) >+ >+Retrieve from storage the session identified by $id, or dies if it can't. >+ >+Returns the session. >+ >+This is a frozen session. This value must be thawed by calling the appropriate serialization >+driver's thaw() method. >+ >+L<Data::Session> calls the right thaw() automatically. >+ >+=head1 Method: store($id => $data) >+ >+Writes to storage the session identified by $id, together with its data $data, or dies if it can't. >+ >+Returns 1. >+ >+=head1 Method: traverse() >+ >+Retrieves all ids from the sessions table, and for each id calls the supplied subroutine with the >+id as the only parameter. >+ >+$dbh -> selectall_arrayref is used, and the table is not locked. >+ >+Returns 1. >+ >+=head1 Support >+ >+Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>. >+ >+=head1 Author >+ >+L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010. >+ >+Home page: L<http://savage.net.au/index.html>. >+ >+=head1 Copyright >+ >+Australian copyright (c) 2010, Ron Savage. >+ >+ All Programs of mine are 'OSI Certified Open Source Software'; >+ you can redistribute them and/or modify them under the terms of >+ The Artistic License, a copy of which is available at: >+ http://www.opensource.org/licenses/index.html >+ >+=cut >diff --git a/lib/Data/Session/Driver/Oracle.pm b/lib/Data/Session/Driver/Oracle.pm >new file mode 100644 >index 00000000000..4ebca21ec39 >--- /dev/null >+++ b/lib/Data/Session/Driver/Oracle.pm >@@ -0,0 +1,269 @@ >+package Data::Session::Driver::Oracle; >+ >+use parent 'Data::Session::Driver'; >+no autovivification; >+use strict; >+use warnings; >+ >+use Hash::FieldHash ':all'; >+ >+use Try::Tiny; >+ >+our $VERSION = '1.18'; >+ >+# ----------------------------------------------- >+ >+sub new >+{ >+ my($class, %arg) = @_; >+ >+ $class -> init(\%arg); >+ >+ my($self) = from_hash(bless({}, $class), \%arg); >+ >+ $self -> get_dbh(\%arg); >+ >+ return $self; >+ >+} # End of new. >+ >+# ----------------------------------------------- >+ >+sub store >+{ >+ my($self, $id, $data) = @_; >+ my($data_col_name) = $self -> data_col_name; >+ my($dbh) = $self -> dbh; >+ local $$dbh{RaiseError} = 1; >+ my($id_col_name) = $self -> id_col_name; >+ my($table_name) = $self -> table_name; >+ my($sql) = "insert into $table_name ($data_col_name, $id_col_name) select ?, ? " . >+ "on duplicate key update $data_col_name = ?"; >+ >+ $dbh -> do($sql, {}, $data, $id, $data) || die __PACKAGE__ . ". $DBI::errstr"; >+ >+ return 1; >+ >+} # End of store. >+ >+# ----------------------------------------------- >+ >+1; >+ >+=pod >+ >+=head1 NAME >+ >+L<Data::Session::Driver::Oracle> - A persistent session manager >+ >+=head1 Synopsis >+ >+See L<Data::Session> for details. >+ >+=head1 Description >+ >+L<Data::Session::Driver::Oracle> allows L<Data::Session> to store sessions via L<DBD::Oracle>. >+ >+To use this module do both of these: >+ >+=over 4 >+ >+=item o Specify a driver of type Oracle, as Data::Session -> new(type => 'driver:Oracle ...') >+ >+=item o Specify a database handle as Data::Session -> new(dbh => $dbh) or a data source as >+Data::Session -> new(data_source => $string) >+ >+=back >+ >+=head1 Case-sensitive Options >+ >+See L<Data::Session/Case-sensitive Options> for important information. >+ >+=head1 Method: new() >+ >+Creates a new object of type L<Data::Session::Driver::Oracle>. >+ >+C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations >+might be mandatory. >+ >+The keys are listed here in alphabetical order. >+ >+They are lower-case because they are (also) method names, meaning they can be called to set or get >+the value at any time. >+ >+=over 4 >+ >+=item o data_col_name => $string >+ >+Specifes the name of the column in the sessions table which holds the session data. >+ >+This key is normally passed in as Data::Session -> new(data_col_name => $string). >+ >+Default: 'a_session'. >+ >+This key is optional. >+ >+=item o data_source => $string >+ >+Specifies the data source (as used by DBI -> connect($data_source, $username, $password, $attr) ) to >+obtain a database handle. >+ >+This key is normally passed in as Data::Session -> new(data_source => $string). >+ >+Default: ''. >+ >+This key is optional, as long as a value is supplied for 'dbh'. >+ >+=item o data_source_attr => $string >+ >+Specifies the attributes (as used by >+DBI -> connect($data_source, $username, $password, $data_source_attr) ) to obtain a database handle. >+ >+This key is normally passed in as Data::Session -> new(data_source_attr => $string). >+ >+Default: {AutoCommit => 1, PrintError => 0, RaiseError => 1}. >+ >+This key is optional. >+ >+=item o dbh => $dbh >+ >+Specifies the database handle to use to access the sessions table. >+ >+This key is normally passed in as Data::Session -> new(dbh => $dbh). >+ >+If not specified, this module will use the values of these keys to obtain a database handle: >+ >+=over 4 >+ >+=item o data_source >+ >+=item o data_source_attr >+ >+=item o username >+ >+=item o password >+ >+=back >+ >+Default: ''. >+ >+This key is optional. >+ >+=item o host => $string >+ >+Not used. >+ >+=item o id_col_name => $string >+ >+Specifes the name of the column in the sessions table which holds the session id. >+ >+This key is normally passed in as Data::Session -> new(id_col_name => $string). >+ >+Default: 'id'. >+ >+This key is optional. >+ >+=item o password => $string >+ >+Specifies the password (as used by >+DBI -> connect($data_source, $username, $password, $data_source_attr) ) to obtain a database handle. >+ >+This key is normally passed in as Data::Session -> new(password => $string). >+ >+Default: ''. >+ >+This key is optional. >+ >+=item o port => $string >+ >+Not used. >+ >+=item o socket => $string >+ >+Not used. >+ >+=item o table_name => $string >+ >+Specifes the name of the sessions table. >+ >+This key is normally passed in as Data::Session -> new(table_name => $string). >+ >+Default: 'sessions'. >+ >+This key is optional. >+ >+=item o username => $string >+ >+Specifies the username (as used by >+DBI -> connect($data_source, $username, $password, $data_source_attr) ) to obtain a database handle. >+ >+This key is normally passed in as Data::Session -> new(username => $string). >+ >+Default: ''. >+ >+This key is optional. >+ >+=item o verbose => $integer >+ >+Print to STDERR more or less information. >+ >+Typical values are 0, 1 and 2. >+ >+This key is normally passed in as Data::Session -> new(verbose => $integer). >+ >+This key is optional. >+ >+=back >+ >+=head1 Method: remove($id) >+ >+Deletes from storage the session identified by $id, or dies if it can't. >+ >+Returns 1. >+ >+=head1 Method: retrieve($id) >+ >+Retrieve from storage the session identified by $id, or dies if it can't. >+ >+Returns the session. >+ >+This is a frozen session. This value must be thawed by calling the appropriate serialization >+driver's thaw() method. >+ >+L<Data::Session> calls the right thaw() automatically. >+ >+=head1 Method: store($id => $data) >+ >+Writes to storage the session identified by $id, together with its data $data, or dies if it can't. >+ >+Returns 1. >+ >+=head1 Method: traverse() >+ >+Retrieves all ids from the sessions table, and for each id calls the supplied subroutine with the id >+as the only parameter. >+ >+$dbh -> selectall_arrayref is used, and the table is not locked. >+ >+Returns 1. >+ >+=head1 Support >+ >+Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>. >+ >+=head1 Author >+ >+L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010. >+ >+Home page: L<http://savage.net.au/index.html>. >+ >+=head1 Copyright >+ >+Australian copyright (c) 2010, Ron Savage. >+ >+ All Programs of mine are 'OSI Certified Open Source Software'; >+ you can redistribute them and/or modify them under the terms of >+ The Artistic License, a copy of which is available at: >+ http://www.opensource.org/licenses/index.html >+ >+=cut >diff --git a/lib/Data/Session/Driver/Pg.pm b/lib/Data/Session/Driver/Pg.pm >new file mode 100644 >index 00000000000..02e5923be07 >--- /dev/null >+++ b/lib/Data/Session/Driver/Pg.pm >@@ -0,0 +1,363 @@ >+package Data::Session::Driver::Pg; >+ >+use parent 'Data::Session::Driver'; >+no autovivification; >+use strict; >+use warnings; >+ >+use DBD::Pg qw(PG_BYTEA PG_TEXT); >+ >+use Hash::FieldHash ':all'; >+ >+use Try::Tiny; >+ >+our $VERSION = '1.18'; >+ >+# ----------------------------------------------- >+ >+sub init >+{ >+ my($self, $arg) = @_; >+ >+ $self -> SUPER::init($arg); >+ >+ $$arg{pg_bytea} ||= 0; >+ $$arg{pg_text} ||= 0; >+ >+ if ($$arg{pg_bytea} == 0 && $$arg{pg_text} == 0) >+ { >+ $$arg{pg_bytea} = 1; >+ } >+ elsif ($$arg{pg_bytea} == 1 && $$arg{pg_text} == 1) >+ { >+ $$arg{pg_text} = 0; >+ } >+ >+} # End of init. >+ >+# ----------------------------------------------- >+ >+sub new >+{ >+ my($class, %arg) = @_; >+ >+ $class -> init(\%arg); >+ >+ my($self) = from_hash(bless({}, $class), \%arg); >+ >+ $self -> get_dbh(\%arg); >+ >+ return $self; >+ >+} # End of new. >+ >+# ----------------------------------------------- >+ >+sub store >+{ >+ my($self, $id, $data) = @_; >+ my($data_col_name) = $self -> data_col_name; >+ my($dbh) = $self -> dbh; >+ local $$dbh{RaiseError} = 1; >+ my($id_col_name) = $self -> id_col_name; >+ my($table_name) = $self -> table_name; >+ >+ # There is a race condition were two clients could run this code concurrently, >+ # and both end up trying to insert. That's why we check for "duplicate" below >+ >+ try >+ { >+ my($sql) = "insert into $table_name ($data_col_name, $id_col_name) select ?, ? " . >+ "where not exists (select 1 from $table_name where $id_col_name = ? limit 1)"; >+ my($sth) = $dbh -> prepare($sql); >+ >+ $sth -> bind_param(1, $data, {pg_type => $self -> pg_bytea ? PG_BYTEA : PG_TEXT}); >+ $sth -> bind_param(2, $id); >+ $sth -> bind_param(3, $id); >+ >+ my($rv); >+ >+ try >+ { >+ $rv = $sth -> execute; >+ >+ ($rv eq '0E0') && $self -> update($dbh, $table_name, $id_col_name, $data_col_name, $id, $data); >+ } >+ catch >+ { >+ if ($_ =~ /duplicate/) >+ { >+ $self -> update($dbh, $table_name, $id_col_name, $data_col_name, $id, $data); >+ } >+ else >+ { >+ die __PACKAGE__ . ". $_"; >+ } >+ }; >+ >+ $sth -> finish; >+ } >+ catch >+ { >+ die __PACKAGE__ . ". $_"; >+ }; >+ >+ return 1; >+ >+} # End of store. >+ >+# ----------------------------------------------- >+ >+sub update >+{ >+ my($self, $dbh, $table_name, $id_col_name, $data_col_name, $id, $data) = @_; >+ my($sql) = "update $table_name set $data_col_name = ? where $id_col_name = ?"; >+ my($sth) = $dbh -> prepare($sql); >+ >+ $sth -> bind_param(1, $data, {pg_type => $self -> pg_bytea ? PG_BYTEA : PG_TEXT}); >+ $sth -> bind_param(2, $id); >+ >+ $sth -> execute; >+ $sth -> finish; >+ >+ return 1; >+ >+} # End of update. >+ >+# ----------------------------------------------- >+ >+1; >+ >+=pod >+ >+=head1 NAME >+ >+L<Data::Session::Driver::Pg> - A persistent session manager >+ >+=head1 Synopsis >+ >+See L<Data::Session> for details. >+ >+=head1 Description >+ >+L<Data::Session::Driver::Pg> allows L<Data::Session> to manipulate sessions via L<DBD::Pg>. >+ >+To use this module do both of these: >+ >+=over 4 >+ >+=item o Specify a driver of type Pg, as Data::Session -> new(type => 'driver:Pg ...') >+ >+=item o Specify a database handle as Data::Session -> new(dbh => $dbh) or a data source as >+Data::Session -> new(data_source => $string) >+ >+=back >+ >+=head1 Case-sensitive Options >+ >+See L<Data::Session/Case-sensitive Options> for important information. >+ >+=head1 Method: new() >+ >+Creates a new object of type L<Data::Session::Driver::Pg>. >+ >+C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations >+might be mandatory. >+ >+The keys are listed here in alphabetical order. >+ >+They are lower-case because they are (also) method names, meaning they can be called to set or get >+the value at any time. >+ >+=over 4 >+ >+=item o data_col_name => $string >+ >+Specifes the name of the column in the sessions table which holds the session data. >+ >+This key is normally passed in as Data::Session -> new(data_col_name => $string). >+ >+Default: 'a_session'. >+ >+This key is optional. >+ >+=item o data_source => $string >+ >+Specifies the data source (as used by >+DBI -> connect($data_source, $username, $password, $data_source_attr) ) to obtain a database handle. >+ >+This key is normally passed in as Data::Session -> new(data_source => $string). >+ >+Default: ''. >+ >+This key is optional, as long as a value is supplied for 'dbh'. >+ >+=item o data_source_attr => $hashref >+ >+Specifies the attributes (as used by >+DBI -> connect($data_source, $username, $password, $data_source_attr) ) to obtain a database handle. >+ >+This key is normally passed in as Data::Session -> new(data_source_attr => $hashref). >+ >+Default: {AutoCommit => 1, PrintError => 0, RaiseError => 1}. >+ >+This key is optional. >+ >+=item o dbh => $dbh >+ >+Specifies the database handle to use to access the sessions table. >+ >+This key is normally passed in as Data::Session -> new(dbh => $dbh). >+ >+If not specified, this module will use the values of these keys to obtain a database handle: >+ >+=over 4 >+ >+=item o data_source >+ >+=item o data_source_attr >+ >+=item o username >+ >+=item o password >+ >+=back >+ >+Default: ''. >+ >+This key is optional. >+ >+=item o host => $string >+ >+Not used. >+ >+=item o id_col_name => $string >+ >+Specifes the name of the column in the sessions table which holds the session id. >+ >+This key is normally passed in as Data::Session -> new(id_col_name => $string). >+ >+Default: 'id'. >+ >+This key is optional. >+ >+=item o password => $string >+ >+Specifies the password (as used by >+DBI -> connect($data_source, $username, $password, $data_source_attr) ) to obtain a database handle. >+ >+This key is normally passed in as Data::Session -> new(password => $string). >+ >+Default: ''. >+ >+This key is optional. >+ >+=item o pg_bytea => $boolean >+ >+Specifies (if pg_bytea => 1) that the a_session column in the sessions table is of type bytea. >+ >+This key is normally passed in as Data::Session -> new(pg_bytea => $boolean). >+ >+If both 'pg_bytea' and 'pg_text' are set to 1, 'pg_text' is forced to be 0. >+ >+If both 'pg_bytea' and 'pg_text' are set to 0, 'pg_bytea' is forced to be 1. >+ >+=item o pg_text => $boolean >+ >+Specifies (if pg_text => 1) that the a_session column in the sessions table is of type text. >+ >+This key is normally passed in as Data::Session -> new(pg_text => $boolean). >+ >+=item o port => $string >+ >+Not used. >+ >+=item o socket => $string >+ >+Not used. >+ >+=item o table_name => $string >+ >+Specifes the name of the sessions table. >+ >+This key is normally passed in as Data::Session -> new(table_name => $string). >+ >+Default: 'sessions'. >+ >+This key is optional. >+ >+=item o username => $string >+ >+Specifies the username (as used by >+DBI -> connect($data_source, $username, $password, $data_source_attr) ) to obtain a database handle. >+ >+This key is normally passed in as Data::Session -> new(username => $string). >+ >+Default: ''. >+ >+This key is optional. >+ >+=item o verbose => $integer >+ >+Print to STDERR more or less information. >+ >+This key is normally passed in as Data::Session -> new(verbose => $integer). >+ >+Typical values are 0, 1 and 2. >+ >+This key is optional. >+ >+=back >+ >+=head1 Method: remove($id) >+ >+Deletes from storage the session identified by $id, or dies if it can't. >+ >+Returns 1. >+ >+=head1 Method: retrieve($id) >+ >+Retrieve from storage the session identified by $id, or dies if it can't. >+ >+Returns the session. >+ >+This is a frozen session. This value must be thawed by calling the appropriate serialization >+driver's thaw() method. >+ >+L<Data::Session> calls the right thaw() automatically. >+ >+=head1 Method: store($id => $data) >+ >+Writes to storage the session identified by $id, together with its data $data, or dies if it can't. >+ >+$dbh -> selectall_arrayref is used, and the table is not locked. >+ >+Returns 1. >+ >+=head1 Method: traverse() >+ >+Retrieves all ids from the sessions table, and for each id calls the supplied subroutine with the id >+as the only parameter. >+ >+Returns 1. >+ >+=head1 Support >+ >+Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>. >+ >+=head1 Author >+ >+L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010. >+ >+Home page: L<http://savage.net.au/index.html>. >+ >+=head1 Copyright >+ >+Australian copyright (c) 2010, Ron Savage. >+ >+ All Programs of mine are 'OSI Certified Open Source Software'; >+ you can redistribute them and/or modify them under the terms of >+ The Artistic License, a copy of which is available at: >+ http://www.opensource.org/licenses/index.html >+ >+=cut >diff --git a/lib/Data/Session/Driver/SQLite.pm b/lib/Data/Session/Driver/SQLite.pm >new file mode 100644 >index 00000000000..90a261cbe6d >--- /dev/null >+++ b/lib/Data/Session/Driver/SQLite.pm >@@ -0,0 +1,330 @@ >+package Data::Session::Driver::SQLite; >+ >+use parent 'Data::Session::Driver'; >+no autovivification; >+use strict; >+use warnings; >+ >+use DBI qw(SQL_BLOB); >+ >+use Hash::FieldHash ':all'; >+ >+use Try::Tiny; >+ >+our $VERSION = '1.18'; >+ >+# ----------------------------------------------- >+ >+sub new >+{ >+ my($class, %arg) = @_; >+ >+ $class -> init(\%arg); >+ >+ my($self) = from_hash(bless({}, $class), \%arg); >+ >+ $self -> get_dbh(\%arg); >+ >+ my($dbh) = $self -> dbh; >+ $$dbh{sqlite_handle_binary_nulls} = 1; >+ >+ $self -> dbh($dbh); >+ >+ return $self; >+ >+} # End of new. >+ >+# ----------------------------------------------- >+ >+sub store >+{ >+ my($self, $id, $data) = @_; >+ my($data_col_name) = $self -> data_col_name; >+ my($dbh) = $self -> dbh; >+ local $$dbh{RaiseError} = 1; >+ my($id_col_name) = $self -> id_col_name; >+ my($table_name) = $self -> table_name; >+ >+ # There is a race condition were two clients could run this code concurrently, >+ # and both end up trying to insert. That's why we check for "duplicate" below >+ >+ try >+ { >+ my($sql) = "insert into $table_name ($data_col_name, $id_col_name) select ?, ? " . >+ "where not exists (select 1 from $table_name where $id_col_name = ? limit 1)"; >+ my($sth) = $dbh -> prepare($sql); >+ >+ $sth -> bind_param(1, $data, SQL_BLOB); >+ $sth -> bind_param(2, $id); >+ $sth -> bind_param(3, $id); >+ >+ my($rv); >+ >+ try >+ { >+ $rv = $sth -> execute; >+ >+ ($rv eq '0E0') && $self -> update($dbh, $table_name, $id_col_name, $data_col_name, $id, $data); >+ } >+ catch >+ { >+ if ($_ =~ /Error: .+ is not unique/) >+ { >+ $self -> update($dbh, $table_name, $id_col_name, $data_col_name, $id, $data); >+ } >+ else >+ { >+ die __PACKAGE__ . ". $_"; >+ } >+ }; >+ >+ $sth -> finish; >+ } >+ catch >+ { >+ die __PACKAGE__ . ". $_"; >+ }; >+ >+ return 1; >+ >+} # End of store. >+ >+# ----------------------------------------------- >+ >+sub update >+{ >+ my($self, $dbh, $table_name, $id_col_name, $data_col_name, $id, $data) = @_; >+ my($sql) = "update $table_name set $data_col_name = ? where $id_col_name = ?"; >+ my($sth) = $dbh -> prepare($sql); >+ >+ $sth -> bind_param(1, $data, SQL_BLOB); >+ $sth -> bind_param(2, $id); >+ >+ $sth -> execute; >+ $sth -> finish; >+ >+} # End of update. >+ >+# ----------------------------------------------- >+ >+1; >+ >+=pod >+ >+=head1 NAME >+ >+L<Data::Session::Driver::SQLite> - A persistent session manager >+ >+=head1 Synopsis >+ >+See L<Data::Session> for details. >+ >+=head1 Description >+ >+L<Data::Session::Driver::SQLite> allows L<Data::Session> to manipulate sessions via L<DBD::SQLite>. >+ >+To use this module do both of these: >+ >+=over 4 >+ >+=item o Specify a driver of type SQLite, as Data::Session -> new(type => 'driver:SQLite ...') >+ >+=item o Specify a database handle as Data::Session -> new(dbh => $dbh) or a data source as >+Data::Session -> new(data_source => $string) >+ >+=back >+ >+See scripts/sqlite.pl. >+ >+=head1 Case-sensitive Options >+ >+See L<Data::Session/Case-sensitive Options> for important information. >+ >+=head1 Method: new() >+ >+Creates a new object of type L<Data::Session::Driver::SQLite>. >+ >+C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations >+might be mandatory. >+ >+The keys are listed here in alphabetical order. >+ >+They are lower-case because they are (also) method names, meaning they can be called to set or get >+the value at any time. >+ >+=over 4 >+ >+=item o data_col_name => $string >+ >+Specifes the name of the column in the sessions table which holds the session data. >+ >+This key is normally passed in as Data::Session -> new(data_col_name => $string). >+ >+Default: 'a_session'. >+ >+This key is optional. >+ >+=item o data_source => $string >+ >+Specifies the data source (as used by >+DBI -> connect($data_source, $username, $password, $data_source_attr) ) to obtain a database handle. >+ >+This key is normally passed in as Data::Session -> new(data_source => $string). >+ >+Default: ''. >+ >+This key is optional, as long as a value is supplied for 'dbh'. >+ >+=item o data_source_attr => $string >+ >+Specifies the attributes (as used by >+DBI -> connect($data_source, $username, $password, $data_source_attr) ) to obtain a database handle. >+ >+This key is normally passed in as Data::Session -> new(data_source_attr => $string). >+ >+Default: {AutoCommit => 1, PrintError => 0, RaiseError => 1}. >+ >+This key is optional. >+ >+=item o dbh => $dbh >+ >+Specifies the database handle to use to access the sessions table. >+ >+This key is normally passed in as Data::Session -> new(dbh => $dbh). >+ >+If not specified, this module will use the values of these keys to obtain a database handle: >+ >+=over 4 >+ >+=item o data_source >+ >+=item o data_source_attr >+ >+=item o username >+ >+=item o password >+ >+=back >+ >+Default: ''. >+ >+This key is optional. >+ >+=item o host => $string >+ >+Not used. >+ >+=item o id_col_name => $string >+ >+Specifes the name of the column in the sessions table which holds the session id. >+ >+This key is normally passed in as Data::Session -> new(id_col_name => $string). >+ >+Default: 'id'. >+ >+This key is optional. >+ >+=item o password => $string >+ >+Specifies the password (as used by >+DBI -> connect($data_source, $username, $password, $data_source_attr) ) to obtain a database handle. >+ >+This key is normally passed in as Data::Session -> new(password => $string). >+ >+Default: ''. >+ >+This key is optional. >+ >+=item o port => $string >+ >+Not used. >+ >+=item o socket => $string >+ >+Not used. >+ >+=item o table_name => $string >+ >+Specifes the name of the sessions table. >+ >+This key is normally passed in as Data::Session -> new(table_name => $string). >+ >+Default: 'sessions'. >+ >+This key is optional. >+ >+=item o username => $string >+ >+Specifies the username (as used by >+DBI -> connect($data_source, $username, $password, $data_source_attr) ) to obtain a database handle. >+ >+This key is normally passed in as Data::Session -> new(username => $string). >+ >+Default: ''. >+ >+This key is optional. >+ >+=item o verbose => $integer >+ >+Print to STDERR more or less information. >+ >+Typical values are 0, 1 and 2. >+ >+This key is normally passed in as Data::Session -> new(verbose => $integer). >+ >+This key is optional. >+ >+=back >+ >+=head1 Method: remove($id) >+ >+Deletes from storage the session identified by $id, or dies if it can't. >+ >+Returns 1. >+ >+=head1 Method: retrieve($id) >+ >+Retrieve from storage the session identified by $id, or dies if it can't. >+ >+Returns the session. >+ >+This is a frozen session. This value must be thawed by calling the appropriate serialization >+driver's thaw() method. >+ >+L<Data::Session> calls the right thaw() automatically. >+ >+=head1 Method: store($id => $data) >+ >+Writes to storage the session identified by $id, together with its data $data, or dies if it can't. >+ >+Returns 1. >+ >+=head1 Method: traverse() >+ >+Retrieves all ids from the sessions table, and for each id calls the supplied subroutine with the id >+as the only parameter. >+ >+$dbh -> selectall_arrayref is used, and the table is not locked. >+ >+Returns 1. >+ >+=head1 Support >+ >+Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>. >+ >+=head1 Author >+ >+L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010. >+ >+Home page: L<http://savage.net.au/index.html>. >+ >+=head1 Copyright >+ >+Australian copyright (c) 2010, Ron Savage. >+ >+ All Programs of mine are 'OSI Certified Open Source Software'; >+ you can redistribute them and/or modify them under the terms of >+ The Artistic License, a copy of which is available at: >+ http://www.opensource.org/licenses/index.html >+ >+=cut >diff --git a/lib/Data/Session/Driver/mysql.pm b/lib/Data/Session/Driver/mysql.pm >new file mode 100644 >index 00000000000..2db39ba06a5 >--- /dev/null >+++ b/lib/Data/Session/Driver/mysql.pm >@@ -0,0 +1,296 @@ >+package Data::Session::Driver::mysql; >+ >+use parent 'Data::Session::Driver'; >+no autovivification; >+use strict; >+use warnings; >+ >+use Hash::FieldHash ':all'; >+ >+our $VERSION = '1.18'; >+ >+# ----------------------------------------------- >+ >+sub new >+{ >+ my($class, %arg) = @_; >+ >+ $class -> init(\%arg); >+ >+ my($self) = from_hash(bless({}, $class), \%arg); >+ my($dsn) = $self -> data_source; >+ my(%attr) = >+ ( >+ host => 'host', >+ port => 'port', >+ socket => 'mysql_socket', >+ ); >+ >+ for my $key (sort keys %attr) >+ { >+ if ($arg{$key}) >+ { >+ $dsn .= ";$attr{$key}=$arg{$key}"; >+ } >+ } >+ >+ $self -> data_source($dsn); >+ $self -> get_dbh(\%arg); >+ >+ return $self; >+ >+} # End of new. >+ >+# ----------------------------------------------- >+ >+sub store >+{ >+ my($self, $id, $data) = @_; >+ my($data_col_name) = $self -> data_col_name; >+ my($dbh) = $self -> dbh; >+ local $$dbh{RaiseError} = 1; >+ my($id_col_name) = $self -> id_col_name; >+ my($table_name) = $self -> table_name; >+ my($sql) = "insert into $table_name ($data_col_name, $id_col_name) select ?, ? " . >+ "on duplicate key update $data_col_name = ?"; >+ >+ $dbh -> do($sql, {}, $data, $id, $data) || die __PACKAGE__ . ". $DBI::errstr"; >+ >+ return 1; >+ >+} # End of store. >+ >+# ----------------------------------------------- >+ >+1; >+ >+=pod >+ >+=head1 NAME >+ >+L<Data::Session::Driver::mysql> - A persistent session manager >+ >+=head1 Synopsis >+ >+See L<Data::Session> for details. >+ >+=head1 Description >+ >+L<Data::Session::Driver::mysql> allows L<Data::Session> to manipulate sessions via L<DBD::mysql>. >+ >+To use this module do both of these : >+ >+=over 4 >+ >+=item o Specify a driver of type mysql, as Data::Session -> new(type => 'driver:mysql ...') >+ >+=item o Specify a database handle as Data::Session -> new(dbh => $dbh), or a data source as >+Data::Session -> new(data_source => $string) >+ >+=back >+ >+=head1 Case-sensitive Options >+ >+See L<Data::Session/Case-sensitive Options> for important information. >+ >+=head1 Method: new() >+ >+Creates a new object of type L<Data::Session::Driver::mysql>. >+ >+C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations >+might be mandatory. >+ >+The keys are listed here in alphabetical order. >+ >+They are lower-case because they are (also) method names, meaning they can be called to set or get >+the value at any time. >+ >+=over 4 >+ >+=item o data_col_name => $string >+ >+Specifes the name of the column in the sessions table which holds the session data. >+ >+This key is normally passed in as Data::Session -> new(data_col_name => $string). >+ >+Default: 'a_session'. >+ >+This key is optional. >+ >+=item o data_source => $string >+ >+Specifies the data source (as used by DBI -> connect($data_source, $username, $password, >+$data_source_attr) ) to obtain a database handle. >+ >+This key is normally passed in as Data::Session -> new(data_source => $string). >+ >+Default: ''. >+ >+This key is optional, as long as a value is supplied for 'dbh'. >+ >+=item o data_source_attr => $hashref >+ >+Specifies the attributes (as used by DBI -> connect($data_source, $username, $password, $attr) ) to >+obtain a database handle. >+ >+This key is normally passed in as Data::Session -> new(data_source_attr => $hashref). >+ >+Default: {AutoCommit => 1, PrintError => 0, RaiseError => 1}. >+ >+This key is optional. >+ >+=item o dbh => $dbh >+ >+Specifies the database handle to use to access the sessions table. >+ >+This key is normally passed in as Data::Session -> new(dbh => $dbh). >+ >+If not specified, this module will use the values of these keys to obtain a database handle: >+ >+=over 4 >+ >+=item o data_source >+ >+=item o data_source_attr >+ >+=item o username >+ >+=item o password >+ >+=back >+ >+Default: ''. >+ >+This key is optional. >+ >+=item o host => $string >+ >+Specifies the host name to attach to the data_source. >+ >+So Data::Session -> new(data_source => 'dbi:mysql:database=test', host => '192.168.100.1') generates >+the call $dbh = DBI -> connect('dbi:mysql:database=test;host=192.168.100.1', ...). >+ >+=item o id_col_name => $string >+ >+Specifes the name of the column in the sessions table which holds the session id. >+ >+This key is normally passed in as Data::Session -> new(id_col_name => $string). >+ >+Default: 'id'. >+ >+This key is optional. >+ >+=item o password => $string >+ >+Specifies the password (as used by DBI -> connect($data_source, $username, $password, >+$data_source_attr) ) to obtain a database handle. >+ >+This key is normally passed in as Data::Session -> new(password => $string). >+ >+Default: ''. >+ >+This key is optional. >+ >+=item o port => $string >+ >+Specifies the port number to attach to the data_source. >+ >+So Data::Session -> new(data_source => 'dbi:mysql:database=test', port => '5000') generates >+the call $dbh = DBI -> connect('dbi:mysql:database=test;port=5000', ...). >+ >+=item o socket => $string >+ >+Specifies the socket to attach to the data_source. >+ >+So Data::Session -> new(data_source => 'dbi:mysql:database=test', socket => '/dev/mysql.sock') >+generates the call >+$dbh = DBI -> connect('dbi:mysql:database=test;mysql_socket=/dev/mysql.sock', ...). >+ >+The reason this key is called socket and not mysql_socket is in case other drivers permit a socket >+option. >+ >+=item o table_name => $string >+ >+Specifes the name of the sessions table. >+ >+This key is normally passed in as Data::Session -> new(table_name => $string). >+ >+Default: 'sessions'. >+ >+This key is optional. >+ >+=item o username => $string >+ >+Specifies the username (as used by >+DBI -> connect($data_source, $username, $password, $data_source_attr) ) to obtain a database handle. >+ >+This key is normally passed in as Data::Session -> new(username => $string). >+ >+Default: ''. >+ >+This key is optional. >+ >+=item o verbose => $integer >+ >+Print to STDERR more or less information. >+ >+This key is normally passed in as Data::Session -> new(verbose => $integer). >+ >+Typical values are 0, 1 and 2. >+ >+This key is optional. >+ >+=back >+ >+=head1 Method: remove($id) >+ >+Deletes from storage the session identified by $id, or dies if it can't. >+ >+Returns 1. >+ >+=head1 Method: retrieve($id) >+ >+Retrieve from storage the session identified by $id, or dies if it can't. >+ >+Returns the session. >+ >+This is a frozen session. This value must be thawed by calling the appropriate serialization >+driver's thaw() method. >+ >+L<Data::Session> calls the right thaw() automatically. >+ >+=head1 Method: store($id => $data) >+ >+Writes to storage the session identified by $id, together with its data $data, or dies if it can't. >+ >+Returns 1. >+ >+=head1 Method: traverse() >+ >+Retrieves all ids from the sessions table, and for each id calls the supplied subroutine with the id >+as the only parameter. >+ >+$dbh -> selectall_arrayref is used, and the table is not locked. >+ >+Returns 1. >+ >+=head1 Support >+ >+Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>. >+ >+=head1 Author >+ >+L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010. >+ >+Home page: L<http://savage.net.au/index.html>. >+ >+=head1 Copyright >+ >+Australian copyright (c) 2010, Ron Savage. >+ >+ All Programs of mine are 'OSI Certified Open Source Software'; >+ you can redistribute them and/or modify them under the terms of >+ The Artistic License, a copy of which is available at: >+ http://www.opensource.org/licenses/index.html >+ >+=cut >diff --git a/lib/Data/Session/ID.pm b/lib/Data/Session/ID.pm >new file mode 100644 >index 00000000000..cfedc5272f0 >--- /dev/null >+++ b/lib/Data/Session/ID.pm >@@ -0,0 +1,75 @@ >+package Data::Session::ID; >+ >+use parent 'Data::Session::Base'; >+no autovivification; >+use strict; >+use warnings; >+ >+use File::Spec; >+ >+use Hash::FieldHash ':all'; >+ >+fieldhash my %id_length => 'id_length'; >+ >+our $errstr = ''; >+our $VERSION = '1.18'; >+ >+# ----------------------------------------------- >+ >+sub init >+{ >+ my($class, $arg) = @_; >+ $$arg{debug} ||= 0; >+ $$arg{id} ||= 0; >+ $$arg{id_base} ||= 0; # For AutoIncrement (AI). >+ $$arg{id_file} ||= File::Spec -> catdir(File::Spec -> tmpdir, 'data.session.id'); # For AI. >+ $$arg{id_length} = 0; # For UUID. >+ $$arg{id_step} ||= 1; # For AI. >+ $$arg{no_flock} ||= 0; >+ $$arg{umask} ||= 0660; >+ $$arg{verbose} ||= 0; >+ >+} # End of init. >+ >+# ----------------------------------------------- >+ >+1; >+ >+=pod >+ >+=head1 NAME >+ >+L<Data::Session::ID> - A persistent session manager >+ >+=head1 Synopsis >+ >+See L<Data::Session> for details. >+ >+=head1 Description >+ >+L<Data::Session::ID> is the parent of all L<Data::Session::ID::*> modules. >+ >+=head1 Case-sensitive Options >+ >+See L<Data::Session/Case-sensitive Options> for important information. >+ >+=head1 Support >+ >+Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>. >+ >+=head1 Author >+ >+L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010. >+ >+Home page: L<http://savage.net.au/index.html>. >+ >+=head1 Copyright >+ >+Australian copyright (c) 2010, Ron Savage. >+ >+ All Programs of mine are 'OSI Certified Open Source Software'; >+ you can redistribute them and/or modify them under the terms of >+ The Artistic License, a copy of which is available at: >+ http://www.opensource.org/licenses/index.html >+ >+=cut >diff --git a/lib/Data/Session/ID/AutoIncrement.pm b/lib/Data/Session/ID/AutoIncrement.pm >new file mode 100644 >index 00000000000..974047a0e0e >--- /dev/null >+++ b/lib/Data/Session/ID/AutoIncrement.pm >@@ -0,0 +1,221 @@ >+package Data::Session::ID::AutoIncrement; >+ >+use parent 'Data::Session::ID'; >+no autovivification; >+use strict; >+use warnings; >+ >+use Fcntl qw/:DEFAULT :flock/; >+ >+use Hash::FieldHash ':all'; >+ >+our $VERSION = '1.18'; >+ >+# ----------------------------------------------- >+ >+sub generate >+{ >+ my($self) = @_; >+ my($id_file) = $self -> id_file; >+ >+ (! $id_file) && die __PACKAGE__ . '. id_file not specifed in new(...)'; >+ >+ my($message) = __PACKAGE__ . ". Can't %s id_file '$id_file'. %s"; >+ >+ my($fh); >+ >+ sysopen($fh, $id_file, O_RDWR | O_CREAT, $self -> umask) || die sprintf($message, 'open', $self -> debug ? $! : ''); >+ >+ if (! $self -> no_flock) >+ { >+ flock($fh, LOCK_EX) || die sprintf($message, 'lock', $self -> debug ? $! : ''); >+ } >+ >+ my($id) = <$fh>; >+ >+ if (! $id || ($id !~ /^\d+$/) ) >+ { >+ $id = $self -> id_base; >+ } >+ >+ $id += $self -> id_step; >+ >+ seek($fh, 0, 0) || die sprintf($message, 'seek', $self -> debug ? $! : ''); >+ truncate($fh, 0) || die sprintf($message, 'truncate', $self -> debug ? $! : ''); >+ print $fh $id; >+ close $fh || die sprintf($message, 'close', $self -> debug ? $! : ''); >+ >+ return $id; >+ >+} # End of generate. >+ >+# ----------------------------------------------- >+ >+sub id_length >+{ >+ my($self) = @_; >+ >+ return 32; >+ >+} # End of id_length. >+ >+# ----------------------------------------------- >+ >+sub new >+{ >+ my($class, %arg) = @_; >+ >+ $class -> init(\%arg); >+ >+ return from_hash(bless({}, $class), \%arg); >+ >+} # End of new. >+ >+# ----------------------------------------------- >+ >+1; >+ >+=pod >+ >+=head1 NAME >+ >+L<Data::Session::ID::AutoIncrement> - A persistent session manager >+ >+=head1 Synopsis >+ >+See L<Data::Session> for details. >+ >+=head1 Description >+ >+L<Data::Session::ID::AutoIncrement> allows L<Data::Session> to generate session ids. >+ >+To use this module do this: >+ >+=over 4 >+ >+=item o Specify an id generator of type AutoIncrement, as >+Data::Session -> new(type => '... id:AutoIncrement ...') >+ >+=back >+ >+=head1 Case-sensitive Options >+ >+See L<Data::Session/Case-sensitive Options> for important information. >+ >+=head1 Method: new() >+ >+Creates a new object of type L<Data::Session::ID::AutoIncrement>. >+ >+C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations >+might be mandatory. >+ >+The keys are listed here in alphabetical order. >+ >+They are lower-case because they are (also) method names, meaning they can be called to set or get >+the value at any time. >+ >+=over 4 >+ >+=item o id_base => $integer >+ >+Specifies the base value for the auto-incrementing sessions ids. >+ >+This key is normally passed in as Data::Session -> new(id_base => $integer). >+ >+Note: The first id returned by generate() is id_base + id_step. >+ >+Default: 0. >+ >+This key is optional. >+ >+=item o id_file => $file_name >+ >+Specifies the file name in which to save the 'current' id. >+ >+This key is normally passed in as Data::Session -> new(id_file => $file_name). >+ >+Note: The next id returned by generate() is 'current' id + id_step. >+ >+Default: File::Spec -> catdir(File::Spec -> tmpdir, 'data.session.id'). >+ >+The reason Data::Session -> new(directory => ...) is not used as the default directory is because >+this latter option is for where the session files are stored if the driver is File and the id >+generator is not AutoIncrement. >+ >+This key is optional. >+ >+=item o id_step => $integer >+ >+Specifies the amount to be added to the previous id to get the next id. >+ >+This key is normally passed in as Data::Session -> new(id_step => $integer). >+ >+Default: 1. >+ >+This key is optional. >+ >+=item o no_flock => $boolean >+ >+Specifies (no_flock => 1) to not use flock() to obtain a lock on $file_name (which holds the >+'current' id) before processing it, or (no_flock => 0) to use flock(). >+ >+This key is normally passed in as Data::Session -> new(no_flock => $boolean). >+ >+Default: 0. >+ >+This key is optional. >+ >+=item o umask => $octal_value >+ >+Specifies the mode to use when calling sysopen() on $file_name. >+ >+This key is normally passed in as Data::Session -> new(umask => $octal_value). >+ >+Default: 0660. >+ >+This key is optional. >+ >+=item o verbose => $integer >+ >+Print to STDERR more or less information. >+ >+Typical values are 0, 1 and 2. >+ >+This key is normally passed in as Data::Session -> new(verbose => $integer). >+ >+This key is optional. >+ >+=back >+ >+=head1 Method: generate() >+ >+Generates the next session id, or dies if it can't. >+ >+Returns the new id. >+ >+=head1 Method: id_length() >+ >+Returns 32 because that's the classic value of the size of the id field in the sessions table. >+ >+This can be used to generate the SQL to create the sessions table. >+ >+=head1 Support >+ >+Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>. >+ >+=head1 Author >+ >+L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010. >+ >+Home page: L<http://savage.net.au/index.html>. >+ >+=head1 Copyright >+ >+Australian copyright (c) 2010, Ron Savage. >+ >+ All Programs of mine are 'OSI Certified Open Source Software'; >+ you can redistribute them and/or modify them under the terms of >+ The Artistic License, a copy of which is available at: >+ http://www.opensource.org/licenses/index.html >+ >+=cut >diff --git a/lib/Data/Session/ID/MD5.pm b/lib/Data/Session/ID/MD5.pm >new file mode 100644 >index 00000000000..34b0e69f7ab >--- /dev/null >+++ b/lib/Data/Session/ID/MD5.pm >@@ -0,0 +1,137 @@ >+package Data::Session::ID::MD5; >+ >+use parent 'Data::Session::ID'; >+no autovivification; >+use strict; >+use warnings; >+ >+use Digest::MD5; >+ >+use Hash::FieldHash ':all'; >+ >+our $errstr = ''; >+our $VERSION = '1.18'; >+ >+# ----------------------------------------------- >+ >+sub generate >+{ >+ my($self) = @_; >+ >+ return Digest::MD5 -> new -> add($$, time, rand(time) ) -> hexdigest; >+ >+} # End of generate. >+ >+# ----------------------------------------------- >+ >+sub id_length >+{ >+ my($self) = @_; >+ >+ return 32; >+ >+} # End of id_length. >+ >+# ----------------------------------------------- >+ >+sub new >+{ >+ my($class, %arg) = @_; >+ $arg{verbose} ||= 0; >+ >+ return from_hash(bless({}, $class), \%arg); >+ >+} # End of new. >+ >+# ----------------------------------------------- >+ >+1; >+ >+=pod >+ >+=head1 NAME >+ >+L<Data::Session::ID::MD5> - A persistent session manager >+ >+=head1 Synopsis >+ >+See L<Data::Session> for details. >+ >+=head1 Description >+ >+L<Data::Session::ID::MD5> allows L<Data::Session> to generate session ids using L<Digest::MD5>. >+ >+To use this module do this: >+ >+=over 4 >+ >+=item o Specify an id generator of type MD5, as Data::Session -> new(type => '... id:MD5 ...') >+ >+=back >+ >+=head1 Case-sensitive Options >+ >+See L<Data::Session/Case-sensitive Options> for important information. >+ >+=head1 Method: new() >+ >+Creates a new object of type L<Data::Session::ID::MD5>. >+ >+C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations >+might be mandatory. >+ >+The keys are listed here in alphabetical order. >+ >+They are lower-case because they are (also) method names, meaning they can be called to set or get >+the value at any time. >+ >+=over 4 >+ >+=item o verbose => $integer >+ >+Print to STDERR more or less information. >+ >+Typical values are 0, 1 and 2. >+ >+This key is normally passed in as Data::Session -> new(verbose => $integer). >+ >+This key is optional. >+ >+=back >+ >+=head1 Method: generate() >+ >+Generates the next session id, or dies if it can't. >+ >+The algorithm is Digest::MD5 -> new -> add($$, time, rand(time) ) -> hexdigest. >+ >+Returns the new id. >+ >+=head1 Method: id_length() >+ >+Returns 32 because that's the number of hex digits in a MD5 digest. >+ >+This can be used to generate the SQL to create the sessions table. >+ >+See scripts/digest.pl. >+ >+=head1 Support >+ >+Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>. >+ >+=head1 Author >+ >+L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010. >+ >+Home page: L<http://savage.net.au/index.html>. >+ >+=head1 Copyright >+ >+Australian copyright (c) 2010, Ron Savage. >+ >+ All Programs of mine are 'OSI Certified Open Source Software'; >+ you can redistribute them and/or modify them under the terms of >+ The Artistic License, a copy of which is available at: >+ http://www.opensource.org/licenses/index.html >+ >+=cut >diff --git a/lib/Data/Session/ID/SHA1.pm b/lib/Data/Session/ID/SHA1.pm >new file mode 100644 >index 00000000000..7a40c387f31 >--- /dev/null >+++ b/lib/Data/Session/ID/SHA1.pm >@@ -0,0 +1,130 @@ >+package Data::Session::ID::SHA1; >+ >+use parent 'Data::Session::SHA'; >+no autovivification; >+use strict; >+use warnings; >+ >+use Hash::FieldHash ':all'; >+ >+our $VERSION = '1.18'; >+ >+# ----------------------------------------------- >+ >+sub generate >+{ >+ my($self) = @_; >+ >+ return $self -> SUPER::generate(1); >+ >+} # End of generate. >+ >+# ----------------------------------------------- >+ >+sub id_length >+{ >+ my($self) = @_; >+ >+ return 40; >+ >+} # End of id_length. >+ >+# ----------------------------------------------- >+ >+sub new >+{ >+ my($class, %arg) = @_; >+ $arg{verbose} ||= 0; >+ >+ return from_hash(bless({}, $class), \%arg); >+ >+} # End of new. >+ >+# ----------------------------------------------- >+ >+1; >+ >+=pod >+ >+=head1 NAME >+ >+L<Data::Session::ID::SHA1> - A persistent session manager >+ >+=head1 Synopsis >+ >+See L<Data::Session> for details. >+ >+=head1 Description >+ >+L<Data::Session::ID::SHA1> allows L<Data::Session> to generate session ids using L<Digest::SHA>. >+ >+To use this module do this: >+ >+=over 4 >+ >+=item o Specify an id generator of type SHA1, as Data::Session -> new(type => '... id:SHA1 ...') >+ >+=back >+ >+=head1 Case-sensitive Options >+ >+See L<Data::Session/Case-sensitive Options> for important information. >+ >+=head1 Method: new() >+ >+Creates a new object of type L<Data::Session::ID::SHA1>. >+ >+C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations >+might be mandatory. >+ >+The keys are listed here in alphabetical order. >+ >+They are lower-case because they are (also) method names, meaning they can be called to set or get >+the value at any time. >+ >+=over 4 >+ >+=item o verbose => $integer >+ >+Print to STDERR more or less information. >+ >+Typical values are 0, 1 and 2. >+ >+This key is normally passed in as Data::Session -> new(verbose => $integer). >+ >+This key is optional. >+ >+=back >+ >+=head1 Method: generate() >+ >+Generates the next session id, or dies if it can't. >+ >+The algorithm is Digest::SHA -> new(1) -> add($$, time, rand(time) ) -> hexdigest. >+ >+Returns the new id. >+ >+=head1 Method: id_length() >+ >+Returns 40 because that's the number of hex digits in an SHA1 digest. >+ >+=head1 Support >+ >+Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>. >+ >+=head1 Author >+ >+L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010. >+ >+Home page: L<http://savage.net.au/index.html>. >+ >+=head1 Copyright >+ >+Australian copyright (c) 2010, Ron Savage. >+ >+ All Programs of mine are 'OSI Certified Open Source Software'; >+ you can redistribute them and/or modify them under the terms of >+ The Artistic License, a copy of which is available at: >+ http://www.opensource.org/licenses/index.html >+ >+=cut >diff --git a/lib/Data/Session/ID/SHA256.pm b/lib/Data/Session/ID/SHA256.pm >new file mode 100644 >index 00000000000..048e34d405a >--- /dev/null >+++ b/lib/Data/Session/ID/SHA256.pm >@@ -0,0 +1,132 @@ >+package Data::Session::ID::SHA256; >+ >+use parent 'Data::Session::SHA'; >+no autovivification; >+use strict; >+use warnings; >+ >+use Hash::FieldHash ':all'; >+ >+our $VERSION = '1.18'; >+ >+# ----------------------------------------------- >+ >+sub generate >+{ >+ my($self) = @_; >+ >+ return $self -> SUPER::generate(256); >+ >+} # End of generate. >+ >+# ----------------------------------------------- >+ >+sub id_length >+{ >+ my($self) = @_; >+ >+ return 64; >+ >+} # End of id_length. >+ >+# ----------------------------------------------- >+ >+sub new >+{ >+ my($class, %arg) = @_; >+ $arg{verbose} ||= 0; >+ >+ return from_hash(bless({}, $class), \%arg); >+ >+} # End of new. >+ >+# ----------------------------------------------- >+ >+1; >+ >+=pod >+ >+=head1 NAME >+ >+L<Data::Session::ID::SHA256> - A persistent session manager >+ >+=head1 Synopsis >+ >+See L<Data::Session> for details. >+ >+=head1 Description >+ >+L<Data::Session::ID::SHA256> allows L<Data::Session> to generate session ids using L<Digest::SHA>. >+ >+To use this module do this: >+ >+=over 4 >+ >+=item o Specify an id generator of type SHA256, as Data::Session -> new(type => '... id:SHA256 ...') >+ >+=back >+ >+=head1 Case-sensitive Options >+ >+See L<Data::Session/Case-sensitive Options> for important information. >+ >+=head1 Method: new() >+ >+Creates a new object of type L<Data::Session::ID::SHA256>. >+ >+C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations >+might be mandatory. >+ >+The keys are listed here in alphabetical order. >+ >+They are lower-case because they are (also) method names, meaning they can be called to set or get >+the value at any time. >+ >+=over 4 >+ >+=item o verbose => $integer >+ >+Print to STDERR more or less information. >+ >+Typical values are 0, 1 and 2. >+ >+This key is normally passed in as Data::Session -> new(verbose => $integer). >+ >+This key is optional. >+ >+=back >+ >+=head1 Method: generate() >+ >+Generates the next session id, or dies if it can't. >+ >+The algorithm is Digest::SHA -> new(256) -> add($$, time, rand(time) ) -> hexdigest. >+ >+Returns the new id. >+ >+=head1 Method: id_length() >+ >+Returns 64 because that's the number of hex digits in an SHA256 digest. >+ >+This can be used to generate the SQL to create the sessions table. >+ >+=head1 Support >+ >+Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>. >+ >+=head1 Author >+ >+L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010. >+ >+Home page: L<http://savage.net.au/index.html>. >+ >+=head1 Copyright >+ >+Australian copyright (c) 2010, Ron Savage. >+ >+ All Programs of mine are 'OSI Certified Open Source Software'; >+ you can redistribute them and/or modify them under the terms of >+ The Artistic License, a copy of which is available at: >+ http://www.opensource.org/licenses/index.html >+ >+=cut >diff --git a/lib/Data/Session/ID/SHA512.pm b/lib/Data/Session/ID/SHA512.pm >new file mode 100644 >index 00000000000..500b2d74d38 >--- /dev/null >+++ b/lib/Data/Session/ID/SHA512.pm >@@ -0,0 +1,132 @@ >+package Data::Session::ID::SHA512; >+ >+use parent 'Data::Session::SHA'; >+no autovivification; >+use strict; >+use warnings; >+ >+use Hash::FieldHash ':all'; >+ >+our $VERSION = '1.18'; >+ >+# ----------------------------------------------- >+ >+sub generate >+{ >+ my($self) = @_; >+ >+ return $self -> SUPER::generate(512); >+ >+} # End of generate. >+ >+# ----------------------------------------------- >+ >+sub id_length >+{ >+ my($self) = @_; >+ >+ return 128; >+ >+} # End of id_length. >+ >+# ----------------------------------------------- >+ >+sub new >+{ >+ my($class, %arg) = @_; >+ $arg{verbose} ||= 0; >+ >+ return from_hash(bless({}, $class), \%arg); >+ >+} # End of new. >+ >+# ----------------------------------------------- >+ >+1; >+ >+=pod >+ >+=head1 NAME >+ >+L<Data::Session::ID::SHA512> - A persistent session manager >+ >+=head1 Synopsis >+ >+See L<Data::Session> for details. >+ >+=head1 Description >+ >+L<Data::Session::ID::SHA512> allows L<Data::Session> to generate session ids using L<Digest::SHA>. >+ >+To use this module do this: >+ >+=over 4 >+ >+=item o Specify an id generator of type SHA512, as Data::Session -> new(type => '... id:SHA512 ...') >+ >+=back >+ >+=head1 Case-sensitive Options >+ >+See L<Data::Session/Case-sensitive Options> for important information. >+ >+=head1 Method: new() >+ >+Creates a new object of type L<Data::Session::ID::SHA512>. >+ >+C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations >+might be mandatory. >+ >+The keys are listed here in alphabetical order. >+ >+They are lower-case because they are (also) method names, meaning they can be called to set or get >+the value at any time. >+ >+=over 4 >+ >+=item o verbose => $integer >+ >+Print to STDERR more or less information. >+ >+Typical values are 0, 1 and 2. >+ >+This key is normally passed in as Data::Session -> new(verbose => $integer). >+ >+This key is optional. >+ >+=back >+ >+=head1 Method: generate() >+ >+Generates the next session id, or dies if it can't. >+ >+The algorithm is Digest::SHA -> new(512) -> add($$, time, rand(time) ) -> hexdigest. >+ >+Returns the new id. >+ >+=head1 Method: id_length() >+ >+Returns 128 because that's the number of hex digits in an SHA512 digest. >+ >+This can be used to generate the SQL to create the sessions table. >+ >+=head1 Support >+ >+Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>. >+ >+=head1 Author >+ >+L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010. >+ >+Home page: L<http://savage.net.au/index.html>. >+ >+=head1 Copyright >+ >+Australian copyright (c) 2010, Ron Savage. >+ >+ All Programs of mine are 'OSI Certified Open Source Software'; >+ you can redistribute them and/or modify them under the terms of >+ The Artistic License, a copy of which is available at: >+ http://www.opensource.org/licenses/index.html >+ >+=cut >diff --git a/lib/Data/Session/ID/Static.pm b/lib/Data/Session/ID/Static.pm >new file mode 100644 >index 00000000000..0697923cbca >--- /dev/null >+++ b/lib/Data/Session/ID/Static.pm >@@ -0,0 +1,145 @@ >+package Data::Session::ID::Static; >+ >+use parent 'Data::Session::ID'; >+no autovivification; >+use strict; >+use warnings; >+ >+use Hash::FieldHash ':all'; >+ >+our $VERSION = '1.18'; >+ >+# ----------------------------------------------- >+ >+sub generate >+{ >+ my($self) = @_; >+ my($id) = $self -> id; >+ >+ (! $id) && die __PACKAGE__ . '. Static id (supplied to new) is not a true value'; >+ >+ return $id; >+ >+} # End of generate. >+ >+# ----------------------------------------------- >+ >+sub id_length >+{ >+ my($self) = @_; >+ >+ return 32; >+ >+} # End of id_length. >+ >+# ----------------------------------------------- >+ >+sub new >+{ >+ my($class, %arg) = @_; >+ >+ $class -> init(\%arg); >+ >+ return from_hash(bless({}, $class), \%arg); >+ >+} # End of new. >+ >+# ----------------------------------------------- >+ >+1; >+ >+=pod >+ >+=head1 NAME >+ >+L<Data::Session::ID::Static> - A persistent session manager >+ >+=head1 Synopsis >+ >+See L<Data::Session> for details. >+ >+=head1 Description >+ >+L<Data::Session::ID::Static> allows L<Data::Session> to generate a static (constant) session id. >+ >+To use this module do this: >+ >+=over 4 >+ >+=item o Specify an id generator of type Static, as Data::Session -> new(type => '... id:Static ...') >+ >+=back >+ >+=head1 Case-sensitive Options >+ >+See L<Data::Session/Case-sensitive Options> for important information. >+ >+=head1 Method: new() >+ >+Creates a new object of type L<Data::Session::ID::Static>. >+ >+C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations >+might be mandatory. >+ >+The keys are listed here in alphabetical order. >+ >+They are lower-case because they are (also) method names, meaning they can be called to set or get >+the value at any time. >+ >+=over 4 >+ >+=item o id => $string >+ >+Specifies the static (constant) id to 'generate'. >+ >+This key is normally passed in as Data::Session -> new(id => $string). >+ >+Default: 0. >+ >+This key is mandatory, and can't be 0. >+ >+=item o verbose => $integer >+ >+Print to STDERR more or less information. >+ >+Typical values are 0, 1 and 2. >+ >+This key is normally passed in as Data::Session -> new(verbose => $integer). >+ >+This key is optional. >+ >+=back >+ >+=head1 Method: generate() >+ >+Generates the next session id (which is always what was passed in to new(id => ...) ), or dies if it >+can't. >+ >+Returns the new id. >+ >+=head1 Method: id_length() >+ >+Returns 32 because that's the classic value of the size of the id field in the sessions table. >+ >+This can be used to generate the SQL to create the sessions table. >+ >+=head1 Support >+ >+Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>. >+ >+=head1 Author >+ >+L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010. >+ >+Home page: L<http://savage.net.au/index.html>. >+ >+=head1 Copyright >+ >+Australian copyright (c) 2010, Ron Savage. >+ >+ All Programs of mine are 'OSI Certified Open Source Software'; >+ you can redistribute them and/or modify them under the terms of >+ The Artistic License, a copy of which is available at: >+ http://www.opensource.org/licenses/index.html >+ >+=cut >diff --git a/lib/Data/Session/ID/UUID16.pm b/lib/Data/Session/ID/UUID16.pm >new file mode 100644 >index 00000000000..f00704605b6 >--- /dev/null >+++ b/lib/Data/Session/ID/UUID16.pm >@@ -0,0 +1,156 @@ >+package Data::Session::ID::UUID16; >+ >+use parent 'Data::Session::ID'; >+no autovivification; >+use strict; >+use warnings; >+ >+use Data::UUID; >+ >+use Hash::FieldHash ':all'; >+ >+our $VERSION = '1.18'; >+ >+# ----------------------------------------------- >+ >+sub generate >+{ >+ my($self) = @_; >+ >+ return Data::UUID -> new -> create_bin; >+ >+} # End of generate. >+ >+# ----------------------------------------------- >+ >+sub id_length >+{ >+ my($self) = @_; >+ >+ return 16; >+ >+} # End of id_length. >+ >+# ----------------------------------------------- >+ >+sub init >+{ >+ my($self, $arg) = @_; >+ $$arg{id_length} = 16; # Bytes. >+ $$arg{verbose} ||= 0; >+ >+} # End of init. >+ >+# ----------------------------------------------- >+ >+sub new >+{ >+ my($class, %arg) = @_; >+ >+ $class -> init(\%arg); >+ >+ return from_hash(bless({}, $class), \%arg); >+ >+} # End of new. >+ >+# ----------------------------------------------- >+ >+1; >+ >+=pod >+ >+=head1 NAME >+ >+L<Data::Session::ID::UUID16> - A persistent session manager >+ >+=head1 Synopsis >+ >+See L<Data::Session> for details. >+ >+=head1 Case-sensitive Options >+ >+See L<Data::Session/Case-sensitive Options> for important information. >+ >+To use this module do this: >+ >+=over 4 >+ >+=item o Specify an id generator of type UUID16, as Data::Session -> new(type => '... id:UUID16 ...') >+ >+=back >+ >+=head1 Description >+ >+L<Data::Session::ID::UUID16> allows L<Data::Session> to generate session ids using L<Data::UUID>. >+ >+=head1 Method: new() >+ >+Creates a new object of type L<Data::Session::ID::UUID16>. >+ >+C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations >+might be mandatory. >+ >+The keys are listed here in alphabetical order. >+ >+They are lower-case because they are (also) method names, meaning they can be called to set or get >+the value at any time. >+ >+=over 4 >+ >+=item o verbose => $integer >+ >+Print to STDERR more or less information. >+ >+Typical values are 0, 1 and 2. >+ >+This key is normally passed in as Data::Session -> new(verbose => $integer). >+ >+This key is optional. >+ >+=back >+ >+=head1 Method: generate() >+ >+Generates the next session id, or dies if it can't. >+ >+The algorithm is Data::UUID -> new -> create_bin. >+ >+Returns the new id. >+ >+Note: A UUID16 hex string is not necessarily a valid UTF8 string, so you can't use UUID16 >+to generate ids which are to be stored in a Postgres table if the database was created like this (in >+psql): >+ >+ create database a_db owner an_owner encoding 'UTF8'; >+ >+Warning: This also means you should never try to use 'driver:File;id:UUID16;...', since the ids >+generated by this module would rarely if ever be valid as a part of a file name. >+ >+=head1 Method: id_length() >+ >+Returns 16 because that's the number of bytes in a UUID16 digest. >+ >+This can be used to generate the SQL to create the sessions table. >+ >+See scripts/digest.pl. >+ >+=head1 Support >+ >+Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>. >+ >+=head1 Author >+ >+L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010. >+ >+Home page: L<http://savage.net.au/index.html>. >+ >+=head1 Copyright >+ >+Australian copyright (c) 2010, Ron Savage. >+ >+ All Programs of mine are 'OSI Certified Open Source Software'; >+ you can redistribute them and/or modify them under the terms of >+ The Artistic License, a copy of which is available at: >+ http://www.opensource.org/licenses/index.html >+ >+=cut >diff --git a/lib/Data/Session/ID/UUID34.pm b/lib/Data/Session/ID/UUID34.pm >new file mode 100644 >index 00000000000..bc2518867a4 >--- /dev/null >+++ b/lib/Data/Session/ID/UUID34.pm >@@ -0,0 +1,149 @@ >+package Data::Session::ID::UUID34; >+ >+use parent 'Data::Session::ID'; >+no autovivification; >+use strict; >+use warnings; >+ >+use Data::UUID; >+ >+use Hash::FieldHash ':all'; >+ >+our $VERSION = '1.18'; >+ >+# ----------------------------------------------- >+ >+sub generate >+{ >+ my($self) = @_; >+ >+ return Data::UUID -> new -> create_hex; >+ >+} # End of generate. >+ >+# ----------------------------------------------- >+ >+sub id_length >+{ >+ my($self) = @_; >+ >+ return 34; >+ >+} # End of id_length. >+ >+# ----------------------------------------------- >+ >+sub init >+{ >+ my($self, $arg) = @_; >+ $$arg{id_length} = 34; # Bytes. >+ $$arg{verbose} ||= 0; >+ >+} # End of init. >+ >+# ----------------------------------------------- >+ >+sub new >+{ >+ my($class, %arg) = @_; >+ >+ $class -> init(\%arg); >+ >+ return from_hash(bless({}, $class), \%arg); >+ >+} # End of new. >+ >+# ----------------------------------------------- >+ >+1; >+ >+=pod >+ >+=head1 NAME >+ >+L<Data::Session::ID::UUID34> - A persistent session manager >+ >+=head1 Synopsis >+ >+See L<Data::Session> for details. >+ >+=head1 Description >+ >+L<Data::Session::ID::UUID34> allows L<Data::Session> to generate session ids using L<Data::UUID>. >+ >+To use this module do this: >+ >+=over 4 >+ >+=item o Specify an id generator of type UUID34, as Data::Session -> new(type => '... id:UUID34 ...') >+ >+=back >+ >+=head1 Case-sensitive Options >+ >+See L<Data::Session/Case-sensitive Options> for important information. >+ >+=head1 Method: new() >+ >+Creates a new object of type L<Data::Session::ID::UUID34>. >+ >+C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations >+might be mandatory. >+ >+The keys are listed here in alphabetical order. >+ >+They are lower-case because they are (also) method names, meaning they can be called to set or get >+the value at any time. >+ >+=over 4 >+ >+=item o verbose => $integer >+ >+Print to STDERR more or less information. >+ >+Typical values are 0, 1 and 2. >+ >+This key is normally passed in as Data::Session -> new(verbose => $integer). >+ >+This key is optional. >+ >+=back >+ >+=head1 Method: generate() >+ >+Generates the next session id, or dies if it can't. >+ >+The algorithm is Data::UUID -> new -> create_hex. >+ >+Returns the new id. >+ >+Note: L<Data::UUID> returns '0x' as the prefix of the 34-byte hex digest. You have been warned. >+ >+=head1 Method: id_length() >+ >+Returns 34 because that's the number of bytes in a UUID34 digest. >+ >+This can be used to generate the SQL to create the sessions table. >+ >+See scripts/digest.pl. >+ >+=head1 Support >+ >+Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>. >+ >+=head1 Author >+ >+L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010. >+ >+Home page: L<http://savage.net.au/index.html>. >+ >+=head1 Copyright >+ >+Australian copyright (c) 2010, Ron Savage. >+ >+ All Programs of mine are 'OSI Certified Open Source Software'; >+ you can redistribute them and/or modify them under the terms of >+ The Artistic License, a copy of which is available at: >+ http://www.opensource.org/licenses/index.html >+ >+=cut >diff --git a/lib/Data/Session/ID/UUID36.pm b/lib/Data/Session/ID/UUID36.pm >new file mode 100644 >index 00000000000..0a337694cef >--- /dev/null >+++ b/lib/Data/Session/ID/UUID36.pm >@@ -0,0 +1,147 @@ >+package Data::Session::ID::UUID36; >+ >+use parent 'Data::Session::ID'; >+no autovivification; >+use strict; >+use warnings; >+ >+use Data::UUID; >+ >+use Hash::FieldHash ':all'; >+ >+our $VERSION = '1.18'; >+ >+# ----------------------------------------------- >+ >+sub generate >+{ >+ my($self) = @_; >+ >+ return Data::UUID -> new -> create_str; >+ >+} # End of generate. >+ >+# ----------------------------------------------- >+ >+sub id_length >+{ >+ my($self) = @_; >+ >+ return 36; >+ >+} # End of id_length. >+ >+# ----------------------------------------------- >+ >+sub init >+{ >+ my($self, $arg) = @_; >+ $$arg{id_length} = 36; # Bytes. >+ $$arg{verbose} ||= 0; >+ >+} # End of init. >+ >+# ----------------------------------------------- >+ >+sub new >+{ >+ my($class, %arg) = @_; >+ >+ $class -> init(\%arg); >+ >+ return from_hash(bless({}, $class), \%arg); >+ >+} # End of new. >+ >+# ----------------------------------------------- >+ >+1; >+ >+=pod >+ >+=head1 NAME >+ >+L<Data::Session::ID::UUID36> - A persistent session manager >+ >+=head1 Synopsis >+ >+See L<Data::Session> for details. >+ >+=head1 Description >+ >+L<Data::Session::ID::UUID36> allows L<Data::Session> to generate session ids using L<Data::UUID>. >+ >+To use this module do this: >+ >+=over 4 >+ >+=item o Specify an id generator of type UUID36, as Data::Session -> new(type => '... id:UUID36 ...') >+ >+=back >+ >+=head1 Case-sensitive Options >+ >+See L<Data::Session/Case-sensitive Options> for important information. >+ >+=head1 Method: new() >+ >+Creates a new object of type L<Data::Session::ID::UUID36>. >+ >+C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations >+might be mandatory. >+ >+The keys are listed here in alphabetical order. >+ >+They are lower-case because they are (also) method names, meaning they can be called to set or get >+the value at any time. >+ >+=over 4 >+ >+=item o verbose => $integer >+ >+Print to STDERR more or less information. >+ >+Typical values are 0, 1 and 2. >+ >+This key is normally passed in as Data::Session -> new(verbose => $integer). >+ >+This key is optional. >+ >+=back >+ >+=head1 Method: generate() >+ >+Generates the next session id, or dies if it can't. >+ >+The algorithm is Data::UUID -> new -> create_str. >+ >+Returns the new id. >+ >+=head1 Method: id_length() >+ >+Returns 36 because that's the number of bytes in a UUID36 digest. >+ >+This can be used to generate the SQL to create the sessions table. >+ >+See scripts/digest.pl. >+ >+=head1 Support >+ >+Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>. >+ >+=head1 Author >+ >+L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010. >+ >+Home page: L<http://savage.net.au/index.html>. >+ >+=head1 Copyright >+ >+Australian copyright (c) 2010, Ron Savage. >+ >+ All Programs of mine are 'OSI Certified Open Source Software'; >+ you can redistribute them and/or modify them under the terms of >+ The Artistic License, a copy of which is available at: >+ http://www.opensource.org/licenses/index.html >+ >+=cut >diff --git a/lib/Data/Session/ID/UUID64.pm b/lib/Data/Session/ID/UUID64.pm >new file mode 100644 >index 00000000000..794b60d99b9 >--- /dev/null >+++ b/lib/Data/Session/ID/UUID64.pm >@@ -0,0 +1,154 @@ >+package Data::Session::ID::UUID64; >+ >+use parent 'Data::Session::ID'; >+no autovivification; >+use strict; >+use warnings; >+ >+use Data::UUID; >+ >+use Hash::FieldHash ':all'; >+ >+our $VERSION = '1.18'; >+ >+# ----------------------------------------------- >+ >+sub generate >+{ >+ my($self) = @_; >+ >+ return Data::UUID -> new -> create_b64; >+ >+} # End of generate. >+ >+# ----------------------------------------------- >+ >+sub id_length >+{ >+ my($self) = @_; >+ >+ return 24; # sic. >+ >+} # End of id_length. >+ >+# ----------------------------------------------- >+ >+sub init >+{ >+ my($self, $arg) = @_; >+ $$arg{id_length} = 24; # Bytes. >+ $$arg{verbose} ||= 0; >+ >+} # End of init. >+ >+# ----------------------------------------------- >+ >+sub new >+{ >+ my($class, %arg) = @_; >+ >+ $class -> init(\%arg); >+ >+ return from_hash(bless({}, $class), \%arg); >+ >+} # End of new. >+ >+# ----------------------------------------------- >+ >+1; >+ >+=pod >+ >+=head1 NAME >+ >+L<Data::Session::ID::UUID64> - A persistent session manager >+ >+=head1 Synopsis >+ >+See L<Data::Session> for details. >+ >+=head1 Description >+ >+L<Data::Session::ID::UUID64> allows L<Data::Session> to generate session ids using L<Data::UUID>. >+ >+To use this module do this: >+ >+=over 4 >+ >+=item o Specify an id generator of type UUID64, as Data::Session -> new(type => '... id:UUID64 ...') >+ >+=back >+ >+Note: The uuid will be 24 (sic) bytes because that's the number of bytes in a UUID64 digest. >+ >+See scripts/digest.pl. >+ >+=head1 Case-sensitive Options >+ >+See L<Data::Session/Case-sensitive Options> for important information. >+ >+=head1 Method: new() >+ >+Creates a new object of type L<Data::Session::ID::UUID64>. >+ >+C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations >+might be mandatory. >+ >+The keys are listed here in alphabetical order. >+ >+They are lower-case because they are (also) method names, meaning they can be called to set or get >+the value at any time. >+ >+=over 4 >+ >+=item o verbose => $integer >+ >+Print to STDERR more or less information. >+ >+Typical values are 0, 1 and 2. >+ >+This key is normally passed in as Data::Session -> new(verbose => $integer). >+ >+This key is optional. >+ >+=back >+ >+=head1 Method: generate() >+ >+Generates the next session id, or dies if it can't. >+ >+The algorithm is Data::UUID -> new -> create_b64. >+ >+Returns the new id. >+ >+Warning: You should never try to use 'driver:File;id:UUID64;...', since the ids generated by >+this module sometimes contain '/', which the code forbids to be part of a file name. >+ >+=head1 Method: id_length() >+ >+Returns 24 (sic) because that's the number of bytes in a UUID64 digest. >+ >+This can be used to generate the SQL to create the sessions table. >+ >+See scripts/digest.pl. >+ >+=head1 Support >+ >+Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>. >+ >+=head1 Author >+ >+L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010. >+ >+Home page: L<http://savage.net.au/index.html>. >+ >+=head1 Copyright >+ >+Australian copyright (c) 2010, Ron Savage. >+ >+ All Programs of mine are 'OSI Certified Open Source Software'; >+ you can redistribute them and/or modify them under the terms of >+ The Artistic License, a copy of which is available at: >+ http://www.opensource.org/licenses/index.html >+ >+=cut >diff --git a/lib/Data/Session/SHA.pm b/lib/Data/Session/SHA.pm >new file mode 100644 >index 00000000000..f0b0a58e372 >--- /dev/null >+++ b/lib/Data/Session/SHA.pm >@@ -0,0 +1,77 @@ >+package Data::Session::SHA; >+ >+use parent 'Data::Session::Base'; >+no autovivification; >+use strict; >+use warnings; >+ >+use Digest::SHA; >+ >+use Hash::FieldHash ':all'; >+ >+our $errstr = ''; >+our $VERSION = '1.18'; >+ >+# ----------------------------------------------- >+ >+sub generate >+{ >+ my($self, $bits) = @_; >+ >+ return Digest::SHA -> new($bits) -> add($$, time, rand(time) ) -> hexdigest; >+ >+} # End of generate. >+ >+# ----------------------------------------------- >+ >+sub new >+{ >+ my($class, %arg) = @_; >+ $arg{verbose} ||= 0; >+ >+ return from_hash(bless({}, $class), \%arg); >+ >+} # End of new. >+ >+# ----------------------------------------------- >+ >+1; >+ >+=pod >+ >+=head1 NAME >+ >+L<Data::Session::SHA> - A persistent session manager >+ >+=head1 Synopsis >+ >+See L<Data::Session> for details. >+ >+=head1 Description >+ >+L<Data::Session::SHA> is the parent of all L<Data::Session::SHA::*> modules. >+ >+=head1 Case-sensitive Options >+ >+See L<Data::Session/Case-sensitive Options> for important information. >+ >+=head1 Support >+ >+Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>. >+ >+=head1 Author >+ >+L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010. >+ >+Home page: L<http://savage.net.au/index.html>. >+ >+=head1 Copyright >+ >+Australian copyright (c) 2010, Ron Savage. >+ >+ All Programs of mine are 'OSI Certified Open Source Software'; >+ you can redistribute them and/or modify them under the terms of >+ The Artistic License, a copy of which is available at: >+ http://www.opensource.org/licenses/index.html >+ >+=cut >diff --git a/lib/Data/Session/Serialize/DataDumper.pm b/lib/Data/Session/Serialize/DataDumper.pm >new file mode 100644 >index 00000000000..475c01a14ce >--- /dev/null >+++ b/lib/Data/Session/Serialize/DataDumper.pm >@@ -0,0 +1,265 @@ >+package Data::Session::Serialize::DataDumper; >+ >+use parent 'Data::Session::Base'; >+no autovivification; >+use strict; >+use warnings; >+ >+use Data::Dumper; >+ >+use Safe; >+ >+use Scalar::Util qw(blessed reftype refaddr); >+ >+use vars qw( %overloaded ); >+ >+require overload; >+ >+our $VERSION = '1.18'; >+ >+# ----------------------------------------------- >+ >+sub freeze >+{ >+ my($self, $data) = @_; >+ my($d) = Data::Dumper -> new([$data], ["D"]); >+ >+ $d -> Deepcopy(0); >+ $d -> Indent(0); >+ $d -> Purity(1); >+ $d -> Quotekeys(1); >+ $d -> Terse(0); >+ $d -> Useqq(0); >+ >+ return $d ->Dump; >+ >+} # End of freeze. >+ >+# ----------------------------------------------- >+ >+sub new >+{ >+ my($class) = @_; >+ >+ return bless({}, $class); >+ >+} # End of new. >+ >+# ----------------------------------------------- >+# We need to do this because the values we get back from the safe compartment >+# will have packages defined from the safe compartment's *main instead of >+# the one we use. >+ >+sub _scan >+{ >+ # $_ gets aliased to each value from @_ which are aliases of the values in >+ # the current data structure. >+ >+ for (@_) >+ { >+ if (blessed $_) >+ { >+ if (overload::Overloaded($_) ) >+ { >+ my($address) = refaddr $_; >+ >+ # If we already rebuilt and reblessed this item, use the cached >+ # copy so our ds is consistent with the one we serialized. >+ >+ if (exists $overloaded{$address}) >+ { >+ $_ = $overloaded{$address}; >+ } >+ else >+ { >+ my($reftype) = reftype $_; >+ >+ if ($reftype eq "HASH") >+ { >+ $_ = $overloaded{$address} = bless { %$_ }, ref $_; >+ } >+ elsif ($reftype eq "ARRAY") >+ { >+ $_ = $overloaded{$address} = bless [ @$_ ], ref $_; >+ } >+ elsif ($reftype eq "SCALAR" || $reftype eq "REF") >+ { >+ $_ = $overloaded{$address} = bless \do{my $o = $$_}, ref $_; >+ } >+ else >+ { >+ die __PACKAGE__ . ". Do not know how to reconstitute blessed object of base type $reftype"; >+ } >+ } >+ } >+ else >+ { >+ bless $_, ref $_; >+ } >+ } >+ } >+ >+ return @_; >+ >+} # End of _scan. >+ >+# ----------------------------------------------- >+ >+sub thaw >+{ >+ my($self, $data) = @_; >+ >+ # To make -T happy. >+ >+ my($safe_string) = $data =~ m/^(.*)$/s; >+ my($rv) = Safe -> new -> reval($safe_string); >+ >+ if ($@) >+ { >+ die __PACKAGE__ . ". Couldn't thaw. $@"; >+ } >+ >+ _walk($rv); >+ >+ return $rv; >+ >+} # End of thaw. >+ >+# ----------------------------------------------- >+ >+sub _walk >+{ >+ my(@filter) = _scan(shift); >+ >+ local %overloaded; >+ >+ my(%seen); >+ >+ # We allow the value assigned to a key to be undef. >+ # Hence the defined() test is not in the while(). >+ >+ while (@filter) >+ { >+ defined(my $x = shift @filter) or next; >+ >+ $seen{refaddr $x || ''}++ and next; >+ >+ # The original syntax my($r) = reftype($x) or next led to if ($r...) >+ # issuing an uninit warning when $r was undef. >+ >+ my($r) = reftype($x) || next; >+ >+ if ($r eq "HASH") >+ { >+ # We use this form to make certain we have aliases >+ # to the values in %$x and not copies. >+ >+ push @filter, _scan(@{$x}{keys %$x}); >+ } >+ elsif ($r eq "ARRAY") >+ { >+ push @filter, _scan(@$x); >+ } >+ elsif ($r eq "SCALAR" || $r eq "REF") >+ { >+ push @filter, _scan($$x); >+ } >+ } >+ >+} # End of _walk. >+ >+# ----------------------------------------------- >+ >+1; >+ >+=pod >+ >+=head1 NAME >+ >+L<Data::Session::Serialize::DataDumper> - A persistent session manager >+ >+=head1 Synopsis >+ >+See L<Data::Session> for details. >+ >+=head1 Description >+ >+L<Data::Session::Serialize::DataDumper> allows L<Data::Session> to manipulate sessions with >+L<Data::Dumper>. >+ >+To use this module do this: >+ >+=over 4 >+ >+=item o Specify a driver of type DataDumper as >+Data::Session -> new(type=> '... serialize:DataDumper') >+ >+=back >+ >+The Data::Dumper options used are: >+ >+ $d -> Deepcopy(0); >+ $d -> Indent(0); >+ $d -> Purity(1); >+ $d -> Quotekeys(1); >+ $d -> Terse(0); >+ $d -> Useqq(0); >+ >+=head1 Case-sensitive Options >+ >+See L<Data::Session/Case-sensitive Options> for important information. >+ >+=head1 Method: new() >+ >+Creates a new object of type L<Data::Session::Serialize::DataDumper>. >+ >+C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations >+might be mandatory. >+ >+The keys are listed here in alphabetical order. >+ >+They are lower-case because they are (also) method names, meaning they can be called to set or get >+the value at any time. >+ >+=over 4 >+ >+=item o verbose => $integer >+ >+Print to STDERR more or less information. >+ >+Typical values are 0, 1 and 2. >+ >+This key is normally passed in as Data::Session -> new(verbose => $integer). >+ >+This key is optional. >+ >+=back >+ >+=head1 Method: freeze($data) >+ >+Returns $data frozen by L<Data::Dumper>. >+ >+=head1 Method: thaw($data) >+ >+Returns $data thawed by L<Data::Dumper>. >+ >+=head1 Support >+ >+Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>. >+ >+=head1 Author >+ >+L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010. >+ >+Home page: L<http://savage.net.au/index.html>. >+ >+=head1 Copyright >+ >+Australian copyright (c) 2010, Ron Savage. >+ >+ All Programs of mine are 'OSI Certified Open Source Software'; >+ you can redistribute them and/or modify them under the terms of >+ The Artistic License, a copy of which is available at: >+ http://www.opensource.org/licenses/index.html >+ >+=cut >diff --git a/lib/Data/Session/Serialize/FreezeThaw.pm b/lib/Data/Session/Serialize/FreezeThaw.pm >new file mode 100644 >index 00000000000..aa5b42d6e87 >--- /dev/null >+++ b/lib/Data/Session/Serialize/FreezeThaw.pm >@@ -0,0 +1,127 @@ >+package Data::Session::Serialize::FreezeThaw; >+ >+use parent 'Data::Session::Base'; >+no autovivification; >+use strict; >+use warnings; >+ >+use FreezeThaw; >+ >+our $VERSION = '1.18'; >+ >+# ----------------------------------------------- >+ >+sub freeze >+{ >+ my($self, $data) = @_; >+ >+ return FreezeThaw::freeze($data); >+ >+} # End of freeze. >+ >+# ----------------------------------------------- >+ >+sub new >+{ >+ my($class) = @_; >+ >+ return bless({}, $class); >+ >+} # End of new. >+ >+# ----------------------------------------------- >+ >+sub thaw >+{ >+ my($self, $data) = @_; >+ >+ return (FreezeThaw::thaw($data) )[0]; >+ >+} # End of thaw. >+ >+# ----------------------------------------------- >+ >+1; >+ >+=pod >+ >+=head1 NAME >+ >+L<Data::Session::Serialize::FreezeThaw> - A persistent session manager >+ >+=head1 Synopsis >+ >+See L<Data::Session> for details. >+ >+=head1 Description >+ >+L<Data::Session::Serialize::FreezeThaw> allows L<Data::Session> to manipulate sessions with >+L<FreezeThaw>. >+ >+To use this module do this: >+ >+=over 4 >+ >+=item o Specify a driver of type FreezeThaw as >+Data::Session -> new(type => '... serialize:FreezeThaw') >+ >+=back >+ >+=head1 Case-sensitive Options >+ >+See L<Data::Session/Case-sensitive Options> for important information. >+ >+=head1 Method: new() >+ >+Creates a new object of type L<Data::Session::Serialize::FreezeThaw>. >+ >+C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations >+might be mandatory. >+ >+The keys are listed here in alphabetical order. >+ >+They are lower-case because they are (also) method names, meaning they can be called to set or get >+the value at any time. >+ >+=over 4 >+ >+=item o verbose => $integer >+ >+Print to STDERR more or less information. >+ >+Typical values are 0, 1 and 2. >+ >+This key is normally passed in as Data::Session -> new(verbose => $integer). >+ >+This key is optional. >+ >+=back >+ >+=head1 Method: freeze($data) >+ >+Returns $data frozen by L<FreezeThaw>. >+ >+=head1 Method: thaw($data) >+ >+Returns $data thawed by L<FreezeThaw>. >+ >+=head1 Support >+ >+Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>. >+ >+=head1 Author >+ >+L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010. >+ >+Home page: L<http://savage.net.au/index.html>. >+ >+=head1 Copyright >+ >+Australian copyright (c) 2010, Ron Savage. >+ >+ All Programs of mine are 'OSI Certified Open Source Software'; >+ you can redistribute them and/or modify them under the terms of >+ The Artistic License, a copy of which is available at: >+ http://www.opensource.org/licenses/index.html >+ >+=cut >diff --git a/lib/Data/Session/Serialize/JSON.pm b/lib/Data/Session/Serialize/JSON.pm >new file mode 100644 >index 00000000000..e6192faba6a >--- /dev/null >+++ b/lib/Data/Session/Serialize/JSON.pm >@@ -0,0 +1,125 @@ >+package Data::Session::Serialize::JSON; >+ >+use parent 'Data::Session::Base'; >+no autovivification; >+use strict; >+use warnings; >+ >+use JSON; >+ >+our $VERSION = '1.18'; >+ >+# ----------------------------------------------- >+ >+sub freeze >+{ >+ my($self, $data) = @_; >+ >+ return JSON -> new -> encode($data); >+ >+} # End of freeze. >+ >+# ----------------------------------------------- >+ >+sub new >+{ >+ my($class) = @_; >+ >+ return bless({}, $class); >+ >+} # End of new. >+ >+# ----------------------------------------------- >+ >+sub thaw >+{ >+ my($self, $data) = @_; >+ >+ return JSON -> new -> decode($data); >+ >+} # End of thaw. >+ >+# ----------------------------------------------- >+ >+1; >+ >+=pod >+ >+=head1 NAME >+ >+L<Data::Session::Serialize::JSON> - A persistent session manager >+ >+=head1 Synopsis >+ >+See L<Data::Session> for details. >+ >+=head1 Description >+ >+L<Data::Session::Serialize::JSON> allows L<Data::Session> to manipulate sessions with L<JSON>. >+ >+To use this module do this: >+ >+=over 4 >+ >+=item o Specify a driver of type JSON as Data::Session -> new(type => '... serialize:JSON') >+ >+=back >+ >+=head1 Case-sensitive Options >+ >+See L<Data::Session/Case-sensitive Options> for important information. >+ >+=head1 Method: new() >+ >+Creates a new object of type L<Data::Session::Serialize::JSON>. >+ >+C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations >+might be mandatory. >+ >+The keys are listed here in alphabetical order. >+ >+They are lower-case because they are (also) method names, meaning they can be called to set or get >+the value at any time. >+ >+=over 4 >+ >+=item o verbose => $integer >+ >+Print to STDERR more or less information. >+ >+Typical values are 0, 1 and 2. >+ >+This key is normally passed in as Data::Session -> new(verbose => $integer). >+ >+This key is optional. >+ >+=back >+ >+=head1 Method: freeze($data) >+ >+Returns $data frozen by L<JSON>. >+ >+=head1 Method: thaw($data) >+ >+Returns $data thawed by L<JSON>. >+ >+=head1 Support >+ >+Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>. >+ >+=head1 Author >+ >+L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010. >+ >+Home page: L<http://savage.net.au/index.html>. >+ >+=head1 Copyright >+ >+Australian copyright (c) 2010, Ron Savage. >+ >+ All Programs of mine are 'OSI Certified Open Source Software'; >+ you can redistribute them and/or modify them under the terms of >+ The Artistic License, a copy of which is available at: >+ http://www.opensource.org/licenses/index.html >+ >+=cut >diff --git a/lib/Data/Session/Serialize/Storable.pm b/lib/Data/Session/Serialize/Storable.pm >new file mode 100644 >index 00000000000..cb13c690213 >--- /dev/null >+++ b/lib/Data/Session/Serialize/Storable.pm >@@ -0,0 +1,129 @@ >+package Data::Session::Serialize::Storable; >+ >+use parent 'Data::Session::Base'; >+no autovivification; >+use strict; >+use warnings; >+ >+use Storable; >+ >+our $VERSION = '1.18'; >+ >+# ----------------------------------------------- >+ >+sub freeze >+{ >+ my($self, $data) = @_; >+ >+ return Storable::freeze($data); >+ >+} # End of freeze. >+ >+# ----------------------------------------------- >+ >+sub new >+{ >+ my($class) = @_; >+ >+ return bless({}, $class); >+ >+} # End of new. >+ >+# ----------------------------------------------- >+ >+sub thaw >+{ >+ my($self, $data) = @_; >+ >+ return Storable::thaw($data); >+ >+} # End of thaw. >+ >+# ----------------------------------------------- >+ >+1; >+ >+=pod >+ >+=head1 NAME >+ >+L<Data::Session::Serialize::Storable> - A persistent session manager >+ >+=head1 Synopsis >+ >+See L<Data::Session> for details. >+ >+Warning: Storable should be avoided until this problem is fixed: >+L<http://rt.cpan.org/Public/Bug/Display.html?id=36087> >+ >+=head1 Description >+ >+L<Data::Session::Serialize::Storable> allows L<Data::Session> to manipulate sessions with >+L<Storable>. >+ >+To use this module do this: >+ >+=over 4 >+ >+=item o Specify a driver of type Storable as Data::Session -> new(type => '... serialize:Storable') >+ >+=back >+ >+=head1 Case-sensitive Options >+ >+See L<Data::Session/Case-sensitive Options> for important information. >+ >+=head1 Method: new() >+ >+Creates a new object of type L<Data::Session::Serialize::Storable>. >+ >+C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations >+might be mandatory. >+ >+The keys are listed here in alphabetical order. >+ >+They are lower-case because they are (also) method names, meaning they can be called to set or get >+the value at any time. >+ >+=over 4 >+ >+=item o verbose => $integer >+ >+Print to STDERR more or less information. >+ >+Typical values are 0, 1 and 2. >+ >+This key is normally passed in as Data::Session -> new(verbose => $integer). >+ >+This key is optional. >+ >+=back >+ >+=head1 Method: freeze($data) >+ >+Returns $data frozen by L<Storable>. >+ >+=head1 Method: thaw($data) >+ >+Returns $data thawed by L<Storable>. >+ >+=head1 Support >+ >+Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>. >+ >+=head1 Author >+ >+L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010. >+ >+Home page: L<http://savage.net.au/index.html>. >+ >+=head1 Copyright >+ >+Australian copyright (c) 2010, Ron Savage. >+ >+ All Programs of mine are 'OSI Certified Open Source Software'; >+ you can redistribute them and/or modify them under the terms of >+ The Artistic License, a copy of which is available at: >+ http://www.opensource.org/licenses/index.html >+ >+=cut >diff --git a/lib/Data/Session/Serialize/YAML.pm b/lib/Data/Session/Serialize/YAML.pm >new file mode 100644 >index 00000000000..0c51e97364d >--- /dev/null >+++ b/lib/Data/Session/Serialize/YAML.pm >@@ -0,0 +1,125 @@ >+package Data::Session::Serialize::YAML; >+ >+use parent 'Data::Session::Base'; >+no autovivification; >+use strict; >+use warnings; >+ >+use YAML::Tiny (); >+ >+our $VERSION = '1.18'; >+ >+# ----------------------------------------------- >+ >+sub freeze >+{ >+ my($self, $data) = @_; >+ >+ return YAML::Tiny::freeze($data); >+ >+} # End of freeze. >+ >+# ----------------------------------------------- >+ >+sub new >+{ >+ my($class) = @_; >+ >+ return bless({}, $class); >+ >+} # End of new. >+ >+# ----------------------------------------------- >+ >+sub thaw >+{ >+ my($self, $data) = @_; >+ >+ return YAML::Tiny::thaw($data); >+ >+} # End of thaw. >+ >+# ----------------------------------------------- >+ >+1; >+ >+=pod >+ >+=head1 NAME >+ >+L<Data::Session::Serialize::YAML> - A persistent session manager >+ >+=head1 Synopsis >+ >+See L<Data::Session> for details. >+ >+=head1 Description >+ >+L<Data::Session::Serialize::YAML> allows L<Data::Session> to manipulate sessions with L<YAML::Tiny>. >+ >+To use this module do this: >+ >+=over 4 >+ >+=item o Specify a driver of type YAML as Data::Session -> new(type => '... serialize:YAML') >+ >+=back >+ >+=head1 Case-sensitive Options >+ >+See L<Data::Session/Case-sensitive Options> for important information. >+ >+=head1 Method: new() >+ >+Creates a new object of type L<Data::Session::Serialize::YAML>. >+ >+C<new()> takes a hash of key/value pairs, some of which might mandatory. Further, some combinations >+might be mandatory. >+ >+The keys are listed here in alphabetical order. >+ >+They are lower-case because they are (also) method names, meaning they can be called to set or get >+the value at any time. >+ >+=over 4 >+ >+=item o verbose => $integer >+ >+Print to STDERR more or less information. >+ >+Typical values are 0, 1 and 2. >+ >+This key is normally passed in as Data::Session -> new(verbose => $integer). >+ >+This key is optional. >+ >+=back >+ >+=head1 Method: freeze($data) >+ >+Returns $data frozen by L<YAML::Tiny>. >+ >+=head1 Method: thaw($data) >+ >+Returns $data thawed by L<YAML::Tiny>. >+ >+=head1 Support >+ >+Log a bug on RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Session>. >+ >+=head1 Author >+ >+L<Data::Session> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>> in 2010. >+ >+Home page: L<http://savage.net.au/index.html>. >+ >+=head1 Copyright >+ >+Australian copyright (c) 2010, Ron Savage. >+ >+ All Programs of mine are 'OSI Certified Open Source Software'; >+ you can redistribute them and/or modify them under the terms of >+ The Artistic License, a copy of which is available at: >+ http://www.opensource.org/licenses/index.html >+ >+=cut >-- >2.25.1
You cannot view the attachment while viewing its details because your browser does not support IFRAMEs.
View the attachment on a separate page
.
View Attachment As Diff
View Attachment As Raw
Actions:
View
|
Diff
|
Splinter Review
Attachments on
bug 17427
:
56185
|
56504
|
56572
|
57067
|
60355
|
121337
|
121633
|
121657
|
121658
|
121659
|
150569
|
150570
|
150571
|
150603
|
150604
|
150605
|
150606
|
150633
|
150634
|
150635
|
150636
|
150637
|
150638
|
150639
|
150926
|
150927
|
150928
|
150929
|
150930
|
150931
|
153030
|
153031
|
153032
|
153033
|
153034
|
153035
| 153036 |
153037
|
153038
|
153039
|
153040