fix tests for clear_flash (mocking was bad)
[catagits/Catalyst-Plugin-Session.git] / lib / Catalyst / Plugin / Session.pm
index e5d2af3..d8ce67e 100644 (file)
@@ -12,18 +12,25 @@ use Digest              ();
 use overload            ();
 use Object::Signature   ();
 
-our $VERSION = "0.04";
+our $VERSION = "0.13";
 
+my @session_data_accessors; # used in delete_session
 BEGIN {
     __PACKAGE__->mk_accessors(
-        qw/
+        "_session_delete_reason",
+        @session_data_accessors = qw/
           _sessionid
           _session
           _session_expires
+          _extended_session_expires
           _session_data_sig
-          _session_delete_reason
           _flash
-          _flash_stale_keys
+          _flash_keep_keys
+          _flash_key_hashes
+          _tried_loading_session_id
+          _tried_loading_session_data
+          _tried_loading_session_expires
+          _tried_loading_flash_data
           /
     );
 }
@@ -72,7 +79,7 @@ sub prepare_action {
     my $c = shift;
 
     if (    $c->config->{session}{flash_to_stash}
-        and $c->_sessionid
+        and $c->sessionid
         and my $flash_data = $c->flash )
     {
         @{ $c->stash }{ keys %$flash_data } = values %$flash_data;
@@ -84,34 +91,54 @@ sub prepare_action {
 sub finalize {
     my $c = shift;
 
+    $c->finalize_session;
+    
+    $c->NEXT::finalize(@_);
+}
+
+sub finalize_session {
+    my $c = shift;
+
+    $c->NEXT::finalize_session;
+
+    $c->_save_session_id;
     $c->_save_session;
     $c->_save_flash;
+    $c->_save_session_expires;
 
-    $c->NEXT::finalize(@_);
+    $c->_clear_session_instance_data;
 }
 
-sub _save_session {
+sub _save_session_id {
     my $c = shift;
 
-    if ( my $sid = $c->_sessionid ) {
-        if ( my $session_data = $c->_session ) {
+    # we already called set when allocating
+    # no need to tell the state plugins anything new
+}
 
-            # all sessions are extended at the end of the request
-            my $now = time;
+sub _save_session_expires {
+    my $c = shift;
 
-            # the ref is a workaround for FastMmap:
-            # FastMmap can't store values which aren't refs
-            # this yields errors and other great suckage
-            $c->store_session_data( "expires:$sid" =>
-                  ( { expires => $c->config->{session}{expires} + $now } ) );
+    if ( defined($c->_session_expires) ) {
+        my $expires = $c->session_expires; # force extension
 
-            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 );
-            }
+        my $sid = $c->sessionid;
+        $c->store_session_data( "expires:$sid" => $expires );
+    }
+}
+
+sub _save_session {
+    my $c = shift;
+
+    if ( my $session_data = $c->_session ) {
+
+        no warnings 'uninitialized';
+        if ( Object::Signature::signature($session_data) ne
+            $c->_session_data_sig )
+        {
+            $session_data->{__updated} = time();
+            my $sid = $c->sessionid;
+            $c->store_session_data( "session:$sid" => $session_data );
         }
     }
 }
@@ -119,12 +146,19 @@ sub _save_session {
 sub _save_flash {
     my $c = shift;
 
-    if ( my $sid = $c->_sessionid ) {
-        my $flash_data = $c->_flash || {};
+    if ( my $flash_data = $c->_flash ) {
 
-        delete @{$flash_data}{ @{ $c->_flash_stale_keys || [] } };
+        my $hashes = $c->_flash_key_hashes || {};
+        my $keep = $c->_flash_keep_keys || {};
+        foreach my $key ( keys %$hashes ) {
+            if ( !exists $keep->{$key} and Object::Signature::signature( \$flash_data->{$key} ) eq $hashes->{$key} ) {
+                delete $flash_data->{$key};
+            }
+        }
+        
+        my $sid = $c->sessionid;
 
-        if (%$flash_data) {    # damn 'my' declarations
+        if (%$flash_data) {
             $c->store_session_data( "flash:$sid", $flash_data );
         }
         else {
@@ -133,45 +167,56 @@ sub _save_flash {
     }
 }
 
-sub _load_session {
+sub _load_session_expires {
     my $c = shift;
+    return $c->_session_expires if $c->_tried_loading_session_expires;
+    $c->_tried_loading_session_expires(1);
+
+    if ( my $sid = $c->sessionid ) {
+        my $expires = $c->get_session_data("expires:$sid") || 0;
+
+        if ( $expires >= time() ) {
+            $c->_session_expires( $expires );
+            return $expires;
+        } else {
+            $c->delete_session( "session expired" );
+            return 0;
+        }
+    }
 
-    if ( my $sid = $c->_sessionid ) {
-        no warnings 'uninitialized';    # ne __address
-
-        # see above for explanation  of the workaround for FastMmap problem
-        my $session_expires =
-          ( $c->get_session_data("expires:$sid") || { expires => 0 } )
-          ->{expires};
+    return;
+}
 
-        if ( $session_expires < time ) {
+sub _load_session {
+    my $c = shift;
+    return $c->_session if $c->_tried_loading_session_data;
+    $c->_tried_loading_session_data(1);
 
-            # session expired
-            $c->log->debug("Deleting session $sid (expired)") if $c->debug;
-            $c->delete_session("session expired");
-            return;
-        }
+    if ( my $sid = $c->sessionid ) {
+        if ( $c->_load_session_expires ) {    # > 0
 
-        my $session_data = $c->get_session_data("session:$sid");
-        $c->_session($session_data);
+            my $session_data = $c->get_session_data("session:$sid") || return;
+            $c->_session($session_data);
 
-        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;
-        }
+            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;
+            }
 
-        $c->log->debug(qq/Restored session "$sid"/) if $c->debug;
-        $c->_session_data_sig( Object::Signature::signature($session_data) );
-        $c->_expire_session_keys;
+            $c->log->debug(qq/Restored session "$sid"/) if $c->debug;
+            $c->_session_data_sig( Object::Signature::signature($session_data) ) if $session_data;
+            $c->_expire_session_keys;
 
-        return $session_data;
+            return $session_data;
+        }
     }
 
     return;
@@ -179,17 +224,20 @@ sub _load_session {
 
 sub _load_flash {
     my $c = shift;
+    return $c->_flash if $c->_tried_loading_flash_data;
+    $c->_tried_loading_flash_data(1);
 
-    if ( my $sid = $c->_sessionid ) {
+    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 ] );
+            $c->_flash_key_hashes({ map { $_ => Object::Signature::signature( \$flash_data->{$_} ) } keys %$flash_data });
+            
             return $flash_data;
         }
     }
 
-    return undef;
+    return;
 }
 
 sub _expire_session_keys {
@@ -197,54 +245,118 @@ sub _expire_session_keys {
 
     my $now = time;
 
-    my $expiry = ( $data || $c->_session || {} )->{__expire_keys} || {};
-    foreach my $key ( grep { $expiry->{$_} < $now } keys %$expiry ) {
+    my $expire_times = ( $data || $c->_session || {} )->{__expire_keys} || {};
+    foreach my $key ( grep { $expire_times->{$_} < $now } keys %$expire_times ) {
         delete $c->_session->{$key};
-        delete $expiry->{$key};
+        delete $expire_times->{$key};
     }
 }
 
+sub _clear_session_instance_data {
+    my $c = shift;
+    $c->$_(undef) for @session_data_accessors;
+    $c->NEXT::_clear_session_instance_data; # allow other plugins to hook in on this
+}
+
 sub delete_session {
     my ( $c, $msg ) = @_;
 
+    $c->log->debug("Deleting session" . ( defined($msg) ? "($msg)" : '(no reason given)') ) if $c->debug;
+
     # delete the session data
-    my $sid = $c->_sessionid || return;
-    $c->delete_session_data("${_}:${sid}") for qw/session expires flash/;
+    if ( my $sid = $c->sessionid ) {
+        $c->delete_session_data("${_}:${sid}") for qw/session expires flash/;
+        $c->delete_session_id($sid);
+    }
 
     # reset the values in the context object
-    $c->_session(undef);
-    $c->_sessionid(undef);
+    # see the BEGIN block
+    $c->_clear_session_instance_data;
+
     $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->session_is_valid; # check that it was loaded
 
     $c->_session_delete_reason(@_);
 }
 
+sub session_expires {
+    my $c = shift;
+
+    if ( defined( my $expires = $c->_extended_session_expires ) ) {
+        return $expires;
+    } elsif ( defined( $expires = $c->_load_session_expires ) ) {
+        return $c->extend_session_expires( $expires );
+    } else {
+        return 0;
+    }
+}
+
+sub extend_session_expires {
+    my ( $c, $expires ) = @_;
+    $c->_extended_session_expires( my $updated = $c->calculate_extended_session_expires( $expires ) );
+    $c->extend_session_id( $c->sessionid, $updated );
+    return $updated;
+}
+
+sub calculate_initial_session_expires {
+    my $c = shift;
+    return ( time() + $c->config->{session}{expires} );
+}
+
+sub calculate_extended_session_expires {
+    my ( $c, $prev ) = @_;
+    $c->calculate_initial_session_expires;
+}
+
+sub reset_session_expires {
+    my ( $c, $sid ) = @_;
+    
+    my $exp = $c->calculate_initial_session_expires;
+    $c->_session_expires( $exp );
+    $c->_extended_session_expires( $exp );
+    $exp;
+}
+
 sub sessionid {
     my $c = shift;
+    
+    return $c->_sessionid || $c->_load_sessionid;
+}
+
+sub _load_sessionid {
+    my $c = shift;
+    return if $c->_tried_loading_session_id;
+    $c->_tried_loading_session_id(1);
 
-    if (@_) {
-        if ( $c->validate_session_id( my $sid = shift ) ) {
+    if ( defined( my $sid = $c->get_session_id ) ) {
+        if ( $c->validate_session_id($sid) ) {
+            # temporarily set the inner key, so that validation will work
             $c->_sessionid($sid);
-            return unless defined wantarray;
-        }
-        else {
+            return $sid;
+        } 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
+    return;
+}
 
-    return $c->_sessionid;
+sub session_is_valid {
+    my $c = shift;
+
+    # force a check for expiry, but also __address, etc
+    if ( $c->_load_session ) {
+        return 1;
+    } else {
+        return;
+    }
 }
 
 sub validate_session_id {
@@ -257,18 +369,32 @@ sub session {
     my $c = shift;
 
     $c->_session || $c->_load_session || do {
-        $c->create_session_id;
-
+        $c->create_session_id_if_needed;
         $c->initialize_session_data;
     };
 }
 
+sub keep_flash {
+    my ( $c, @keys ) = @_;
+    my $href = $c->_flash_keep_keys || $c->_flash_keep_keys({});
+    (@{$href}{@keys}) = ((undef) x @keys);
+}
+
 sub flash {
     my $c = shift;
     $c->_flash || $c->_load_flash || do {
-        $c->create_session_id;
+        $c->create_session_id_if_needed;
         $c->_flash( {} );
-      }
+    }
+}
+
+sub clear_flash {
+    my $c = shift;
+    
+    #$c->delete_session_data("flash:" . $c->sessionid); # should this be in here? or delayed till finalization?
+    $c->_flash_key_hashes({});
+    $c->_flash_keep_keys({});
+    $c->_flash({});
 }
 
 sub session_expire_key {
@@ -306,16 +432,23 @@ sub generate_session_id {
     return $digest->hexdigest;
 }
 
+sub create_session_id_if_needed {
+    my $c = shift;
+    $c->create_session_id unless $c->sessionid;
+}
+
 sub create_session_id {
     my $c = shift;
+    
+    my $sid = $c->generate_session_id;
 
-    if ( !$c->_sessionid ) {
-        my $sid = $c->generate_session_id;
+    $c->log->debug(qq/Created session "$sid"/) if $c->debug;
 
-        $c->log->debug(qq/Created session "$sid"/) if $c->debug;
+    $c->_sessionid($sid);
+    $c->reset_session_expires;
+    $c->set_session_id($sid);
 
-        $c->sessionid($sid);
-    }
+    return $sid;
 }
 
 my $counter;
@@ -357,6 +490,12 @@ sub dump_these {
     );
 }
 
+
+sub get_session_id { shift->NEXT::get_session_id(@_) }
+sub set_session_id { shift->NEXT::set_session_id(@_) }
+sub delete_session_id { shift->NEXT::delete_session_id(@_) }
+sub extend_session_id { shift->NEXT::extend_session_id(@_) }
+
 __PACKAGE__;
 
 __END__
@@ -462,10 +601,27 @@ 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
-lasts a single redirect, not only a forward.
+lasts for longer than one request, letting you redirect instead of forward.
+
+The flash data will be cleaned up only on requests on which actually use
+$c->flash (thus allowing multiple redirections), and the policy is to delete
+all the keys which haven't changed since the flash data was loaded at the end
+of every request.
 
     sub moose : Local {
         my ( $self, $c ) = @_;
@@ -492,6 +648,20 @@ lasts a single redirect, not only a forward.
         }
     }
 
+=item clear_flash
+
+Zap all the keys in the flash regardless of their current state.
+
+=item keep_flash @keys
+
+If you wawnt to keep a flash key for the next request too, even if it hasn't
+changed, call C<keep_flash> and pass in the keys as arguments.
+
+=item delete_session REASON
+
+This method is used to invalidate a session. It takes an optional parameter
+which will be saved in C<session_delete_reason> if provided.
+
 =item session_delete_reason
 
 This accessor contains a string with the reason a session was deleted. Possible
@@ -561,11 +731,6 @@ prepare time.
 This method is extended and will extend the expiry time, as well as persist the
 session data if a session exists.
 
-=item delete_session REASON
-
-This method is used to invalidate a session. It takes an optional parameter
-which will be saved in C<session_delete_reason> if provided.
-
 =item initialize_session_data
 
 This method will initialize the internal structure of the session, and is
@@ -576,6 +741,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
@@ -590,13 +762,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 *
@@ -643,6 +808,12 @@ Or even more directly, replace C<generate_session_id>:
 Also have a look at L<Crypt::Random> and the various openssl bindings - these
 modules provide APIs for cryptographically secure random data.
 
+=item finalize_session
+
+Clean up the session during C<finalize>.
+
+This clears the various accessors after saving to the store.
+
 =item dump_these
 
 See L<Catalyst/dump_these> - ammends the session data structure to the list of
@@ -708,7 +879,7 @@ are automatically set:
 
 =item __expires
 
-This key no longer exists. This data is now saved elsewhere.
+This key no longer exists. Use C<session_expires> instead.
 
 =item __updated