added hot sessions

docs/changelog/8.x.x.txt

@@ -1 +1,4 @@
 8.0.0
+ - Replaced the existing caching mechanism with memcached, which results in a 400% improvement to cache speed. See migration.txt for API changes and gotcha.txt for prereq changes.
+ - Added "hot sessions" so sessions interact with the database less.
+

docs/upgrades/upgrade_7.8.1-8.0.0.pl

@@ -45,7 +45,8 @@ sub migrateToNewCache {
     unlink "../../lib/WebGUI/Workflow/Activity/CleanDatabaseCache.pm";
     unlink "../../lib/WebGUI/Workflow/Activity/CleanFileCache.pm";
     my $config = $session->config;
-    $config->set("cacheServers" => [ { "socket" => "/data/wre/var/memcached.sock", "host" => "127.0.0.1", "port" => "11211" } ]);
+    $config->set("cacheServers", [ { "socket" => "/data/wre/var/memcached.sock", "host" => "127.0.0.1", "port" => "11211" } ]);
+    $config->set("hotSessionFlushToDb", 600);
     $config->delete("disableCache");
     $config->delete("cacheType");
     $config->delete("fileCacheRoot");

etc/WebGUI.conf.original

@@ -96,10 +96,21 @@
 # memcached over TCP. And since this is an array you can specify
 # as many server connections as you have memcached servers
 
- "cacheServers" : [
+"cacheServers" : [
 	{ "socket" : "/tmp/memcached.sock", "host" : "127.0.0.1", "port" : "11211" }
 ],
 
+# Sessions that are "hot", those that are not only not expired,
+# but that are currently active on the site are kept in memory
+# to make them exceptionally fast. The hotSessionFlushToDb 
+# directive allows you to say how often (in seconds) those
+# sessions should be pushed down to the database. On most sites
+# 10 minutes is a good duration. If you have an exceptionally
+# short session timeout (in the settings) then you may wish to
+# set it lower.
+
+"hotSessionFlushToDb" : 600,
+
 # The database connection string. It usually takes the form of
 # DBI:<driver>:<db>;host:<hostname>
 

lib/WebGUI/Session.pm

@@ -144,7 +144,7 @@ sub close {
 
 	# Kill circular references.  The literal list is so that the order
 	# can be explicitly shuffled as necessary.
-	foreach my $key (qw/_asset _datetime _icon _slave _db _env _form _http _id _output _os _privilege _scratch _setting _stow _style _url _user _var _errorHandler/) {
+	foreach my $key (qw/_asset _datetime _icon _slave _db _env _form _http _id _output _os _privilege _scratch _setting _stow _style _url _user _var _cache _errorHandler/) {
 		delete $self->{$key};
 	}
 }

lib/WebGUI/Session/Var.pm

@@ -56,7 +56,6 @@ Deconstructor.
 
 sub DESTROY {
         my $self = shift;
-        undef $self;
 }
 
 
@@ -69,10 +68,13 @@ Removes the specified user session from memory and database.
 =cut
 
 sub end {
-        my $self = shift;
-        $self->session->scratch->deleteAll;
-        $self->session->db->write("delete from userSession where sessionId=?",[$self->getId]);
-        delete $self->session->{_user};
+    my $self = shift;
+    my $session = $self->session;
+    my $id = $self->getId;
+    eval{$session->cache->delete(['session',$id])};
+    $session->scratch->deleteAll;
+    $session->db->write("delete from userSession where sessionId=?",[$id]);
+    delete $session->{_user};
 	$self->DESTROY;
 }
 
@@ -168,16 +170,16 @@ normally be used by anyone.
 =cut
 
 sub new {
-	my $class = shift;
-	my $session = shift;
+    my ($class, $session, $sessionId, $noFuss) = @_;
 	my $self = bless {_session=>$session}, $class;
-	my $sessionId = shift;
-	my $noFuss = shift;
 	if ($sessionId eq "") { ##New session
 		$self->start(1);
 	}
     else { ##existing session requested
-        $self->{_var} = $session->db->quickHashRef("select * from userSession where sessionId=?",[$sessionId]);
+        $self->{_var} = eval{$session->cache->get(['session',$sessionId])};
+        unless ($self->{_var}{sessionId} eq $sessionId) {
+            $self->{_var} = $session->db->quickHashRef("select * from userSession where sessionId=?",[$sessionId]);
+        }
         ##We have to make sure that the session variable has a sessionId, otherwise downstream users of
         ##the object will break
         if ($noFuss && $self->{_var}{sessionId}) {
@@ -189,11 +191,20 @@ sub new {
 			$self->start(1,$sessionId);
 		}
         elsif ($self->{_var}{sessionId} ne "") { ##Fetched an existing session.  Update variables with recent data.
-			$self->{_var}{lastPageView} = $session->datetime->time();
+            my $time = $session->datetime->time();
+            my $timeout = $session->setting->get("sessionTimeout");
+			$self->{_var}{lastPageView} = $time;
 			$self->{_var}{lastIP} = $session->env->getIp;
-			$self->{_var}{expires} = $session->datetime->time() + $session->setting->get("sessionTimeout");
+			$self->{_var}{expires} = $time + $timeout;
+            if ($self->{_var}{nextCacheFlush} > 0 && $self->{_var}{nextCacheFlush} < $time) {
+                delete $self->{_var}{nextCacheFlush};
+			    $session->db->setRow("userSession","sessionId",$self->{_var});
+            }
+            else {
+                $self->{_var}{nextCacheFlush} = $time + $session->config->get("hotSessionFlushToDb");
+                $session->cache->set(['session',$sessionId], $self->{_var}, $timeout);
+            }
 			$self->session->{_sessionId} = $self->{_var}{sessionId};
-			$session->db->setRow("userSession","sessionId",$self->{_var});
             return $self;
 		}
         else {  ##Start a new default session with the requested, non-existant id.
@@ -240,19 +251,24 @@ sub start {
 	my $userId = shift;
 	$userId = 1 if ($userId eq "");
 	my $sessionId = shift;
-	$sessionId = $self->session->id->generate if ($sessionId eq "");
-	my $time = $self->session->datetime->time();
+    my $session = $self->session;
+    my $id = $session->id;
+	$sessionId = $id->generate if ($sessionId eq "");
+    my $timeout = $session->setting->get('sessionTimeout');
+	my $time = $session->datetime->time();
 	$self->{_var} = {
-		expires      => $time + $self->session->setting->get("sessionTimeout"),
+		expires      => $time + $timeout,
 		lastPageView => $time,
-		lastIP       => $self->session->env->getIp,
+		lastIP       => $session->env->getIp,
 		adminOn      => 0,
 		userId       => $userId
 	};
-	$self->{_var}{sessionId} = $sessionId;
-	$self->session->db->setRow("userSession","sessionId",$self->{_var},$sessionId);
-	$self->session->{_sessionId} = $sessionId;
-    $self->session->scratch->set('webguiCsrfToken', $self->session->id->generate);
+    $self->session->{_sessionId} = $sessionId;
+    eval{$session->cache->set(['session',$sessionId], $self->{_var}, $timeout)};
+    delete $self->{_var}{nextCacheFlush};
+	$session->db->setRow("userSession","sessionId",$self->{_var},$sessionId);
+	$self->{_sessionId} = $sessionId;
+    $session->scratch->set('webguiCsrfToken', $id->generate); # create cross site request forgery token
 }
 
 #-------------------------------------------------------------------
@@ -264,9 +280,12 @@ Disables admin mode.
 =cut
 
 sub switchAdminOff {
-        my $self = shift;
-        $self->{_var}{adminOn} = 0;
-        $self->session->db->setRow("userSession","sessionId", $self->{_var});
+    my $self = shift;
+    $self->{_var}{adminOn} = 0;
+    my $session = $self->session;
+    eval{$session->cache->set(['session',$self->getId], $self->{_var}, $session->setting->get('sessionTimeout'))};
+    delete $self->{_var}{nextCacheFlush};
+    $session->db->setRow("userSession","sessionId", $self->{_var});
 }
 
 #-------------------------------------------------------------------
@@ -278,9 +297,12 @@ Enables admin mode.
 =cut
 
 sub switchAdminOn {
-        my $self = shift;
-        $self->{_var}{adminOn} = 1;
-        $self->session->db->setRow("userSession","sessionId", $self->{_var});
+    my $self = shift;
+    $self->{_var}{adminOn} = 1;
+    my $session = $self->session;
+    eval{$session->cache->set(['session',$self->getId], $self->{_var}, $session->setting->get('sessionTimeout'))};
+    delete $self->{_var}{nextCacheFlush};
+    $self->session->db->setRow("userSession","sessionId", $self->{_var});
 }
 
 

t/Session/Stow.t

@@ -15,7 +15,7 @@ use lib "$FindBin::Bin/../lib";
 use WebGUI::Test;
 use WebGUI::Session;
 
-use Test::More tests => 35; # increment this value for each test you create
+use Test::More tests => 33; # increment this value for each test you create
  
 my $session = WebGUI::Test->session;
  
@@ -25,9 +25,6 @@ my $stow  = $session->stow;
 my $count = 0;
 my $maxCount = 20;
 
-my $disableCache = $session->config->get('disableCache');
-$session->config->set('disableCache',0);
-
 for (my $count = 1; $count <= $maxCount; $count++){
    $stow->set("Test$count",$count);
 }
@@ -41,22 +38,8 @@ is($stow->get("Test1"), undef, "delete()");
 $stow->deleteAll;
 is($stow->get("Test2"), undef, "deleteAll()");
 
-####################################################
-#
-# get, set with disableCache
-#
-####################################################
-
-$session->config->set('disableCache', 1);
-is($stow->get('Test2'), undef, 'get: when config->disableCache is set get returns undef');
-
 WebGUI::Test->interceptLogging();
 
-$stow->set('unavailableVariable', 'too bad');
-is($WebGUI::Test::logger_debug, 'Stow->set() is being called but cache has been disabled', 'debug emitted by set when disableCache is true');
-
-$session->config->set('disableCache', 0);
-
 is($session->stow->set('', 'null string'), undef, 'set returns undef when name is empty string');
 is($session->stow->set(0, 'zero'), undef, 'set returns undef when name is zero');
 
@@ -99,6 +82,3 @@ is( $session->stow->get( 'possibilities', { noclone => 1 } ), $arr,
     "With noclone returns same reference"
 );
 
-END {
-	$session->config->set('disableCache',$disableCache);
-}

t/Session/Var.t

@@ -129,10 +129,16 @@ $var->end;
 ##by looking for admin status and userId
 $var2 = WebGUI::Session::Var->new($session);
 $var2->switchAdminOn;
+
+# jury rig the database and the cache to expire
 $session->db->write("update userSession set userId=? where sessionId=?",
 	[3, $var2->getId]);
 $session->db->write("update userSession set expires=? where sessionId=?",
 	[$var2->get('lastPageView')-1, $var2->getId]);
+my %copyOfVar2 = %{$var2->{_var}};
+$copyOfVar2{expires} = $var2->get('lastPageView')-1;
+$copyOfVar2{userId} = 3;
+$session->cache->set(['session',$var2->getId], \%copyOfVar2);
 
 my $var3 = WebGUI::Session::Var->new($session, $var2->getId);
 is($var3->getId,           $var2->getId, 'new Var object has correct id');