Doc tweaks to C::P::Session::Store
[catagits/Catalyst-Plugin-Session.git] / lib / Catalyst / Plugin / Session.pm
index ae79a8e..f306997 100644 (file)
@@ -10,11 +10,23 @@ use NEXT;
 use Catalyst::Exception ();
 use Digest              ();
 use overload            ();
+use Object::Signature   ();
 
-our $VERSION = "0.02";
+our $VERSION = "0.04";
 
+my @session_data_accessors; # used in delete_session
 BEGIN {
-    __PACKAGE__->mk_accessors(qw/_sessionid _session _session_delete_reason _flash _flash_stale_keys/);
+    __PACKAGE__->mk_accessors(
+        "_session_delete_reason",
+        @session_data_accessors = qw/
+          _sessionid
+          _session
+          _session_expires
+          _session_data_sig
+          _flash
+          _flash_stale_keys
+          /
+    );
 }
 
 sub setup {
@@ -60,7 +72,10 @@ sub setup_session {
 sub prepare_action {
     my $c = shift;
 
-    if ( $c->config->{session}{flash_to_stash} and $c->_sessionid and my $flash_data = $c->flash ) {
+    if (    $c->config->{session}{flash_to_stash}
+        and $c->_sessionid
+        and my $flash_data = $c->flash )
+    {
         @{ $c->stash }{ keys %$flash_data } = values %$flash_data;
     }
 
@@ -78,16 +93,25 @@ sub finalize {
 
 sub _save_session {
     my $c = shift;
-    
+
     if ( my $sid = $c->_sessionid ) {
-        if ( my $session_data = $c->_session ) {
 
-            # all sessions are extended at the end of the request
-            my $now = time;
-            @{ $session_data }{qw/__updated __expires/} =
-              ( $now, $c->config->{session}{expires} + $now );
+        # all sessions are extended at the end of the request
+        my $now = time;
 
-            $c->store_session_data( "session:$sid", $session_data );
+        if ( my $expires = $c->session_expires ) {
+            $c->store_session_data( "expires:$sid" => $expires );
+        }
+
+        if ( my $session_data = $c->_session ) {
+
+            no warnings 'uninitialized';
+            if ( Object::Signature::signature($session_data) ne
+                $c->_session_data_sig )
+            {
+                $session_data->{__updated} = $now;
+                $c->store_session_data( "session:$sid" => $session_data );
+            }
         }
     }
 }
@@ -96,13 +120,15 @@ sub _save_flash {
     my $c = shift;
 
     if ( my $sid = $c->_sessionid ) {
-        if ( my $flash_data = $c->_flash ) {
-            if ( %$flash_data ) { # damn 'my' declarations
-                delete @{ $flash_data }{ @{ $c->_flash_stale_keys || [] } };
-                $c->store_session_data( "flash:$sid", $flash_data );
-            }
-        } else {
-            $c->delete_session_data( "flash:$sid" );
+        my $flash_data = $c->_flash || {};
+
+        delete @{$flash_data}{ @{ $c->_flash_stale_keys || [] } };
+
+        if (%$flash_data) {    # damn 'my' declarations
+            $c->store_session_data( "flash:$sid", $flash_data );
+        }
+        else {
+            $c->delete_session_data("flash:$sid");
         }
     }
 }
@@ -111,43 +137,44 @@ sub _load_session {
     my $c = shift;
 
     if ( my $sid = $c->_sessionid ) {
-               no warnings 'uninitialized'; # ne __address
-
-        my $session_data = $c->_session || $c->_session( $c->get_session_data( "session:$sid" ) );
-        if ( !$session_data or $session_data->{__expires} < time ) {
+        if ( $c->session_expires ) {    # > 0
+
+            my $session_data = $c->get_session_data("session:$sid");
+            $c->_session($session_data);
+
+            no warnings 'uninitialized';    # ne __address
+            if (   $c->config->{session}{verify_address}
+                && $session_data->{__address} ne $c->request->address )
+            {
+                $c->log->warn(
+                        "Deleting session $sid due to address mismatch ("
+                      . $session_data->{__address} . " != "
+                      . $c->request->address . ")",
+                );
+                $c->delete_session("address mismatch");
+                return;
+            }
 
-            # session expired
-            $c->log->debug("Deleting session $sid (expired)") if $c->debug;
-            $c->delete_session("session expired");
-        }
-        elsif ($c->config->{session}{verify_address}
-            && $session_data->{__address} ne $c->request->address )
-        {
-            $c->log->warn(
-                    "Deleting session $sid due to address mismatch ("
-                  . $session_data->{__address} . " != "
-                  . $c->request->address . ")",
-            );
-            $c->delete_session("address mismatch");
-        }
-        else {
             $c->log->debug(qq/Restored session "$sid"/) if $c->debug;
-        }
-       
-        $c->_expire_ession_keys;
+            $c->_session_data_sig(
+                Object::Signature::signature($session_data) );
+            $c->_expire_session_keys;
 
-        return $session_data;
+            return $session_data;
+        }
     }
 
-    return undef;
+    return;
 }
 
 sub _load_flash {
     my $c = shift;
 
     if ( my $sid = $c->_sessionid ) {
-        if ( my $flash_data = $c->_flash || $c->_flash( $c->get_session_data( "flash:$sid" ) ) ) {
-            $c->_flash_stale_keys([ keys %$flash_data ]);
+        if ( my $flash_data = $c->_flash
+            || $c->_flash( $c->get_session_data("flash:$sid") ) )
+        {
+            $c->_flash_stale_keys( [ keys %$flash_data ] );
             return $flash_data;
         }
     }
@@ -155,13 +182,13 @@ sub _load_flash {
     return undef;
 }
 
-sub _expire_ession_keys {
+sub _expire_session_keys {
     my ( $c, $data ) = @_;
 
     my $now = time;
 
-    my $expiry = ($data || $c->_session || {})->{__expire_keys} || {};
-    foreach my $key (grep { $expiry->{$_} < $now } keys %$expiry ) {
+    my $expiry = ( $data || $c->_session || {} )->{__expire_keys} || {};
+    foreach my $key ( grep { $expiry->{$_} < $now } keys %$expiry ) {
         delete $c->_session->{$key};
         delete $expiry->{$key};
     }
@@ -172,45 +199,73 @@ sub delete_session {
 
     # delete the session data
     my $sid = $c->_sessionid || return;
-    $c->delete_session_data( "session:$sid" );
+    $c->delete_session_data("${_}:${sid}") for qw/session expires flash/;
 
     # reset the values in the context object
-    $c->_session(undef);
-    $c->_sessionid(undef);
+    # see the BEGIN block
+    $c->$_(undef) for @session_data_accessors;
+
     $c->_session_delete_reason($msg);
 }
 
 sub session_delete_reason {
     my $c = shift;
 
-    $c->_load_session if ( $c->_sessionid && !$c->_session ); # must verify session data
+    $c->_load_session
+      if ( $c->_sessionid && !$c->_session );    # must verify session data
 
-    $c->_session_delete_reason( @_ );
+    $c->_session_delete_reason(@_);
+}
+
+sub session_expires {
+    my ( $c, $should_create ) = @_;
+
+    $c->_session_expires || do {
+        if ( my $sid = $c->_sessionid ) {
+            my $now = time;
+
+            if ( !$should_create ) {
+                if ( ( $c->get_session_data("expires:$sid") || 0 ) < $now ) {
+
+                    # session expired
+                    $c->log->debug("Deleting session $sid (expired)")
+                      if $c->debug;
+                    $c->delete_session("session expired");
+                    return 0;
+                }
+            }
+
+            return $c->_session_expires(
+                $now + $c->config->{session}{expires} );
+        }
+    };
 }
 
 sub sessionid {
-       my $c = shift;
-    
-       if ( @_ ) {
-               if ( $c->validate_session_id( my $sid = shift ) ) {
-                       $c->_sessionid( $sid );
+    my $c = shift;
+
+    if (@_) {
+        if ( $c->validate_session_id( my $sid = shift ) ) {
+            $c->_sessionid($sid);
             return unless defined wantarray;
-               } else {
-                       my $err = "Tried to set invalid session ID '$sid'";
-                       $c->log->error( $err );
-                       Catalyst::Exception->throw( $err );
-               }
-       }
-    
-    $c->_load_session if ( $c->_sessionid && !$c->_session ); # must verify session data
+        }
+        else {
+            my $err = "Tried to set invalid session ID '$sid'";
+            $c->log->error($err);
+            Catalyst::Exception->throw($err);
+        }
+    }
 
-       return $c->_sessionid;
+    $c->_load_session
+      if ( $c->_sessionid && !$c->_session );    # must verify session data
+
+    return $c->_sessionid;
 }
 
 sub validate_session_id {
-       my ( $c, $sid ) = @_;
+    my ( $c, $sid ) = @_;
 
-       $sid and $sid =~ /^[a-f\d]+$/i;
+    $sid and $sid =~ /^[a-f\d]+$/i;
 }
 
 sub session {
@@ -220,7 +275,7 @@ sub session {
         $c->create_session_id;
 
         $c->initialize_session_data;
-       };
+    };
 }
 
 sub flash {
@@ -228,14 +283,15 @@ sub flash {
     $c->_flash || $c->_load_flash || do {
         $c->create_session_id;
         $c->_flash( {} );
-    }
+      }
 }
 
 sub session_expire_key {
     my ( $c, %keys ) = @_;
 
     my $now = time;
-    @{ $c->session->{__expire_keys} }{keys %keys} = map { $now + $_ } values %keys;
+    @{ $c->session->{__expire_keys} }{ keys %keys } =
+      map { $now + $_ } values %keys;
 }
 
 sub initialize_session_data {
@@ -243,17 +299,18 @@ sub initialize_session_data {
 
     my $now = time;
 
-    return $c->_session({
-        __created => $now,
-        __updated => $now,
-        __expires => $now + $c->config->{session}{expires},
-
-        (
-            $c->config->{session}{verify_address}
-            ? ( __address => $c->request->address )
-            : ()
-        ),
-    });
+    return $c->_session(
+        {
+            __created => $now,
+            __updated => $now,
+
+            (
+                $c->config->{session}{verify_address}
+                ? ( __address => $c->request->address )
+                : ()
+            ),
+        }
+    );
 }
 
 sub generate_session_id {
@@ -273,6 +330,7 @@ sub create_session_id {
         $c->log->debug(qq/Created session "$sid"/) if $c->debug;
 
         $c->sessionid($sid);
+        $c->session_expires(1);
     }
 }
 
@@ -288,19 +346,16 @@ my $usable;
 
 sub _find_digest () {
     unless ($usable) {
-        foreach my $alg (qw/SHA-1 MD5 SHA-256/) {
-            eval {
-                Digest->new($alg);
-            };
-            unless ($@) {
+        foreach my $alg (qw/SHA-1 SHA-256 MD5/) {
+            if ( eval { Digest->new($alg) } ) {
                 $usable = $alg;
                 last;
             }
         }
-        $usable
-          or Catalyst::Exception->throw(
+        Catalyst::Exception->throw(
                 "Could not find a suitable Digest module. Please install "
-              . "Digest::SHA1, Digest::SHA, or Digest::MD5" );
+              . "Digest::SHA1, Digest::SHA, or Digest::MD5" )
+          unless $usable;
     }
 
     return Digest->new($usable);
@@ -423,6 +478,18 @@ requests.
 This method will automatically create a new session and session ID if none
 exists.
 
+=item session_expires
+
+=item session_expires $reset
+
+This method returns the time when the current session will expire, or 0 if
+there is no current session. If there is a session and it already expired, it
+will delete the session and return 0 as well.
+
+If the C<$reset> parameter is true, and there is a session ID the expiry time
+will be reset to the current time plus the time to live (see
+L</CONFIGURATION>). This is used when creating a new session.
+
 =item flash
 
 This is like Ruby on Rails' flash data structure. Think of it as a stash that
@@ -490,7 +557,7 @@ Note that these values are not auto extended.
 
 =back
 
-=item INTERNAL METHODS
+=head1 INTERNAL METHODS
 
 =over 4
 
@@ -537,6 +604,13 @@ called by the C<session> method if appropriate.
 Creates a new session id using C<generate_session_id> if there is no session ID
 yet.
 
+=item validate_session_id SID
+
+Make sure a session ID is of the right format.
+
+This currently ensures that the session ID string is any amount of case
+insensitive hexadecimal characters.
+
 =item generate_session_id
 
 This method will return a string that can be used as a session ID. It is
@@ -551,13 +625,6 @@ overridable in case you want to provide more random data.
 
 Currently it returns a concatenated string which contains:
 
-=item validate_session_id SID
-
-Make sure a session ID is of the right format.
-
-This currently ensures that the session ID string is any amount of case
-insensitive hexadecimal characters.
-
 =over 4
 
 =item *
@@ -669,14 +736,11 @@ are automatically set:
 
 =item __expires
 
-A timestamp whose value is the last second when the session is still valid. If
-a session is restored, and __expires is less than the current time, the session
-is deleted.
+This key no longer exists. Use C<session_expires> instead.
 
 =item __updated
 
-The last time a session was saved. This is the value of
-C<< $c->session->{__expires} - $c->config->session->{expires} >>.
+The last time a session was saved to the store.
 
 =item __created