added database cache option

docs/changelog/6.x.x.txt

@@ -1,5 +1,6 @@
 6.99.0
  - Added archive/unarchive options to CS threads.
+ - Added a database cache option as an alternative to memcached.
  - Added a workflow system.
  - Added a workflow scheduler system.
  - Converted the runHourly.pl scripts to run as scheduled workflows. 

docs/upgrades/upgrade_6.8.7-6.99.0.pl

@@ -35,9 +35,22 @@ ipsToCIDR();
 addDisabletoRichEditor();
 addNavigationMimeType();
 addIndexes();
+addDatabaseCache();
 
 finish($session); # this line required
 
+#-------------------------------------------------
+sub addDatabaseCache {
+	print "\tAdding database cache.\n";
+	$session->db->write("create table cache ( namespace varchar(128) not null, cachekey varchar(128) not null, expires bigint not null, size int not null, content mediumtext, primary key (namespace, cachekey))");
+	$session->db->write("alter table cache add index namespace_cachekey_size (namespace,cachekey,expires)");
+	if ($session->config->get("memcached_servers")) {
+		$session->config->set("cacheType","WebGUI::Cache::Memcached");
+	} else {
+		$session->config->set("cacheType","WebGUI::Cache::FileCache");
+	}
+}
+
 #-------------------------------------------------
 sub addIndexes {
 	print "\tAdding indexes to increase performance.\n";

etc/WebGUI.conf.original

@@ -45,6 +45,17 @@
 
 # "passthruUrls" : ["/icons", "/documentation/pdf", "/my-custom-application", "/server-status", "/perl-status"],
 
+# What kind of cache do you wish to use? Available types are 
+# WebGUI::Cache::FileCache, WebGUI::Cache::Database, and
+# WebGUI::Cache::Memcached. We highly recommend the file
+# cache if you're in a single server environment, and the
+# database cache if you have multiple web nodes. Memcached
+# is experimental and is slower and buggier than the other
+# two, so should only be used if you know what you're
+# doing.
+
+"cacheType" : "WebGUI::Cache::FileCache",
+
 # Tell WebGUI where to store cached files. Defaults to the 
 # /tmp or c:\temp folder depending upon your operating system.
 

lib/WebGUI/Cache.pm

@@ -117,9 +117,12 @@ sub new {
 	my $cache;
 	my $class = shift;
 	my $session = shift;
-	if ($session->config->get("memcached_servers")) {
+	if ($session->config->get("cacheType") eq "WebGUI::Cache::Memcached" && $session->config->get("memcached_servers")) {
 		require WebGUI::Cache::Memcached;
 		return WebGUI::Cache::Memcached->new($session,@_);
+	} elsif ($session->config->get("cacheType") eq "WebGUI::Cache::Database") {
+		require WebGUI::Cache::Database;
+		return WebGUI::Cache::Database->new($session,@_);
 	} else {
 		require WebGUI::Cache::FileCache;
 		return WebGUI::Cache::FileCache->new($session,@_);

lib/WebGUI/Cache/Database.pm

@@ -0,0 +1,183 @@
+package WebGUI::Cache::Database;
+
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2006 Plain Black Corporation.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com                     info@plainblack.com
+ -------------------------------------------------------------------
+
+=cut
+
+use strict;
+use base "WebGUI::Cache";
+use Storable qw(freeze thaw);
+
+=head1 NAME
+
+Package WebGUI::Cache::Database
+
+=head1 DESCRIPTION
+
+This package provides a means for WebGUI to cache data to the database.
+
+=head1 SYNOPSIS
+
+ use WebGUI::Cache::Database;
+
+=head1 METHODS
+
+These methods are available from this class:
+
+=cut
+
+
+
+
+#-------------------------------------------------------------------
+
+=head2 delete ( )
+
+Remove content from the filesystem cache.
+
+=cut
+
+sub delete {
+	my $self = shift;
+	$self->session->db->write("delete from cache where namespace=? and cachekey=?",[$self->{_namespace}, $self->{_key}]);
+}
+
+#-------------------------------------------------------------------
+
+=head2 deleteChunk ( key )
+
+Remove a partial composite key from the cache.
+
+=head3 key
+
+A partial composite key to remove.
+
+=cut
+
+sub deleteChunk {
+	my $self = shift;
+	$self->session->db->write("delete from cache where namespace=? and cachekey like ?",[$self->{_namespace}, $self->{_key}.'%']);
+}
+
+#-------------------------------------------------------------------
+
+=head2 flush ( )
+
+Remove all objects from the filecache system.
+
+=cut
+
+sub flush {
+	my $self = shift;
+	$self->SUPER::flush();
+	$self->session->db->write("delete from cache where namespace=?",[$self->{_namespace}]);
+}
+
+#-------------------------------------------------------------------
+
+=head2 get ( )
+
+Retrieve content from the filesystem cache.
+
+=cut
+
+sub get {
+	my $self = shift;
+	return undef if ($self->session->config->get("disableCache"));
+	# getting better performance using native dbi than webgui sql
+	my $dbh = $self->session->db->dbh;	
+	my $sth = $dbh->prepare("select content from cache where namespace=? and cachekey=? and expires>?");
+	$sth->execute($self->{_namespace},$self->{_key},time());
+	my $data = $sth->fetchrow_arrayref;
+	$sth->finish;
+	my $content = $data->[0];
+	return undef unless ($content);
+	return thaw($content);
+}
+
+#-------------------------------------------------------------------
+
+=head2 new ( session, key [, namespace ]  )
+
+Constructor.
+
+=head3 session
+
+A reference to the current session.
+
+=head3 key 
+
+A key unique to this namespace. It is used to uniquely identify the cached content.
+
+=head3 namespace
+
+Defaults to the config filename for the current site. The only reason to override the default is if you want the cached content to be shared among all WebGUI instances on this machine. A common alternative namespace is "URL", which is typically used when caching content using the setByHTTP method.
+
+=cut
+
+sub new {
+	my $cache;
+	my $class = shift;
+	my $session = shift;
+	my $key = $class->parseKey(shift);
+	my $namespace = shift || $session->config->getFilename;
+	bless {_session=>$session, _key=>$key, _namespace=>$namespace}, $class;
+}
+
+
+#-------------------------------------------------------------------
+
+=head2 set ( content [, ttl ] )
+
+Save content to the filesystem cache.
+
+=head3 content
+
+A scalar variable containing the content to be set.
+
+=head3 ttl
+
+The time to live for this content. This is the amount of time (in seconds) that the content will remain in the cache. Defaults to "60".
+
+=cut
+
+sub set {
+	my $self = shift;
+	my $content = freeze(shift);
+	my $ttl = shift || 60;
+	my $size = length($content);
+	# getting better performance using native dbi than webgui sql
+	my $dbh = $self->session->db->dbh;
+	my $sth = $dbh->prepare("replace into cache (namespace,cachekey,expires,size,content) values (?,?,?,?,?)");
+	$sth->execute($self->{_namespace}, $self->{_key}, time()+$ttl, $size, $content);
+	$sth->finish;
+}
+
+
+#-------------------------------------------------------------------
+
+=head2 stats ( )
+
+Returns statistic information about the caching system.
+
+=cut
+
+sub stats {
+	my $self = shift;
+	my ($size) = $self->session->db->quickArray("select sum(size) from cache where namespace=?",[$self->{_namespace}]);
+	return $size." bytes";
+}
+
+1;
+
+