Tadashi Okoshi
slash****@users*****
2005年 12月 20日 (火) 01:42:00 JST
Index: affelio/extlib/CGI/Session.pm diff -u affelio/extlib/CGI/Session.pm:1.2 affelio/extlib/CGI/Session.pm:1.3 --- affelio/extlib/CGI/Session.pm:1.2 Sun Dec 18 14:16:45 2005 +++ affelio/extlib/CGI/Session.pm Tue Dec 20 01:42:00 2005 @@ -1,409 +1,452 @@ package CGI::Session; -# $Id: Session.pm,v 1.2 2005/12/18 05:16:45 slash5234 Exp $ +# $Id: Session.pm,v 1.3 2005/12/19 16:42:00 slash5234 Exp $ + use strict; +#use diagnostics; use Carp; -use CGI::Session::ErrorHandler; +use AutoLoader 'AUTOLOAD'; + +use vars qw($VERSION $REVISION $errstr $IP_MATCH $NAME $API_3 $FROZEN); - ＠ CGI::Session::ISA = qw( CGI::Session::ErrorHandler ); -$CGI::Session::VERSION = '4.03'; -$CGI::Session::NAME = 'CGISESSID'; -$CGI::Session::IP_MATCH = 0; - -sub STATUS_NEW () { 1 } # denotes session that's just created -sub STATUS_MODIFIED () { 2 } # denotes session that needs synchronization -sub STATUS_DELETED () { 4 } # denotes session that needs deletion -sub STATUS_EXPIRED () { 8 } # denotes session that was expired. +($REVISION) = '$Revision: 1.3 $' =~ m/Revision:\s*(\S+)/; +$VERSION = '3.95'; +$NAME = 'CGISESSID'; +# import() - we do not import anything into the callers namespace, however, +# we enable the user to specify hooks at compile time sub import { my $class = shift; @_ or return; - - for(@_) { - $CGI::Session::IP_MATCH = ( $_ eq '-ip_match' ); + for ( my $i=0; $i < @_; $i++ ) { + $IP_MATCH = ( $_[$i] eq '-ip_match' ) and next; + $API_3 = ( $_[$i] eq '-api3' ) and next; + $FROZEN = ( $_[$i] eq '-frozen' ) and next; } } + +# Session _STATUS flags +sub SYNCED () { 0 } +sub MODIFIED () { 1 } +sub DELETED () { 2 } + + +# new() - constructor. +# Returns respective driver object sub new { - my $class = shift; + my $class = shift; + $class = ref($class) || $class; - # If called as object method as in $session->new()... - my $self; - if ( ref $class ) { - $self = bless { %$class }, ref($class); - $class = ref($class); - $self->_reset_status(); - - # Object may still have public data associated with it, but we don't care about that, - # since we want to leave that to the client's disposal. However, if new() was requested on - # an expired session, we already know that '_DATA' table is empty, since it was the - # job of flush() to empty '_DATA' after deleting. How do we know flush() was already - # called on an expired session? Because load() - constructor always calls flush() - # on all to-be expired sessions - } else { - defined($self = $class->load( @_ )) - or return $class->set_error( "new(): failed: " . $class->errstr ); - } + my $self = { + _OPTIONS => [ @_ ], + _DATA => undef, + _STATUS => MODIFIED, + _API3 => { }, + _IS_NEW => 0, # to Chris Dolan's request + }; - # Absence of '_SESSION_ID' can only signal: - # * expired session - # Because load() - constructor is required to empty contents of _DATA - table - # * unavailable session - # Such sessions are the ones that don't exist on datastore, but requested by client - # * new sessions - # When no specific session is requested to be loaded - unless ( $self->{_DATA}->{_SESSION_ID} ) { - $self->{_DATA}->{_SESSION_ID} = $self->_id_generator()->generate_id($self->{_DRIVER_ARGS}, $self->{_CLAIMED_ID}); - unless ( defined $self->{_DATA}->{_SESSION_ID} ) { - return $self->set_error( "Couldn't generate new SID" ); - } - $self->{_DATA}->{_SESSION_CTIME} = $self->{_DATA}->{_SESSION_ATIME} = time(); - $self->_set_status(STATUS_NEW); + if ( $API_3 || (@_ == 3 ) ) { + return $class->api_3(@_); } + + bless ($self, $class); + $self->_validate_driver() && $self->_init() or return; return $self; } -sub DESTROY { $_[0]->flush() } -sub close { $_[0]->flush() } -*param_hashref = \&dataref; -my $avoid_single_use_warning = *param_hashref; -sub dataref { $_[0]->{_DATA} } -sub is_empty { !defined($_[0]->id) } -sub is_expired { $_[0]->_test_status( STATUS_EXPIRED ) } -sub is_new { $_[0]->_test_status( STATUS_NEW ) } -sub id { return defined($_[0]->dataref) ? $_[0]->dataref->{_SESSION_ID} : undef } -sub atime { return defined($_[0]->dataref) ? $_[0]->dataref->{_SESSION_ATIME} : undef } -sub ctime { return defined($_[0]->dataref) ? $_[0]->dataref->{_SESSION_CTIME} : undef } -sub _driver { - my $self = shift; - defined($self->{_OBJECTS}->{driver}) and return $self->{_OBJECTS}->{driver}; - my $pm = "CGI::Session::Driver::" . $self->{_DSN}->{driver}; - return $self->{_OBJECTS}->{driver} = $pm->new( $self->{_DRIVER_ARGS} ); -} -sub _serializer { - my $self = shift; - defined($self->{_OBJECTS}->{serializer}) and return $self->{_OBJECTS}->{serializer}; - return $self->{_OBJECTS}->{serializer} = "CGI::Session::Serialize::" . $self->{_DSN}->{serializer}; -} +sub api_3 { + my $class = shift; + $class = ref($class) || $class; + my $self = { + _OPTIONS => [ $_[1], $_[2] ], + _DATA => undef, + _STATUS => MODIFIED, + _API_3 => { + DRIVER => 'File', + SERIALIZER => 'Default', + ID => 'MD5', + }, + _IS_NEW => 0, # to Chris Dolan's request + }; -sub _id_generator { - my $self = shift; - defined($self->{_OBJECTS}->{id}) and return $self->{_OBJECTS}->{id}; - return $self->{_OBJECTS}->{id} = "CGI::Session::ID::" . $self->{_DSN}->{id}; -} + # supporting DSN namme abbreviations: + require Text::Abbrev; + my $dsn_abbrev = Text::Abbrev::abbrev('driver', 'serializer', 'id'); -sub _ip_matches { - return ( $_[0]->{_DATA}->{_SESSION_REMOTE_ADDR} eq $ENV{REMOTE_ADDR} ); -} + if ( defined $_[0] ) { + my @arg_pairs = split (/;/, $_[0]); + for my $arg ( @arg_pairs ) { + my ($key, $value) = split (/:/, $arg) or next; + $key = $dsn_abbrev->{$key}; + $self->{_API_3}->{ uc($key) } = $value || $self->{_API_3}->{uc($key)}; + } + } + my $driver = "CGI::Session::$self->{_API_3}->{DRIVER}"; + eval "require $driver" or die $@; -# parses the DSN string and returns it as a hash. -# Notably: Allows unique abbreviations of the keys: driver, serializer and 'id'. -# Also, keys and values of the returned hash are lower-cased. -sub parse_dsn { - my $self = shift; - my $dsn_str = shift; - croak "parse_dsn(): usage error" unless $dsn_str; + my $serializer = "CGI::Session::Serialize::$self->{_API_3}->{SERIALIZER}"; + eval "require $serializer" or die $@; - require Text::Abbrev; - my $abbrev = Text::Abbrev::abbrev( "driver", "serializer", "id" ); - my %dsn_map = map { split /:/ } (split /;/, $dsn_str); - my %dsn = map { $abbrev->{lc $_}, lc $dsn_map{$_} } keys %dsn_map; - return \%dsn; -} + my $id = "CGI::Session::ID::$self->{_API_3}->{ID}"; + eval "require $id" or die $@; -sub query { - my $self = shift; - if ( $self->{_QUERY} ) { - return $self->{_QUERY}; + # Now re-defining ISA according to what we have above + { + no strict 'refs'; + @{$driver . "::ISA"} = ( $class, $serializer, $id ); } - require CGI; - $self->{_QUERY} = CGI->new(); - return $self->{_QUERY}; -} - -sub name { - unless ( defined $_[1] ) { - return $CGI::Session::NAME; - } - $CGI::Session::NAME = $_[1]; + bless ($self, $driver); + $self->_validate_driver() && $self->_init() or return; + return $self; } -sub dump { + +# DESTROY() - destructor. +# Flushes the memory, and calls driver's teardown() +sub DESTROY { my $self = shift; - require Data::Dumper; - my $d = Data::Dumper->new([$self], [ref $self]); - $d->Deepcopy(1); - return $d->Dump(); + $self->flush() or croak "could not flush: " . $self->error(); + $self->can('teardown') && $self->teardown(); } -sub _set_status { - my $self = shift; - croak "_set_status(): usage error" unless @_; - $self->{_STATUS} |= $_ for @_; -} +# options() - used by drivers only. Returns the driver +# specific options. To be used in the future releases of the +# library, may be +sub driver_options { + my $self = shift; + return $self->{_OPTIONS}->[1]; +} -sub _unset_status { +# _validate_driver() - checks driver's validity. +# Return value doesn't matter. If the driver doesn't seem +# to be valid, it croaks +sub _validate_driver { my $self = shift; - croak "_unset_status(): usage error" unless @_; - $self->{_STATUS} &= ~$_ for @_; -} + my @required = qw(store retrieve remove generate_id); -sub _reset_status { - $_[0]->{_STATUS} = 0; + for my $method ( @required ) { + unless ( $self->can($method) ) { + my $class = ref($self); + confess "$class doesn't seem to be a valid CGI::Session driver. " . + "At least one method ('$method') is missing"; + } + } + return 1; } -sub _test_status { - return $_[0]->{_STATUS} & $_[1]; -} -sub flush { + +# _init() - object initialializer. +# Decides between _init_old_session() and _init_new_session() +sub _init { my $self = shift; - return unless $self->id; # <-- empty session - return if $self->{_STATUS} == 0; # <-- neither new, nor deleted nor modified + my $claimed_id = undef; + my $arg = $self->{_OPTIONS}->[0]; + if ( defined ($arg) && ref($arg) ) { + if ( $arg->isa('CGI') ) { + $claimed_id = $arg->cookie($NAME) || $arg->param($NAME) || undef; + $self->{_SESSION_OBJ} = $arg; + } elsif ( ref($arg) eq 'CODE' ) { + $claimed_id = $arg->() || undef; - if ( $self->_test_status(STATUS_NEW) && $self->_test_status(STATUS_DELETED) ) { - $self->{_DATA} = {}; - return $self->_unset_status(STATUS_NEW, STATUS_DELETED); + } + } else { + $claimed_id = $arg; } - my $driver = $self->_driver(); - my $serializer = $self->_serializer(); - - if ( $self->_test_status(STATUS_DELETED) ) { - defined($driver->remove($self->id)) or - return $self->set_error( "flush(): couldn't remove session data: " . $driver->errstr ); - $self->{_DATA} = {}; # <-- removing all the data, making sure - # it won't be accessible after flush() - return $self->_unset_status(STATUS_DELETED); - } + if ( defined $claimed_id ) { + my $rv = $self->_init_old_session($claimed_id); - if ( $self->_test_status(STATUS_NEW) || $self->_test_status(STATUS_MODIFIED) ) { - my $datastr = $serializer->freeze( $self->dataref ); - unless ( defined $datastr ) { - return $self->set_error( "flush(): couldn't freeze data: " . $serializer->errstr ); + unless ( $rv ) { + return $self->_init_new_session(); } - defined( $driver->store($self->id, $datastr) ) or - return $self->set_error( "flush(): couldn't store datastr: " . $driver->errstr); - $self->_unset_status(STATUS_NEW, STATUS_MODIFIED); + return 1; } - return 1; + return $self->_init_new_session(); } -sub trace {} -sub tracemsg {} -sub param { - my $self = shift; - carp "param(): attempt to read/write deleted session" if $self->_test_status(STATUS_DELETED); - # - # USAGE: $s->param(); - # DESC: returns all the **public** parameters - unless ( @_ ) { - return grep { !/^_SESSION_/ } keys %{ $self->{_DATA} }; - } +# _init_old_session() - tries to retieve the old session. +# If suceeds, checks if the session is expirable. If so, deletes it +# and returns undef so that _init() creates a new session. +# Otherwise, checks if there're any parameters to be expired, and +# calls clear() if any. Aftewards, updates atime of the session, and +# returns true +sub _init_old_session { + my ($self, $claimed_id) = @_; - # - # USAGE: $s->param($p); - # DESC: returns a specific session parameter - return $self->{_DATA}->{$_[0]} if @_ == 1; + my $options = $self->{_OPTIONS} || []; + my $data = $self->retrieve($claimed_id, $options); - my %args = ( - -name => undef, - -value => undef, - @_ - ); + # Session was initialized successfully + if ( defined $data ) { - # - # USAGE: $s->param(-name=>$n, -value=>$v); - # DESC: updates session data using CGI.pm's 'named parameter' syntax. Only - # public records can be set! - if ( defined( $args{'-name'} ) && defined( $args{'-value'} ) ) { - if ( $args{'-name'} =~ m/^_SESSION_/ ) { - carp "param(): attempt to write to private parameter"; - return undef; - } - $self->_set_status(STATUS_MODIFIED); - return $self->{_DATA}->{ $args{'-name'} } = $args{'-value'}; - } + $self->{_DATA} = $data; - # - # USAGE: $s->param(-name=>$n); - # DESC: access to session data (public & private) using CGI.pm's 'named parameter' syntax. - return $self->{_DATA}->{ $args{'-name'} } if defined $args{'-name'}; - - # USAGE: $s->param($name, $value); - # USAGE: $s->param($name1 => $value1, $name2 => $value2 [,...]); - # DESC: updates one or more **public** records using simple syntax - unless ( @_ % 2 ) { - for ( my $i=0; $i < @_; $i += 2 ) { - if ( $_[$i] =~ m/^_SESSION_/) { - carp "param(): attempt to write to private parameter"; - next; + # Check if the IP of the initial session owner should + # match with the current user's IP + if ( $IP_MATCH ) { + unless ( $self->_ip_matches() ) { + $self->delete(); + $self->flush(); + return undef; } - $self->{_DATA}->{ $_[$i] } = $_[$i+1]; } - $self->_set_status(STATUS_MODIFIED); + + # Check if the session's expiration ticker is up + if ( $self->_is_expired() ) { + $self->delete(); + $self->flush(); + return undef; + } + + # Expring single parameters, if any + $self->_expire_params(); + + # Updating last access time for the session + $self->{_DATA}->{_SESSION_ATIME} = time(); + + # Marking the session as modified + $self->{_STATUS} = MODIFIED; + return 1; } + return undef; +} + + - # - # If we reached this far none of the expected syntax were detected. Syntax error - croak "param(): usage error. Invalid number"; + + +sub _ip_matches { + return ( $_[0]->{_DATA}->{_SESSION_REMOTE_ADDR} eq $ENV{REMOTE_ADDR} ); } -sub delete { $_[0]->_set_status( STATUS_DELETED ) } -*header = \&http_header; -my $avoid_single_use_warning_again = *header; -sub http_header { +# _is_expired() - returns true if the session is to be expired. +# Called from _init_old_session() method. +sub _is_expired { my $self = shift; - return $self->query->header(-cookie=>$self->cookie, type=>'text/html', @_); + + unless ( $self->expire() ) { + return undef; + } + + return ( time() >= ($self->expire() + $self->atime() ) ); } -sub cookie { - my $self = shift; - my $query = $self->query(); - my $cookie= undef; - if ( $self->is_expired ) { - $cookie = $query->cookie( -name=>$self->name, -value=>$self->id, -expires=> '-1d', @_ ); - } elsif ( my $t = $self->expire ) { - $cookie = $query->cookie( -name=>$self->name, -value=>$self->id, -expires=> $t . 's', @_ ); - } else { - $cookie = $query->cookie( -name=>$self->name, -value=>$self->id, @_ ); + + +# _expire_params() - expires individual params. Called from within +# _init_old_session() method on a sucessfully retrieved session +sub _expire_params { + my $self = shift; + + # Expiring + my $exp_list = $self->{_DATA}->{_SESSION_EXPIRE_LIST} || {}; + my @trash_can = (); + while ( my ($param, $etime) = each %{$exp_list} ) { + if ( time() >= ($self->atime() + $etime) ) { + push @trash_can, $param; + } } - return $cookie; + if ( @trash_can ) { + $self->clear(\@trash_can); + } } -sub save_param { +# _init_new_session() - initializes a new session +sub _init_new_session { my $self = shift; - my ($query, $params) = @_; - $query ||= $self->query(); - $params ||= [ $query->param ]; + my $currtime = time(); + $self->{_DATA} = { + _SESSION_ID => $self->generate_id($self->{_OPTIONS}), + _SESSION_CTIME => $currtime, + _SESSION_ATIME => $currtime, + _SESSION_ETIME => undef, + _SESSION_REMOTE_ADDR => $ENV{REMOTE_ADDR} || undef, + _SESSION_EXPIRE_LIST => { }, + }; - for my $p ( @$params ) { - my @values = $query->param($p) or next; - if ( @values > 1 ) { - $self->param($p, \@values); - } else { - $self->param($p, $values[0]); - } - } - $self->_set_status( STATUS_MODIFIED ); + # to Chris Dolan's request: + # I'm not sure if this information should be serialized (placed under _DATA), + # but I don't see any desperate need for it. So let it be part of the object + $self->{_IS_NEW} = 1; + + $self->{_STATUS} = MODIFIED; + + return 1; } -sub load_param { + +# id() - accessor method. Returns effective id +# for the current session. CGI::Session deals with +# two kinds of ids; effective and claimed. Claimed id +# is the one passed to the constructor - new() as the first +# argument. It doesn't mean that id() method returns that +# particular id, since that ID might be either expired, +# or even invalid, or just data associated with that id +# might not be available for some reason. In this case, +# claimed id and effective id are not the same. +sub id { my $self = shift; - my ($query, $params) = @_; - $query ||= $self->query(); - $params ||= [ $self->param ]; + return $self->{_DATA}->{_SESSION_ID}; +} + - for ( @$params ) { - $query->param(-name=>$_, -value=>$self->param($_)); + +# param() - accessor method. Reads and writes +# session parameters ( $self->{_DATA} ). Decides +# between _get_param() and _set_param() accordingly. +sub param { + my $self = shift; + + + unless ( defined $_[0] ) { + return keys %{ $self->{_DATA} }; } -} + if ( @_ == 1 ) { + return $self->_get_param(@_); + } + + # If it has more than one arguments, let's try to figure out + # what the caller is trying to do, since our tricks are endless ;-) + my $arg = { + -name => undef, + -value => undef, + @_, + }; + + if ( defined($arg->{'-name'}) && defined($arg->{'-value'}) ) { + return $self->_set_param($arg->{'-name'}, $arg->{'-value'}); -sub clear { - my $self = shift; - my $params = shift; - #warn ref($params); - if (defined $params) { - $params = [ $params ] unless ref $params; } - else { - $params = [ $self->param ]; + + if ( defined $arg->{'-name'} ) { + return $self->_get_param( $arg->{'-name'} ); } - for ( @$params ) { - delete $self->{_DATA}->{$_}; + if ( @_ == 2 ) { + return $self->_set_param(@_); } - $self->_set_status( STATUS_MODIFIED ); + + unless ( @_ % 2 ) { + my $n = 0; + my %args = @_; + while ( my ($key, $value) = each %args ) { + $self->_set_param($key, $value) && ++$n; + } + return $n; + } + + confess "param(): something smells fishy here. RTFM!"; } -sub find { - my $class = shift; - my ($dsnstr, $coderef, $dsn_args); - if ( @_ == 1 ) { - $coderef = $_[0]; - } else { - ($dsnstr, $coderef, $dsn_args) = @_; - } +# _set_param() - sets session parameter to the '_DATA' table +sub _set_param { + my ($self, $key, $value) = @_; - unless ( $coderef && ref($coderef) && (ref $coderef eq 'CODE') ) { - croak "find(): usage error."; + if ( $self->{_STATUS} == DELETED ) { + return; } - my $driver; - if ( $dsnstr ) { - my $hashref = $class->parse_dsn( $dsnstr ); - $driver = $hashref->{driver}; - } - $driver ||= "file"; - my $pm = "CGI::Session::Driver::" . $driver; - eval "require $pm"; - if (my $errmsg = $@ ) { - return $class->set_error( "find(): couldn't load driver." . $errmsg ); + # session parameters starting with '_session_' are + # private to the class + if ( $key =~ m/^_SESSION_/ ) { + return undef; } - my $driver_obj = $pm->new( $dsn_args ); - unless ( $driver_obj ) { - return $class->set_error( "find(): couldn't create driver object. " . $pm->errstr ); + $self->{_DATA}->{$key} = $value; + $self->{_STATUS} = MODIFIED; + + return $value; +} + + + + +# _get_param() - gets a single parameter from the +# '_DATA' table +sub _get_param { + my ($self, $key) = @_; + + if ( $self->{_STATUS} == DELETED ) { + return; } - my $driver_coderef = sub { - my ($sid) = @_; - my $session = $class->load( $dsnstr, $sid, $dsn_args ); - unless ( $session ) { - return $class->set_error( "find(): couldn't load session '$sid'. " . $class->errstr ); - } - $coderef->( $session ); - }; + return $self->{_DATA}->{$key}; +} - defined($driver_obj->traverse( $driver_coderef )) - or return $class->set_error( "find(): traverse seems to have failed. " . $driver_obj->errstr ); - return 1; + +# flush() - flushes the memory into the disk if necessary. +# Usually called from within DESTROY() or close() +sub flush { + my $self = shift; + + my $status = $self->{_STATUS}; + + if ( $status == MODIFIED ) { + $self->store($self->id, $self->{_OPTIONS}, $self->{_DATA}) or return; + } elsif ( $status == DELETED ) { + $self->remove($self->id, $self->{_OPTIONS}) or return; + } + $self->{_STATUS} = SYNCED; + return 1; } -# $Id: Session.pm,v 1.2 2005/12/18 05:16:45 slash5234 Exp $ + + + + +# Autoload methods go after =cut, and are processed by the autosplit program. + +1; + +__END__; + + +# $Id: Session.pm,v 1.3 2005/12/19 16:42:00 slash5234 Exp $ =pod @@ -415,12 +458,11 @@ # Object initialization: use CGI::Session; - $session = new CGI::Session(); - $CGISESSID = $session->id(); + my $session = new CGI::Session("driver:File", undef, {Directory=>'/tmp'}); - # send proper HTTP header with cookies: - print $session->header(); + # getting the effective session id: + my $CGISESSID = $session->id(); # storing data in the session $session->param('f_name', 'Sherzod'); @@ -433,10 +475,10 @@ my $l_name = $session->param(-name=>'l_name'); # clearing a certain session parameter - $session->clear(["l_name", "f_name"]); + $session->clear(["_IS_LOGGED_IN"]); - # expire '_is_logged_in' flag after 10 idle minutes: - $session->expire('is_logged_in', '+10m') + # expire '_IS_LOGGED_IN' flag after 10 idle minutes: + $session->expire(_IS_LOGGED_IN => '+10m') # expire the session itself after 1 idle hour $session->expire('+1h'); @@ -446,14 +488,15 @@ =head1 DESCRIPTION -CGI-Session is a Perl5 library that provides an easy, reliable and modular session management system across HTTP requests. -Persistency is a key feature for such applications as shopping carts, login/authentication routines, and application that -need to carry data across HTTP requests. CGI::Session does that and many more. +CGI-Session is a Perl5 library that provides an easy, reliable and modular +session management system across HTTP requests. Persistency is a key feature for +such applications as shopping carts, login/authentication routines, and +application that need to carry data accross HTTP requests. CGI::Session +does that and many more =head1 TO LEARN MORE -Current manual is optimized to be used as a quick reference. To learn more both about the philosophy and CGI::Session -programming style, consider the following: +Current manual is optimized to be used as a quick reference. To learn more both about the logic behind session management and CGI::Session programming style, consider the following: =over 4 @@ -463,6 +506,10 @@ =item * +L<CGI::Session::CookBook|CGI::Session::CookBook> - practical solutions for real life problems + +=item * + We also provide mailing lists for CGI::Session users. To subscribe to the list or browse the archives visit https://lists.sourceforge.net/lists/listinfo/cgi-session-user =item * @@ -475,710 +522,742 @@ =item * -L<Apache::Session|Apache::Session> - another fine alternative to CGI::Session. +L<Apache::Session|Apache::Session> - another fine alternative to CGI::Session =back =head1 METHODS -Following is the overview of all the available methods accessible via CGI::Session object. +Following is the overview of all the available methods accessible via +CGI::Session object. =over 4 -=item new() +=item C<new( DSN, SID, HASHREF )> -=item new( $sid ) +Requires three arguments. First is the Data Source Name, second should be +the session id to be initialized or an object which provides either of 'param()' +or 'cookie()' mehods. If Data Source Name is undef, it will fall back +to default values, which are "driver:File;serializer:Default;id:MD5". -=item new( $query ) +If session id is missing, it will force the library to generate a new session +id, which will be accessible through C<id()> method. -=item new( $dsn, $query||$sid ) +Examples: -=item new( $dsn, $query||$sid, \%dsn_args ) + $session = new CGI::Session(undef, undef, {Directory=>'/tmp'}); + $session = new CGI::Session("driver:File;serializer:Storable", undef, {Directory=>'/tmp'}) + $session = new CGI::Session("driver:MySQL;id:Incr", undef, {Handle=>$dbh}); -Constructor. Returns new session object, or undef on failure. Error message is accessible through L<errstr() - class method|CGI::Session::ErrorHandler/errstr>. If called on an already initialized session will re-initialize the session based on already configured object. This is only useful after a call to L<load()|/"load">. +Following data source variables are supported: -Can accept up to three arguments, $dsn - Data Source Name, $query||$sid - query object OR a string representing session id, and finally, \%dsn_args, arguments used by $dsn components. +=over 4 -If called without any arguments, $dsn defaults to I<driver:file;serializer:default;id:md5>, $query||$sid defaults to C<< CGI->new() >>, and C<\%dsn_args> defaults to I<undef>. +=item * -If called with a single argument, it will be treated either as C<$query> object, or C<$sid>, depending on its type. If argument is a string , C<new()> will treat it as session id and will attempt to retrieve the session from data store. If it fails, will create a new session id, which will be accessible through L<id() method|/"id">. If argument is an object, L<cookie()|CGI/cookie> and L<param()|CGI/param> methods will be called on that object to recover a potential C<$sid> and retrieve it from data store. If it fails, C<new()> will create a new session id, which will be accessible through L<id() method|/"id">. C<$CGI::Session::NAME> will define the name of the query parameter and/or cookie name to be requested, defaults to I<CGISESSID>. +C<driver> - CGI::Session driver. Available drivers are "File", "DB_File" and +"MySQL". Default is "File". -If called with two arguments first will be treated as $dsn, and second will be treated as $query or $sid or undef, depending on its type. Some examples of this syntax are: +=item * - $s = CGI::Session->new("driver:mysql", undef); - $s = CGI::Session->new("driver:sqlite", $sid); - $s = CGI::Session->new("driver:db_file", $query); - $s = CGI::Session->new("serializer:storable;id:incr", $sid); - # etc... +C<serializer> - serializer to be used to encode the data structure before saving +in the disk. Available serializers are "Storable", "FreezeThaw" and "Default". +Default is "Default", which uses standard L<Data::Dumper|Data::Dumper> +=item * -Following data source components are supported: +C<id> - ID generator to use when new session is to be created. Available ID generators +are "MD5" and "Incr". Default is "MD5". -=over 4 +=back -=item * +Note: you can also use unambiguous abbreviations of the DSN parameters. Examples: -B<driver> - CGI::Session driver. Available drivers are L<file|CGI::Session::Driver::file>, L<db_file|CGI::Session::Driver::db_file>, L<mysql|CGI::Session::Driver::mysql> and L<sqlite|CGI::Session::Driver::sqlite>. Third party drivers are welcome. For driver specs consider L<CGI::Session::Driver|CGI::Session::Driver> + new CGI::Session("dr:File;ser:Storable", undef, {Diretory=>'/tmp'}); -=item * -B<serializer> - serializer to be used to encode the data structure before saving -in the disk. Available serializers are L<storable|CGI::Session::Serialize::storable>, L<freezethaw|CGI::Session::Serialize::freezethaw> and L<default|CGI::Session::Serialize::default>. Default serializer will use L<Data::Dumper|Data::Dumper>. +=item C<id()> -=item * +Returns effective ID for a session. Since effective ID and claimed ID +can differ, valid session id should always be retrieved using this +method. -B<id> - ID generator to use when new session is to be created. Available ID generator is L<md5|CGI::Session::ID::md5> +=item C<param($name)> -=back +=item C<param(-name=E<gt>$name)> -For example, to get CGI::Session store its data using DB_File and serialize data using FreezeThaw: +this method used in either of the above syntax returns a session +parameter set to C<$name> or undef on failure. - $s = new CGI::Session("driver:DB_File;serializer:FreezeThaw", undef); +=item C<param( $name, $value)> -If called with three arguments, first two will be treated as in the previous example, and third argument will be C<\%dsn_args>, which will be passed to C<$dsn> components (namely, driver, serializer and id generators) for initialization purposes. Since all the $dsn components must initialize to some default value, this third argument should not be required for most drivers to operate properly. +=item C<param(-name=E<gt>$name, -value=E<gt>$value)> -undef is acceptable as a valid placeholder to any of the above arguments, which will force default behavior. +method used in either of the above syntax assigns a new value to $name +parameter, which can later be retrieved with previously introduced +param() syntax. -=item load() +=item C<param_hashref()> -=item load($query||$sid) +returns all the session parameters as a reference to a hash -=item load($dsn, $query||$sid) -=item load($dsn, $query, \%dsn_args); +=item C<save_param($cgi)> -Constructor. Usage is identical to L<new()|/"new">, so is the return value. Major difference is, L<new()|/"new"> can create new session if it detects expired and non-existing sessions, but C<load()> does not. +=item C<save_param($cgi, $arrayref)> -C<load()> is useful to detect expired or non-existing sessions without forcing the library to create new sessions. So now you can do something like this: +Saves CGI parameters to session object. In otherwords, it's calling +C<param($name, $value)> for every single CGI parameter. The first +argument should be either CGI object or any object which can provide +param() method. If second argument is present and is a reference to an array, only those CGI parameters found in the array will +be stored in the session - $s = CGI::Session->load() or die CGI::Session->errstr(); - if ( $s->is_expired ) { - print $s->header(), - $cgi->start_html(), - $cgi->p("Your session timed out! Refresh the screen to start new session!") - $cgi->end_html(); - exit(0); - } +=item C<load_param($cgi)> - if ( $s->is_empty ) { - $s = $s->new() or die $s->errstr; - } +=item C<load_param($cgi, $arrayref)> -Notice, all I<expired> sessions are empty, but not all I<empty> sessions are expired! +loads session parameters to CGI object. The first argument is required +to be either CGI.pm object, or any other object which can provide +param() method. If second argument is present and is a reference to an +array, only the parameters found in that array will be loaded to CGI +object. -=cut +=item C<sync_param($cgi)> -sub load { - my $class = shift; +=item C<sync_param($cgi, $arrayref)> - return $class->set_error( "called as instance method") if ref $class; - return $class->set_error( "invalid number of arguments") if @_ > 3; +experimental feature. Synchronizes CGI and session objects. In other words, it's the same as calling respective syntaxes of save_param() and load_param(). - my $self = bless { - _DATA => { - _SESSION_ID => undef, - _SESSION_CTIME => undef, - _SESSION_ATIME => undef, - _SESSION_REMOTE_ADDR => $ENV{REMOTE_ADDR} || "", - # - # Following two attributes may not exist in every single session, and declaring - # them now will force these to get serialized into database, wasting space. But they - # are here to remind the coder of their purpose - # -# _SESSION_ETIME => undef, -# _SESSION_EXPIRE_LIST => {} - }, # session data - _DSN => {}, # parsed DSN params - _OBJECTS => {}, # keeps necessary objects - _DRIVER_ARGS=> {}, # arguments to be passed to driver - _CLAIMED_ID => undef, # id **claimed** by client - _STATUS => 0, # status of the session object - _QUERY => undef # query object - }, $class; +=item C<clear()> - #$self->{_DATA}->{_SESSION_CTIME} = $self->{_DATA}->{_SESSION_ATIME} = time(); +=item C<clear([@list])> - if ( @_ == 1 ) { - if ( ref $_[0] ){ $self->{_QUERY} = $_[0] } - else { $self->{_CLAIMED_ID} = $_[0] } - } +clears parameters from the session object. If passed an argument as an +arrayref, clears only those parameters found in the list. - # Two or more args passed: - if ( @_ > 1 ) { - if ( defined $_[0] ) { # <-- to avoid 'Uninitialized value...' warnings - $self->{_DSN} = $self->parse_dsn( $_[0] ); - } - # - # second argument can either be $sid, or $query - if ( ref $_[1] ){ $self->{_QUERY} = $_[1] } - else { $self->{_CLAIMED_ID} = $_[1] } - } - - # - # grabbing the 3rd argument, if any - if ( @_ == 3 ){ $self->{_DRIVER_ARGS} = $_[2] } - - # - # setting defaults, since above arguments might be 'undef' - $self->{_DSN}->{driver} ||= "file"; - $self->{_DSN}->{serializer} ||= "default"; - $self->{_DSN}->{id} ||= "md5"; - - # Beyond this point used to be '_init()' method. But I had to merge them together - # since '_init()' did not serve specific purpose - - - # - # Checking and loading driver, serializer and id-generators - # - my @pms = (); - $pms[0] = "CGI::Session::Driver::" . $self->{_DSN}->{driver}; - $pms[1] = "CGI::Session::Serialize::" . $self->{_DSN}->{serializer}; - $pms[2] = "CGI::Session::ID::" . $self->{_DSN}->{id}; - for ( @pms ) { - eval "require $_"; - if ( my $errmsg = $@ ) { - return $self->set_error("couldn't load $_: " . $errmsg); - } - } +=item C<flush()> - unless ( $self->{_CLAIMED_ID} ) { - my $query = $self->query(); - eval { - $self->{_CLAIMED_ID} = $query->cookie( $self->name ) || $query->param( $self->name ); - }; - if ( my $errmsg = $@ ) { - return $class->set_error( "query object $query does not support cookie() and param() methods: " . $errmsg ); - } - } +synchronizes data in the buffer with its copy in disk. Normally it will +be called for you just before the program terminates, session object +goes out of scope or close() is called. - # - # No session is being requested. Just return an empty session - return $self unless $self->{_CLAIMED_ID}; - - # - # Attempting to load the session - my $driver = $self->_driver(); - my $raw_data = $driver->retrieve( $self->{_CLAIMED_ID} ); - unless ( defined $raw_data ) { - return $self->set_error( "load(): couldn't retrieve data: " . $driver->errstr ); - } - # - # Requested session couldn't be retrieved - return $self unless $raw_data; - - my $serializer = $self->_serializer(); - $self->{_DATA} = $serializer->thaw($raw_data); - unless ( defined $self->{_DATA} ) { - #die $raw_data . "\n"; - return $self->set_error( "load(): couldn't thaw() data using $serializer:" . - $serializer->errstr ); - } - unless (defined($self->{_DATA}) && ref ($self->{_DATA}) && (ref $self->{_DATA} eq 'HASH') && - defined($self->{_DATA}->{_SESSION_ID}) ) { - return $self->set_error( "Invalid data structure returned from thaw()" ); - } - - # - # checking if previous session ip matches current ip - if($CGI::Session::IP_MATCH) { - unless($self->_ip_matches) { - $self->_set_status( STATUS_DELETED ); - $self->flush; - return $self; - } - } - - # - # checking for expiration ticker - if ( $self->{_DATA}->{_SESSION_ETIME} ) { - if ( ($self->{_DATA}->{_SESSION_ATIME} + $self->{_DATA}->{_SESSION_ETIME}) <= time() ) { - $self->_set_status( STATUS_EXPIRED ); # <-- so client can detect expired sessions - $self->_set_status( STATUS_DELETED ); # <-- session should be removed from database - $self->flush(); # <-- flush() will do the actual removal! - return $self; - } - } +=item C<close()> - # checking expiration tickers of individuals parameters, if any: - my @expired_params = (); - while (my ($param, $max_exp_interval) = each %{ $self->{_DATA}->{_SESSION_EXPIRE_LIST} } ) { - if ( ($self->{_DATA}->{_SESSION_ATIME} + $max_exp_interval) <= time() ) { - push @expired_params, $param; - } - } - $self->clear(\@expired_params) if @expired_params; - $self->{_DATA}->{_SESSION_ATIME} = time(); # <-- updating access time - $self->_set_status( STATUS_MODIFIED ); # <-- access time modified above - return $self; -} +closes the session temporarily until new() is called on the same session +next time. In other words, it's a call to flush() and DESTROY(), but +a lot slower. Normally you never have to call close(). -=pod +=item C<atime()> -=item id() +returns the last access time of the session in the form of seconds from +epoch. This time is used internally while auto-expiring sessions and/or session parameters. -Returns effective ID for a session. Since effective ID and claimed ID can differ, valid session id should always -be retrieved using this method. +=item C<ctime()> -=item param($name) +returns the time when the session was first created. -=item param(-name=E<gt>$name) +=item C<expire()> -Used in either of the above syntax returns a session parameter set to $name or undef if it doesn't exist. If it's called on a deleted method param() will issue a warning but return value is not defined. +=item C<expire($time)> -=item param($name, $value) +=item C<expire($param, $time)> -=item param(-name=E<gt>$name, -value=E<gt>$value) +Sets expiration date relative to atime(). If used with no arguments, returns the expiration date if it was ever set. If no expiration was ever set, returns undef. -Used in either of the above syntax assigns a new value to $name parameter, -which can later be retrieved with previously introduced param() syntax. C<$value> -may be a scalar, arrayref or hashref. +Second form sets an expiration time. This value is checked when previously stored session is asked to be retrieved, and if its expiration date has passed will be expunged from the disk immediately and new session is created accordingly. Passing 0 would cancel expiration date. -Attempts to set parameter names that start with I<_SESSION_> will trigger -a warning and undef will be returned. +By using the third syntax you can also set an expiration date for a +particular session parameter, say "~logged-in". This would cause the +library call clear() on the parameter when its time is up. -=item param_hashref() +All the time values should be given in the form of seconds. Following +time aliases are also supported for your convenience: -B<Deprecated>. Use L<dataref()|/"dataref"> instead. + +===========+===============+ + | alias | meaning | + +===========+===============+ + | s | Second | + | m | Minute | + | h | Hour | + | w | Week | + | M | Month | + | y | Year | + +-----------+---------------+ -=item dataref() +Examples: -Returns reference to session's data table: + $session->expires("+1y"); # expires in one year + $session->expires(0); # cancel expiration + $session->expires("~logged-in", "+10m");# expires ~logged-in flag in 10 mins - $params = $s->dataref(); - $sid = $params->{_SESSION_ID}; - $name= $params->{name}; - # etc... +Note: all the expiration times are relative to session's last access time, not to its creation time. To expire a session immediately, call C<delete()>. To expire a specific session parameter immediately, call C<clear()> on that parameter. -Useful for having all session data in a hashref, but too risky to update. +=item C<remote_addr()> -=item save_param() +returns the remote address of the user who created the session for the +first time. Returns undef if variable REMOTE_ADDR wasn't present in the +environment when the session was created -=item save_param($query) +=item C<delete()> -=item save_param($query, \@list) +deletes the session from the disk. In other words, it calls for +immediate expiration after which the session will not be accessible -Saves query parameters to session object. In other words, it's the same as calling L<param($name, $value)|/"param"> for every single query parameter returned by C<< $query->param() >>. The first argument, if present, should be either CGI object or any object which can provide param() method. If it's undef, defaults to the return value of L<query()|/"query">, which returns C<< CGI->new >>. If second argument is present and is a reference to an array, only those query parameters found in the array will be stored in the session. undef is a valid placeholder for any argument to force default behavior. +=item C<error()> -=item load_param() +returns the last error message from the library. It's the same as the +value of $CGI::Session::errstr. Example: -=item load_param($query) + $session->flush() or die $session->error(); -=item load_param($query, \@list) +=item C<dump()> -Loads session parameters into a query object. The first argument, if present, should be query object, or any other object which can provide param() method. If second argument is present and is a reference to an array, only parameters found in that array will be loaded to the query object. +=item C<dump("logs/dump.txt")> -=item clear() +creates a dump of the session object. Argument, if passed, will be +interpreted as the name of the file object should be dumped in. Used +mostly for debugging. -=item clear('field') +=item C<header()> -=item clear(\@list) +header() is simply a replacement for L<CGI.pm|CGI>'s header() method. Without this method, you usually need to create a CGI::Cookie object and send it as part of the HTTP header: -Clears parameters from the session object. + $cookie = new CGI::Cookie(-name=>'CGISESSID', -value=>$session->id); + print $cgi->header(-cookie=>$cookie); -With no parameters, all fields are cleared. If passed a single parameter or a -reference to an array, only the named parameters are cleared. +You can minimize the above into: -=item flush() + $session->header() -Synchronizes data in the buffer with its copy in disk. Normally it will be called for you just before the program terminates, or session object goes out of scope, so you should never have to flush() on your own. +It will retrieve the name of the session cookie from $CGI::Session::NAME variable, which can also be accessed via CGI::Session->name() method. If you want to use a different name for your session cookie, do something like following before creating session object: -=item atime() + CGI::Session->name("MY_SID"); + $session = new CGI::Session(undef, $cgi, \%attrs); -Read-only method. Returns the last access time of the session in seconds from epoch. This time is used internally while -auto-expiring sessions and/or session parameters. +Now, $session->header() uses "MY_SID" as a name for the session cookie. -=item ctime() +=back -Read-only method. Returns the time when the session was first created in seconds from epoch. +=head1 DATA TABLE -=item expire() +Session data is stored in the form of hash table, in key value pairs. +All the parameter names you assign through param() method become keys +in the table, and whatever value you assign become a value associated with +that key. Every key/value pair is also called a record. -=item expire($time) +All the data you save through param() method are called public records. +There are several read-only private records as well. Normally, you don't have to know anything about them to make the best use of the library. But knowing wouldn't hurt either. Here are the list of the private records and some description of what they hold: -=item expire($param, $time) +=over 4 -Sets expiration interval relative to L<atime()|/"atime">. +=item _SESSION_ID -If used with no arguments, returns the expiration interval if it was ever set. If no expiration was ever set, returns undef. For backwards compatibility, a method named C<etime()> does the same thing. +Session id of that data. Accessible through id() method. -Second form sets an expiration time. This value is checked when previously stored session is asked to be retrieved, and if its expiration interval has passed, it will be expunged from the disk immediately. Passing 0 cancels expiration. +=item _SESSION_CTIME -By using the third syntax you can set the expiration interval for a particular session parameter, say I<~logged-in>. This would cause the library call clear() on the parameter when its time is up. Passing 0 cancels expiration. +Session creation time. Accessible through ctime() method. -All the time values should be given in the form of seconds. Following keywords are also supported for your convenience: +=item _SESSION_ATIME - +-----------+---------------+ - | alias | meaning | - +-----------+---------------+ - | s | Second | - | m | Minute | - | h | Hour | - | d | Day | - | w | Week | - | M | Month | - | y | Year | - +-----------+---------------+ +Session last access time. Accessible through atime() method. -Examples: +=item _SESSION_ETIME - $session->expire("2h"); # expires in two hours - $session->expire(0); # cancel expiration - $session->expire("~logged-in", "10m"); # expires '~logged-in' parameter after 10 idle minutes +Session's expiration time, if any. Accessible through expire() method. -Note: all the expiration times are relative to session's last access time, not to its creation time. To expire a session immediately, call L<delete()|/"delete">. To expire a specific session parameter immediately, call L<clear([$name])|/"clear">. +=item _SESSION_REMOTE_ADDR -=cut +IP address of the user who create that session. Accessible through remote_addr() +method -*expires = \&expire; -my $prevent_warning = \&expires; -sub etime { $_[0]->expire() } -sub expire { - my $self = shift; +=item _SESSION_EXPIRE_LIST - # no params, just return the expiration time. - if (not @_) { - return $self->{_DATA}->{_SESSION_ETIME}; - } - # We have just a time - elsif ( @_ == 1 ) { - my $time = $_[0]; - # If 0 is passed, cancel expiration - if ( defined $time && ($time =~ m/^\d$/) && ($time == 0) ) { - $self->{_DATA}->{_SESSION_ETIME} = undef; - $self->_set_status( STATUS_MODIFIED ); - } - # set the expiration to this time - else { - $self->{_DATA}->{_SESSION_ETIME} = $self->_str2seconds( $time ); - $self->_set_status( STATUS_MODIFIED ); - } - } - # If we get this far, we expect expire($param,$time) - # ( This would be a great use of a Perl6 multi sub! ) - else { - my ($param, $time) = @_; - if ( ($time =~ m/^\d$/) && ($time == 0) ) { - delete $self->{_DATA}->{_SESSION_EXPIRE_LIST}->{ $param }; - $self->_set_status( STATUS_MODIFIED ); - } else { - $self->{_DATA}->{_SESSION_EXPIRE_LIST}->{ $param } = $self->_str2seconds( $time ); - $self->_set_status( STATUS_MODIFIED ); - } - } - return 1; -} +Another internal hash table that holds the expiration information for each +expirable public record, if any. This table is updated with the two-argument-syntax of expires() method. -# =head2 _str2seconds() -# -# my $secs = $self->_str2seconds('1d') -# -# Takes a CGI.pm-style time representation and returns an equivalent number -# of seconds. -# -# See the docs of expire() for more detail. -# -# =cut +=back -sub _str2seconds { - my $self = shift; - my ($str) = @_; +These private methods are essential for the proper operation of the library +while working with session data. For this purpose, CGI::Session doesn't allow +overriding any of these methods through the use of param() method. In addition, +it doesn't allow any parameter names that start with string B<_SESSION_> either +to prevent future collisions. - return unless defined $str; - return $str if $str =~ m/^[-+]?\d+$/; +So the following attempt will have no effect on the session data whatsoever - my %_map = ( - s => 1, - m => 60, - h => 3600, - d => 86400, - w => 604800, - M => 2592000, - y => 31536000 - ); + $session->param(_SESSION_XYZ => 'xyz'); - my ($koef, $d) = $str =~ m/^([+-]?\d+)([smhdwMy])$/; - unless ( defined($koef) && defined($d) ) { - die "_str2seconds(): couldn't parse '$str' into \$koef and \$d parts. Possible invalid syntax"; - } - return $koef * $_map{ $d }; -} +Although private methods are not writable, the library allows reading them +using param() method: + my $sid = $session->param(_SESSION_ID); -=pod +The above is the same as: -=item is_new() + my $sid = $session->id(); -Returns true only for a brand new session. +But we discourage people from accessing private records using param() method. +In the future we are planning to store private records in their own namespace +to avoid name collisions and remove restrictions on session parameter names. -=item is_expired() +=head1 DISTRIBUTION -Tests whether session initialized using L<load()|/"load"> is to be expired. This method works only on sessions initialized with load(): +CGI::Session consists of several modular components such as L<drivers|"DRIVERS">, L<serializers|"SERIALIZERS"> and L<id generators|"ID Generators">. This section lists what is available. - $s = CGI::Session->load() or die CGI::Session->errstr; - if ( $s->is_expired ) { - die "Your session expired. Please refresh"; - } - if ( $s->is_empty ) { - $s = $s->new() or die $s->errstr; - } +=head2 DRIVERS +Following drivers are included in the standard distribution: -=item is_empty() +=over 4 -Returns true for sessions that are empty. It's preferred way of testing whether requested session was loaded successfully or not: +=item * - $s = CGI::Session->load($sid); - if ( $s->is_empty ) { - $s = $s->new(); - } +L<File|CGI::Session::File> - default driver for storing session data in plain files. Full name: B<CGI::Session::File> -Actually, the above code is nothing but waste. The same effect could've been achieved by saying: +=item * - $s = CGI::Session->new( $sid ); +L<DB_File|CGI::Session::DB_File> - for storing session data in BerkelyDB. Requires: L<DB_File>. Full name: B<CGI::Session::DB_File> -L<is_empty()|/"is_empty"> is useful only if you wanted to catch requests for expired sessions, and create new session afterwards. See L<is_expired()|/"is_expired"> for an example. +=item * -=item delete() +L<MySQL|CGI::Session::MySQL> - for storing session data in MySQL tables. Requires L<DBI|DBI> and L<DBD::mysql|DBD::mysql>. Full name: B<CGI::Session::MySQL> -Deletes a session from the data store and empties session data from memory, completely, so subsequent read/write requests on the same object will fail. Technically speaking, it will only set object's status to I<STATUS_DELETED> and will trigger L<flush()|/"flush">, and flush() will do the actual removal. +=back -=item find( \&code ) +=head2 SERIALIZERS -=item find( $dsn, \&code ) +=over 4 -=item find( $dsn, \&code, \%dsn_args ) +=item * -Experimental feature. Executes \&code for every session object stored in disk, passing initialized CGI::Session object as the first argument of \&code. Useful for housekeeping purposes, such as for removing expired sessions. Following line, for instance, will remove sessions already expired, but are still in disk: +L<Default|CGI::Session::Serialize::Default> - default data serializer. Uses standard L<Data::Dumper|Data::Dumper>. Full name: B<CGI::Session::Serialize::Default>. - CGI::Session->find( sub {} ); +=item * -Notice, above \&code didn't have to do anything, because load(), which is called to initialize sessions inside find(), will automatically remove expired sessions. Following example will remove all the objects that are 10+ days old: +L<Storable|CGI::Session::Serialize::Storable> - serializes data using L<Storable>. Requires L<Storable>. Full name: B<CGI::Session::Serialize::Storable>. - CGI::Session->find( \&purge ); - sub purge { - my ($session) = @_; - next if $session->empty; # <-- already expired?! - if ( ($session->ctime + 3600*240) <= time() ) { - $session->delete() or warn "couldn't remove " . $session->id . ": " . $session->errstr; - } - } +=item * -B<Note:> find() is meant to be convenient, not necessarily efficient. It's best suited in cron scripts. +L<FreezeThaw|CGI::Session::Serialize::FreezeThaw> - serializes data using L<FreezeThaw>. Requires L<FreezeThaw>. Full name: B<CGI::Session::Serialize::FreezeThaw> =back -=head1 MISCELLANEOUS METHODS +=head2 ID GENERATORS + +Following ID generators are available: =over 4 -=item remote_addr() +=item * -Returns the remote address of the user who created the session for the first time. Returns undef if variable REMOTE_ADDR wasn't present in the environment when the session was created. +L<MD5|CGI::Session::ID::MD5> - generates 32 character long hexidecimal string. +Requires L<Digest::MD5|Digest::MD5>. Full name: B<CGI::Session::ID::MD5>. -=cut +=item * -sub remote_addr { return $_[0]->{_DATA}->{_SESSION_REMOTE_ADDR} } +L<Incr|CGI::Session::ID::Incr> - generates auto-incrementing ids. Full name: B<CGI::Session::ID::Incr> -=pod +=back -=item errstr() -Class method. Returns last error message from the library. +=head1 COPYRIGHT -=item dump() +Copyright (C) 2001-2002 Sherzod Ruzmetov <sherz****@cpan*****>. All rights reserved. -Returns a dump of the session object. Useful for debugging purposes only. +This library is free software. You can modify and or distribute it under the same terms as Perl itself. -=item header() +=head1 AUTHOR -Replacement for L<CGI.pm|CGI>'s header() method. Without this method, you usually need to create a CGI::Cookie object and send it as part of the HTTP header: +Sherzod Ruzmetov <sherz****@cpan*****>. Feedbacks, suggestions are welcome. - $cookie = CGI::Cookie->new(-name=>$session->name, -value=>$session->id); - print $cgi->header(-cookie=>$cookie); +=head1 SEE ALSO -You can minimize the above into: +=over 4 - print $session->header(); +=item * -It will retrieve the name of the session cookie from $CGI::Session::NAME variable, which can also be accessed via CGI::Session->name() method. If you want to use a different name for your session cookie, do something like following before creating session object: +L<CGI::Session::Tutorial|CGI::Session::Tutorial> - extended CGI::Session manual - CGI::Session->name("MY_SID"); - $session = new CGI::Session(undef, $cgi, \%attrs); +=item * -Now, $session->header() uses "MY_SID" as a name for the session cookie. +L<CGI::Session::CookBook|CGI::Session::CookBook> - practical solutions for real life problems + +=item * + +B<RFC 2965> - "HTTP State Management Mechanism" found at ftp://ftp.isi.edu/in-notes/rfc2965.txt + +=item * -=item query() +L<CGI|CGI> - standard CGI library -Returns query object associated with current session object. Default query object class is L<CGI.pm|CGI>. +=item * + +L<Apache::Session|Apache::Session> - another fine alternative to CGI::Session =back -=head2 DEPRECATED METHODS +=cut -These methods exist solely for for compatibility with CGI::Session 3.x. +# dump() - dumps the session object using Data::Dumper. +# during development it defines global dump(). +sub dump { + my ($self, $file, $indent) = @_; -=over 4 + require Data::Dumper; + local $Data::Dumper::Indent = $indent || 2; -=item close() + my $d = new Data::Dumper([$self], [ref $self]); -Closes the session. Using flush() is recommended instead, since that's exactly what a call -to close() does now. + if ( defined $file ) { + unless ( open(FH, '<' . $file) ) { + unless(open(FH, '>' . $file)) { + $self->error("Couldn't open $file: $!"); + return undef; + } + print FH $d->Dump(); + unless ( CORE::close(FH) ) { + $self->error("Couldn't dump into $file: $!"); + return undef; + } + } + } + return $d->Dump(); +} -=back -=head1 DISTRIBUTION -CGI::Session consists of several components such as L<drivers|"DRIVERS">, L<serializers|"SERIALIZERS"> and L<id generators|"ID GENERATORS">. This section lists what is available. +sub version { return $VERSION } -=head2 DRIVERS -Following drivers are included in the standard distribution: +# delete() - sets the '_STATUS' session flag to DELETED, +# which flush() uses to decide to call remove() method on driver. +sub delete { + my $self = shift; -=over 4 + # If it was already deleted, make a confession! + if ( $self->{_STATUS} == DELETED ) { + confess "delete attempt on deleted session"; + } -=item * + $self->{_STATUS} = DELETED; +} -L<file|CGI::Session::Driver::file> - default driver for storing session data in plain files. Full name: B<CGI::Session::Driver::file> -=item * -L<db_file|CGI::Session::Driver::db_file> - for storing session data in BerkelyDB. Requires: L<DB_File>. -Full name: B<CGI::Session::Driver::db_file> -=item * -L<mysql|CGI::Session::Driver::mysql> - for storing session data in MySQL tables. Requires L<DBI|DBI> and L<DBD::mysql|DBD::mysql>. -Full name: B<CGI::Session::Driver::mysql> +# clear() - clears a list of parameters off the session's '_DATA' table +sub clear { + my $self = shift; + $class = ref($self); + + my @params = (); + + # if there was at least one argument, we take it as a list + # of params to delete + if ( @_ ) { + @params = ref($_[0]) ? @{ $_[0] } : ($_[0]); + } else { + @params = $self->param(); + } -=item * + my $n = 0; + for ( @params ) { + /^_SESSION_/ and next; + # If this particular parameter has an expiration ticker, + # remove it. + if ( $self->{_DATA}->{_SESSION_EXPIRE_LIST}->{$_} ) { + delete ( $self->{_DATA}->{_SESSION_EXPIRE_LIST}->{$_} ); + } + delete ($self->{_DATA}->{$_}) && ++$n; + } -L<sqlite|CGI::Session::Driver::sqlite> - for storing session data in SQLite. Requires L<DBI|DBI> and L<DBD::SQLite|DBD::SQLite>. -Full name: B<CGI::Session::Driver::sqlite> + # Set the session '_STATUS' flag to MODIFIED + $self->{_STATUS} = MODIFIED; -=back + return $n; +} -=head2 SERIALIZERS -=over 4 +# save_param() - copies a list of third party object parameters +# into CGI::Session object's '_DATA' table +sub save_param { + my ($self, $cgi, $list) = @_; -=item * + unless ( ref($cgi) ) { + confess "save_param(): first argument should be an object"; -L<default|CGI::Session::Serialize::default> - default data serializer. Uses standard L<Data::Dumper|Data::Dumper>. -Full name: B<CGI::Session::Serialize::default>. + } + unless ( $cgi->can('param') ) { + confess "save_param(): Cannot call method param() on the object"; + } -=item * + my @params = (); + if ( defined $list ) { + unless ( ref($list) eq 'ARRAY' ) { + confess "save_param(): second argument must be an arrayref"; + } -L<storable|CGI::Session::Serialize::storable> - serializes data using L<Storable>. Requires L<Storable>. -Full name: B<CGI::Session::Serialize::storable>. + @params = @{ $list }; -=item * + } else { + @params = $cgi->param(); -L<freezethaw|CGI::Session::Serialize::freezethaw> - serializes data using L<FreezeThaw>. Requires L<FreezeThaw>. -Full name: B<CGI::Session::Serialize::freezethaw> + } -=back + my $n = 0; + for ( @params ) { + # It's imporatnt to note that CGI.pm's param() returns array + # if a parameter has more values associated with it (checkboxes + # and crolling lists). So we should access its parameters in + # array context not to miss anything + my @values = $cgi->param($_); -=head2 ID GENERATORS + if ( defined $values[1] ) { + $self->_set_param($_ => \@values); -Following ID generators are available: + } else { + $self->_set_param($_ => $values[0] ); -=over 4 + } -=item * + ++$n; + } -L<md5|CGI::Session::ID::md5> - generates 32 character long hexadecimal string. Requires L<Digest::MD5|Digest::MD5>. -Full name: B<CGI::Session::ID::md5>. + return $n; +} -=item * -L<incr|CGI::Session::ID::incr> - generates incremental session ids. +# load_param() - loads a list of third party object parameters +# such as CGI, into CGI::Session's '_DATA' table +sub load_param { + my ($self, $cgi, $list) = @_; -=item * + unless ( ref($cgi) ) { + confess "save_param(): first argument must be an object"; -L<static|CGI::Session::ID::static> - generates static session ids. B<CGI::Session::ID::static> + } + unless ( $cgi->can('param') ) { + my $class = ref($cgi); + confess "save_param(): Cannot call method param() on the object $class"; + } -=back + my @params = (); + if ( defined $list ) { + unless ( ref($list) eq 'ARRAY' ) { + confess "save_param(): second argument must be an arrayref"; + } + @params = @{ $list }; + } else { + @params = $self->param(); -=head1 CREDITS + } -CGI::Session evolved to what it is today with the help of following developers. The list doesn't follow any strict order, but somewhat chronological. Specifics can be found in F<Changes> file + my $n = 0; + for ( @params ) { + $cgi->param(-name=>$_, -value=>$self->_get_param($_)); + } + return $n; +} -=over 4 -=item Andy Lester E<lt>alest****@flr*****<gt> -=item Brian King E<lt>mrbbk****@mac*****<gt> -=item Olivier Dragon E<lt>drago****@shadn*****<gt> +# another, but a less efficient alternative to undefining +# the object +sub close { + my $self = shift; -=item Adam Jacob E<lt>adam****@sysad*****<gt> + $self->DESTROY(); +} -=item Igor Plisco E<lt>igor****@plisc*****<gt> -=item Mark Stosberg E<lt>marks****@cpan*****<gt> -=item Matt LeBlanc +# error() returns/sets error message +sub error { + my ($self, $msg) = @_; -=item Shawn Sorichetti + if ( defined $msg ) { + $errstr = $msg; + } -=back + return $errstr; +} -=head1 COPYRIGHT -Copyright (C) 2001-2005 Sherzod Ruzmetov E<lt>sherz****@cpan*****<gt>. All rights reserved. -This library is free software. You can modify and or distribute it under the same terms as Perl itself. +# errstr() - alias to error() +sub errstr { + my $self = shift; -=head1 PUBLIC CODE REPOSITORY + return $self->error(@_); +} -You can see what the developers have been up to since the last release by -checking out the code repository. You can browse the Subversion repository from here: - http://svn.cromedome.net/ -Or check it directly with C<svn> from here: +# atime() - rerturns session last access time +sub atime { + my $self = shift; - svn://svn.cromedome.net/CGI-Session + if ( @_ ) { + confess "_SESSION_ATIME - read-only value"; + } -=head1 SUPPORT + return $self->{_DATA}->{_SESSION_ATIME}; +} -If you need help using CGI::Session consider the mailing list. You can ask the list by sending your questions to -cgi-****@lists***** . -You can subscribe to the mailing list at https://lists.sourceforge.net/lists/listinfo/cgi-session-user . +# ctime() - returns session creation time +sub ctime { + my $self = shift; -Bug reports can be submitted at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=CGI-Session + if ( @_ ) { + confess "_SESSION_ATIME - read-only value"; + } -=head1 AUTHOR + return $self->{_DATA}->{_SESSION_CTIME}; +} -Sherzod Ruzmetov E<lt>sherz****@cpan*****<gt>, http://author.handalak.com/ -Mark Stosberg became a co-maintainer during the development of 4.0. C<marks****@cpan*****>. +# expire() - sets/returns session/parameter expiration ticker +sub expire { + my $self = shift; -=head1 SEE ALSO + unless ( @_ ) { + return $self->{_DATA}->{_SESSION_ETIME}; + } -=over 4 + if ( @_ == 1 ) { + return $self->{_DATA}->{_SESSION_ETIME} = _time_alias( $_[0] ); + } -=item * + # If we came this far, we'll simply assume user is trying + # to set an expiration date for a single session parameter. + my ($param, $etime) = @_; -L<CGI::Session::Tutorial|CGI::Session::Tutorial> - extended CGI::Session manual + # Let's check if that particular session parameter exists + # in the '_DATA' table. Otherwise, return now! + defined ($self->{_DATA}->{$param} ) || return; -=item * + if ( $etime eq '-1' ) { + delete $self->{_DATA}->{_SESSION_EXPIRE_LIST}->{$param}; + $self->{_STATUS} = MODIFIED; + return; + } -B<RFC 2965> - "HTTP State Management Mechanism" found at ftp://ftp.isi.edu/in-notes/rfc2965.txt + $self->{_DATA}->{_SESSION_EXPIRE_LIST}->{$param} = _time_alias( $etime ); +} -=item * -L<CGI|CGI> - standard CGI library +# expires() - alias to expire(). For backward compatibility +sub expires { + return expire(@_); +} -=item * -L<Apache::Session|Apache::Session> - another fine alternative to CGI::Session +# parses such strings as '+1M', '+3w', accepted by expire() +sub _time_alias { + my ($str) = @_; -=back + # If $str consists of just digits, return them as they are + if ( $str =~ m/^\d+$/ ) { + return $str; + } -=cut + my %time_map = ( + s => 1, + m => 60, + h => 3600, + d => 86400, + w => 604800, + M => 2592000, + y => 31536000 + ); -1; + my ($koef, $d) = $str =~ m/^([+-]?\d+)(\w)$/; + + if ( defined($koef) && defined($d) ) { + return $koef * $time_map{$d}; + } +} + + +# remote_addr() - returns ip address of the session +sub remote_addr { + my $self = shift; + + return $self->{_DATA}->{_SESSION_REMOTE_ADDR}; +} + + +# param_hashref() - returns parameters as a reference to a hash +sub param_hashref { + my $self = shift; + + return $self->{_DATA}; +} + + +# name() - returns the cookie name associated with the session id +sub name { + my ($class, $name) = @_; + + if ( defined $name ) { + $CGI::Session::NAME = $name; + } + + return $CGI::Session::NAME; +} + + +# header() - replacement for CGI::header() method +sub header { + my $self = shift; + + my $cgi = $self->{_SESSION_OBJ}; + unless ( defined $cgi ) { + require CGI; + $self->{_SESSION_OBJ} = CGI->new(); + return $self->header(); + } + + my $cookie = $cgi->cookie($self->name(), $self->id() ); + + return $cgi->header( + -type => 'text/html', + -cookie => $cookie, + @_ + ); +} + + +# sync_param() - synchronizes CGI and Session parameters. +sub sync_param { + my ($self, $cgi, $list) = @_; + + unless ( ref($cgi) ) { + confess("$cgi doesn't look like an object"); + } + + unless ( $cgi->UNIVERSAL::can('param') ) { + confess(ref($cgi) . " doesn't support param() method"); + } + + # we first need to save all the available CGI parameters to the + # object + $self->save_param($cgi, $list); + + # we now need to load all the parameters back to the CGI object + return $self->load_param($cgi, $list); +} + + +# to Chris Dolan's request +sub is_new { + my $self = shift; + + return $self->{_IS_NEW}; +} +# $Id: Session.pm,v 1.3 2005/12/19 16:42:00 slash5234 Exp $
