From 53b8e76db3296be4478d6625514c61a997298123 Mon Sep 17 00:00:00 2001 From: Jonathan Druart 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 < + $title + + Number of times this script has been run: $count.
+ Current value of $name: $id.
+
+ + +
+ + + 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. + +=head1 Description + +L 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 for an extended discussion of the design changes between +L and L. + +L 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. + +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, or - if new() fails - it returns undef. +For details see L. + +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 for +example code. + +The questions of combinations of options, and which option has priority over other options, +are addressed in the section, L. + +=over 4 + +=item o cache => $cache + +Specifies an object of type L or L to use for storage. + +Only needed if you use 'type' like 'driver:BerkeleyDB ...' or 'driver:Memcached ...'. + +See L and L. + +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'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'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 and +L. + +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. + +See L 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 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 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. + +=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 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, 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). + +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 and L. + +=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'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 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 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 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. + +=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'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 for what happens when verbose is 2. + +=back + +=head3 Specifying Session Options + +See also L. + +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 for storage. In this case, you must pass an object of type L +to new() as the value of the 'cache' option. + +See L. + +=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 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. + +=item o Memcached + +Use C for storage. In this case, you must pass an object of type L to +new() as the value of the 'cache' option. + +See L. + +=item o mysql + +This says each session is stored in a separate row of a database table using the L +database server. + +These rows have a unique primary id equal to the session id. + +See L. + +=item o ODBC + +This says each session is stored in a separate row of a database table using the L +database connector. + +These rows have a unique primary id equal to the session id. + +See L. + +=item o Oracle + +This says each session is stored in a separate row of a database table using the L +database server. + +These rows have a unique primary id equal to the session id. + +See L. + +=item o Pg + +This says each session is stored in a separate row of a database table using the L database +server. + +These rows have a unique primary id equal to the session id. + +See L. + +=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 are shipped with all recent versions of Perl. + +See L. + +=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 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. + +=item o MD5 + +The default, 'MD5', says ids are to be generated by L. + +See L. + +=item o SHA1 + +This says ids are to be generated by L, using a digest algorithm of 1. + +See L. + +=item o SHA256 + +This says ids are to be generated by L, using a digest algorithm of 256. + +See L. + +=item o SHA512 + +This says ids are to be generated by L, using a digest algorithm of 512. + +See L. + +=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 dies on all values Perl regards as +false. + +See L. + +=item o UUID16 + +This says ids are to be generated by L, to generate a 16 byte long binary UUID. + +See L. + +=item o UUID34 + +This says ids are to be generated by L, to generate a 34 byte long string UUID. + +See L. + +=item o UUID36 + +This says ids are to be generated by L, to generate a 36 byte long string UUID. + +See L. + +=item o UUID64 + +This says ids are to be generated by L, to generate a 24 (sic) byte long, base-64 +encoded, UUID. + +See L. + +=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 to freeze/thaw sessions. + +See L. + +=item o FreezeThaw + +Use L to freeze/thaw sessions. + +See L. + +=item o JSON + +Use L to freeze/thaw sessions. + +See L. + +=item o Storable + +Use L to freeze/thaw sessions. + +See L. + +Warning: Storable should be avoided until this problem is fixed: +L. + +=item o YAML + +Use L to freeze/thaw sessions. + +See L. + +=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 + +This name comes from L. + +And yes, the module uses L and not L. + +=item o L + +=item o L + +This name comes from L even though the external program you run is called +memcached. + +=item o L + +=item o L + +=item o L + +=item o L + +=item o L + +=back + +ID generators: + +=over 4 + +=item o L + +=item o L + +=item o L + +=item o L + +=item o L + +=item o L + +=item o L + +=item o L + +=item o L + +=item o L + +=back + +Serializers: + +=over 4 + +=item o L + +=item o L + +=item o L + +=item o L + +Warning: Storable should be avoided until this problem is fixed: +L + +=item o L + +=back + +=head3 Specifying an Id + +L 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, 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:;...'), 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. + +See also L, L and L. + +=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 for precisely what this means. + +=item o Sets the expired flag + +See L. + +=back + +This is used when the session is loaded, when you call L, 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 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, and hence should I be passed in, +are: + +=over 4 + +=item o -expires + +=item o -name + +=item o -value + +=back + +See L 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, except for new sessions. + +See also L, L and L. + +=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 and L. + +=head2 deleted() + +Returns a Boolean (0/1) indicating whether or not the session has been deleted. + +See also L and L. + +=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 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, L and L. + +=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. See below and L. + +When a session expires, it is deleted from storage. See L 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 +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 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. 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, L, L, L and +L. + +=head2 expired() + +Returns a Boolean (0/1) indicating whether or not the session has expired. + +See L. + +=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 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. See L and +L. + +=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 print the header. You have to do that, when +appropriate. + +Unlike L, L does I 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 and L default to 'text/html'. + +L 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 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. + +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. + +=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. + +See also L, L and L. + +=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 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 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 (Oracle and Perl) are in +L. + +Simple instructions for installing L and memcached are in +L. + +=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 have a I method + +Let's say your L script sub-classes L or it's successor L. + +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. Basically, you're storing a value +(via 'param') inside $self. + +But when you store an object of type Data::Session using I, it looks like this: + + $self -> param(session => Data::Session -> new(...) ); + +Now, Data::Session itself I implements a method called I. 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 methods. + +=item o 2: How exactly should a L script save a session? + +The first example in the Synopsis shows a very simple L script doing the right thing by +calling I just before it exits. + +Alternately, if you sub-class L, the call to I is best placed in your +I method, which is where you override L. The point here is that +your I is called automatically at the end of each run mode. + +This important matter is also discussed in L 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, below, to understand why flush() must be called explicitly in +persistent environments. + +=item o Why don't the test scripts use L? + +I decided to circumvent it by using L and adopting the wonders of nested +testing. But, since V 1.11, I've replaced that module with L, to reduce dependencies, +and hence to make it easier to get L 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? + +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) +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 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 or similar, but you don't pass that object into +L 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. + +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 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, 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 before assuming the fault is with L. + +=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 + +=head1 Support + +LBugs should be reported via the CPAN bug tracker at + +L + +=head1 Thanks + +Many thanks are due to all the people who contributed to both L and +L. + +Likewise, many thanks to the implementors of nesting testing. See L. + +=head1 Author + +L was written by Ron Savage Iron@savage.net.auE> in 2010. + +Home page: L. + +=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 - A persistent session manager + +=head1 Synopsis + +See L 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. + +=head1 Author + +L was written by Ron Savage Iron@savage.net.auE> in 2010. + +Home page: L. + +=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 - 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 and L. + +The interface to L is not quite compatible with that of L, hence the +new namespace. + +The purpose of L is to be a brand-new alternative to both L and +L. + +=head1 Aliases for Method Names + +Aliases for method names are not supported. + +In L, methods etime() and expires() were aliased to expire(). This is not supported +in L. + +L does have an etime() method, L, which is different. + +In L, method header() was aliased to http_header(). Only the latter method is +supported in L. See L and L. + +In L, id generators had a method generate_id() aliased to generate(). This is not +supported in L. + +In L, method param_dataref() was aliased to dataref(). Neither of these methods is +supported in L. 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 is not I backwards-compatible with L, 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 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, persistent environments stop your program exiting in the way +you are used to. This matter is discussed in L. + +=back + +=head1 CGI::Session::ExpireSessions is obsolete + +Instead, consider using scripts/expire.pl, which ships with L. + +=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 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. 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, L and +L. + +For example, driver:pg is now driver:Pg, which actually means L, based on +the class name L. + +=head1 Exceptions + +Exceptions are caught with L. Errors cause L 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 + +=item o CGI::Session::ID::md5 becomes L + +=item o CGI::Session::ID::sha becomes L + +=item o CGI::Session::ID::sha256 becomes L + +=item o CGI::Session::ID::sha512 becomes L + +=item o CGI::Session::ID::static becomes L + +=item o CGI::Session::ID::uuid becomes L or UUID34 or UUID36 or UUD64 + +=back + +=head1 JSON + +L uses L, not L. + +=head2 Managing Object Attributes + +The light-weight L is used to manage object attributes. + +So, neither L nor L, 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. + +=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 and L default to 'text/html'. + +L 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, L and +L. + +As discussed in L, 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 has been incorporated into other +L drivers. + +=head1 Serialization Drivers + +Serializing classes have been renamed: + +=over 4 + +=item o CGI::Session::Serialize::default becomes L + +=item o CGI::Session::Serialize::freezethaw becomes L + +=item o CGI::Session::Serialize::json becomes L + +The latter will use L. In the past L was used. + +=item o CGI::Session::Serialize::storable becomes L + +=item o CGI::Session::Serialize::yaml becomes L + +The latter uses L. In the past either L or L 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 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 for details. + +=head1 Session modification + +L 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 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 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 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 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 + +The latter no longer uses DB_File. + +=item o CGI::Session::Driver::file becomes L + +=item o CGI::Session::Driver::memcached becomes L + +=item o CGI::Session::Driver::mysql becomes L + +=item o CGI::Session::Driver::odbc becomes L + +=item o CGI::Session::Driver::oracle becomes L + +=item o CGI::Session::Driver::postgresql becomes L + +=item o CGI::Session::Driver::sqlite becomes L + +=back + +=head1 Tests + +All tests have been re-written. + +=head1 The Version of Perl + +Perl 5 code will be used. + +=head1 YAML + +L uses L, not L or L. + +=head1 Author + +L was written by Ron Savage Iron@savage.net.auE> in 2010. + +Home page: L. + +=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 - A persistent session manager + +=head1 Synopsis + +See L for details. + +=head1 Description + +L is the parent of all L modules. + +=head1 Case-sensitive Options + +See L for important information. + +=head1 Method: new() + +Creates a new object of type L. + +C 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 calls the right thaw() automatically. + +=head1 Support + +Log a bug on RT: L. + +=head1 Author + +L was written by Ron Savage Iron@savage.net.auE> in 2010. + +Home page: L. + +=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 - A persistent session manager + +=head1 Synopsis + +See L for details. + +=head1 Description + +L allows L to manipulate sessions via +L. + +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 as Data::Session -> new(cache => $object) + +Also, $object must have been created with a Env parameter of type L. See below. + +=back + +See scripts/berkeleydb.pl. + +=head1 Case-sensitive Options + +See L for important information. + +=head1 Method: new() + +Creates a new object of type L. + +C 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 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, and with +that object having an Env parameter of type L, because this module - +L - uses the L 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 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 method get($id). + +This result is a frozen session. This value must be thawed by calling the appropriate serialization +driver's thaw() method. + +L 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 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. + +=head1 Author + +L was written by Ron Savage Iron@savage.net.auE> in 2010. + +Home page: L. + +=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 - A persistent session manager + +=head1 Synopsis + +See L for details. + +=head1 Description + +L allows L 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 for important information. + +=head1 Method: new() + +Creates a new object of type L. + +C 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 and +L. + +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 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. + +=head1 Author + +L was written by Ron Savage Iron@savage.net.auE> in 2010. + +Home page: L. + +=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 - A persistent session manager + +=head1 Synopsis + +See L for details. + +=head1 Description + +L allows L to manipulate sessions +L. + +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 as Data::Session -> new(cache => $object) + +=back + +See scripts/memcached.pl. + +=head1 Case-sensitive Options + +See L for important information. + +=head1 Method: new() + +Creates a new object of type L. + +C 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 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 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 method get($id). + +This result is a frozen session. This value must be thawed by calling the appropriate serialization +driver's thaw() method. + +L 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, too. + +Returns the result of calling the L 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 documentation, you will have to subclass L 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. + +=head1 Author + +L was written by Ron Savage Iron@savage.net.auE> in 2010. + +Home page: L. + +=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 - A persistent session manager + +=head1 Synopsis + +See L for details. + +=head1 Description + +L allows L to store sessions via L. + +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 for important information. + +=head1 Method: new() + +Creates a new object of type L. + +C 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 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. + +=head1 Author + +L was written by Ron Savage Iron@savage.net.auE> in 2010. + +Home page: L. + +=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 - A persistent session manager + +=head1 Synopsis + +See L for details. + +=head1 Description + +L allows L to store sessions via L. + +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 for important information. + +=head1 Method: new() + +Creates a new object of type L. + +C 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 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. + +=head1 Author + +L was written by Ron Savage Iron@savage.net.auE> in 2010. + +Home page: L. + +=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 - A persistent session manager + +=head1 Synopsis + +See L for details. + +=head1 Description + +L allows L to manipulate sessions via L. + +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 for important information. + +=head1 Method: new() + +Creates a new object of type L. + +C 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 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. + +=head1 Author + +L was written by Ron Savage Iron@savage.net.auE> in 2010. + +Home page: L. + +=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 - A persistent session manager + +=head1 Synopsis + +See L for details. + +=head1 Description + +L allows L to manipulate sessions via L. + +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 for important information. + +=head1 Method: new() + +Creates a new object of type L. + +C 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 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. + +=head1 Author + +L was written by Ron Savage Iron@savage.net.auE> in 2010. + +Home page: L. + +=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 - A persistent session manager + +=head1 Synopsis + +See L for details. + +=head1 Description + +L allows L to manipulate sessions via L. + +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 for important information. + +=head1 Method: new() + +Creates a new object of type L. + +C 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 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. + +=head1 Author + +L was written by Ron Savage Iron@savage.net.auE> in 2010. + +Home page: L. + +=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 - A persistent session manager + +=head1 Synopsis + +See L for details. + +=head1 Description + +L is the parent of all L modules. + +=head1 Case-sensitive Options + +See L for important information. + +=head1 Support + +Log a bug on RT: L. + +=head1 Author + +L was written by Ron Savage Iron@savage.net.auE> in 2010. + +Home page: L. + +=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 - A persistent session manager + +=head1 Synopsis + +See L for details. + +=head1 Description + +L allows L 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 for important information. + +=head1 Method: new() + +Creates a new object of type L. + +C 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. + +=head1 Author + +L was written by Ron Savage Iron@savage.net.auE> in 2010. + +Home page: L. + +=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 - A persistent session manager + +=head1 Synopsis + +See L for details. + +=head1 Description + +L allows L to generate session ids using L. + +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 for important information. + +=head1 Method: new() + +Creates a new object of type L. + +C 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. + +=head1 Author + +L was written by Ron Savage Iron@savage.net.auE> in 2010. + +Home page: L. + +=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 - A persistent session manager + +=head1 Synopsis + +See L for details. + +=head1 Description + +L allows L to generate session ids using L. + +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 for important information. + +=head1 Method: new() + +Creates a new object of type L. + +C 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. + +=head1 Author + +L was written by Ron Savage Iron@savage.net.auE> in 2010. + +Home page: L. + +=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 - A persistent session manager + +=head1 Synopsis + +See L for details. + +=head1 Description + +L allows L to generate session ids using L. + +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 for important information. + +=head1 Method: new() + +Creates a new object of type L. + +C 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. + +=head1 Author + +L was written by Ron Savage Iron@savage.net.auE> in 2010. + +Home page: L. + +=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 - A persistent session manager + +=head1 Synopsis + +See L for details. + +=head1 Description + +L allows L to generate session ids using L. + +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 for important information. + +=head1 Method: new() + +Creates a new object of type L. + +C 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. + +=head1 Author + +L was written by Ron Savage Iron@savage.net.auE> in 2010. + +Home page: L. + +=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 - A persistent session manager + +=head1 Synopsis + +See L for details. + +=head1 Description + +L allows L 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 for important information. + +=head1 Method: new() + +Creates a new object of type L. + +C 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. + +=head1 Author + +L was written by Ron Savage Iron@savage.net.auE> in 2010. + +Home page: L. + +=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 - A persistent session manager + +=head1 Synopsis + +See L for details. + +=head1 Case-sensitive Options + +See L 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 allows L to generate session ids using L. + +=head1 Method: new() + +Creates a new object of type L. + +C 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. + +=head1 Author + +L was written by Ron Savage Iron@savage.net.auE> in 2010. + +Home page: L. + +=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 - A persistent session manager + +=head1 Synopsis + +See L for details. + +=head1 Description + +L allows L to generate session ids using L. + +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 for important information. + +=head1 Method: new() + +Creates a new object of type L. + +C 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 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. + +=head1 Author + +L was written by Ron Savage Iron@savage.net.auE> in 2010. + +Home page: L. + +=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 - A persistent session manager + +=head1 Synopsis + +See L for details. + +=head1 Description + +L allows L to generate session ids using L. + +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 for important information. + +=head1 Method: new() + +Creates a new object of type L. + +C 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. + +=head1 Author + +L was written by Ron Savage Iron@savage.net.auE> in 2010. + +Home page: L. + +=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 - A persistent session manager + +=head1 Synopsis + +See L for details. + +=head1 Description + +L allows L to generate session ids using L. + +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 for important information. + +=head1 Method: new() + +Creates a new object of type L. + +C 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. + +=head1 Author + +L was written by Ron Savage Iron@savage.net.auE> in 2010. + +Home page: L. + +=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 - A persistent session manager + +=head1 Synopsis + +See L for details. + +=head1 Description + +L is the parent of all L modules. + +=head1 Case-sensitive Options + +See L for important information. + +=head1 Support + +Log a bug on RT: L. + +=head1 Author + +L was written by Ron Savage Iron@savage.net.auE> in 2010. + +Home page: L. + +=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 - A persistent session manager + +=head1 Synopsis + +See L for details. + +=head1 Description + +L allows L to manipulate sessions with +L. + +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 for important information. + +=head1 Method: new() + +Creates a new object of type L. + +C 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. + +=head1 Method: thaw($data) + +Returns $data thawed by L. + +=head1 Support + +Log a bug on RT: L. + +=head1 Author + +L was written by Ron Savage Iron@savage.net.auE> in 2010. + +Home page: L. + +=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 - A persistent session manager + +=head1 Synopsis + +See L for details. + +=head1 Description + +L allows L to manipulate sessions with +L. + +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 for important information. + +=head1 Method: new() + +Creates a new object of type L. + +C 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. + +=head1 Method: thaw($data) + +Returns $data thawed by L. + +=head1 Support + +Log a bug on RT: L. + +=head1 Author + +L was written by Ron Savage Iron@savage.net.auE> in 2010. + +Home page: L. + +=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 - A persistent session manager + +=head1 Synopsis + +See L for details. + +=head1 Description + +L allows L to manipulate sessions with L. + +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 for important information. + +=head1 Method: new() + +Creates a new object of type L. + +C 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. + +=head1 Method: thaw($data) + +Returns $data thawed by L. + +=head1 Support + +Log a bug on RT: L. + +=head1 Author + +L was written by Ron Savage Iron@savage.net.auE> in 2010. + +Home page: L. + +=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 - A persistent session manager + +=head1 Synopsis + +See L for details. + +Warning: Storable should be avoided until this problem is fixed: +L + +=head1 Description + +L allows L to manipulate sessions with +L. + +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 for important information. + +=head1 Method: new() + +Creates a new object of type L. + +C 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. + +=head1 Method: thaw($data) + +Returns $data thawed by L. + +=head1 Support + +Log a bug on RT: L. + +=head1 Author + +L was written by Ron Savage Iron@savage.net.auE> in 2010. + +Home page: L. + +=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 - A persistent session manager + +=head1 Synopsis + +See L for details. + +=head1 Description + +L allows L to manipulate sessions with L. + +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 for important information. + +=head1 Method: new() + +Creates a new object of type L. + +C 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. + +=head1 Method: thaw($data) + +Returns $data thawed by L. + +=head1 Support + +Log a bug on RT: L. + +=head1 Author + +L was written by Ron Savage Iron@savage.net.auE> in 2010. + +Home page: L. + +=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