diff --git a/docs/changelog/8.x.x.txt b/docs/changelog/8.x.x.txt index ae9a76b92..25798f40d 100644 --- a/docs/changelog/8.x.x.txt +++ b/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. + diff --git a/docs/gotcha.txt b/docs/gotcha.txt index 90487d3fd..5f71ad524 100644 --- a/docs/gotcha.txt +++ b/docs/gotcha.txt @@ -7,6 +7,18 @@ upgrading from one version to the next, or even between multiple versions. Be sure to heed the warnings contained herein as they will save you many hours of grief. +8.0.0 +-------------------------------------------------------------------- + * WebGUI 8 is not API compatible with WebGUI 7. If you have custom + code, chances are you'll need to update it to make it work with + WebGUI 8. + + * WebGUI now requires memcached. + + * WebGUI now requires the following Perl Modules: + - Memcached::libmemcached (0.3102) + + 7.8.0 -------------------------------------------------------------------- diff --git a/docs/migration.txt b/docs/migration.txt index 5e63c0766..c1aafab6a 100644 --- a/docs/migration.txt +++ b/docs/migration.txt @@ -4,3 +4,12 @@ WebGUI 8 Migration Guide The information contained herein documents the API changes that have occurred in the WebGUI 8 development effort and how to migrate your code to accomodate the new APIs. +WebGUI::Cache +============= +WebGUI::Cache has been completely rewritten. If you were using the cache API in the past, you'll need to update your code to reflect the changes. NOTE: you can get a cached reference to the cache object from WebGUI::Session, which will be substantially faster than instantiating the object yourself. + +my $cache = $session->cache; + + + + diff --git a/docs/upgrades/upgrade_7.8.1-8.0.0.pl b/docs/upgrades/upgrade_7.8.1-8.0.0.pl index 883bb77bc..67877b6ce 100644 --- a/docs/upgrades/upgrade_7.8.1-8.0.0.pl +++ b/docs/upgrades/upgrade_7.8.1-8.0.0.pl @@ -18,6 +18,7 @@ BEGIN { } use strict; +use File::Path qw/rmtree/; use Getopt::Long; use WebGUI::Session; use WebGUI::Storage; @@ -31,10 +32,32 @@ my $quiet; # this line required my $session = start(); # this line required moveMaintenance($session); +migrateToNewCache($session); finish($session); # this line required +#---------------------------------------------------------------------------- +sub migrateToNewCache { + my $session = shift; + print "\tMigrating to new cache " unless $quiet; + rmtree "../../lib/WebGUI/Cache"; + 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("hotSessionFlushToDb", 600); + $config->delete("disableCache"); + $config->delete("cacheType"); + $config->delete("fileCacheRoot"); + $config->deleteFromArray("workflowActivities/None", "WebGUI::Workflow::Activity::CleanDatabaseCache"); + $config->deleteFromArray("workflowActivities/None", "WebGUI::Workflow::Activity::CleanFileCache"); + my $db = $session->db; + $db->write("drop table cache"); + $db->write("delete from WorkflowActivity where className in ('WebGUI::Workflow::Activity::CleanDatabaseCache','WebGUI::Workflow::Activity::CleanFileCache')"); + print "DONE!\n" unless $quiet; +} + #---------------------------------------------------------------------------- sub moveMaintenance { my $session = shift; diff --git a/etc/WebGUI.conf.original b/etc/WebGUI.conf.original index 392c75f9a..c1be63e1a 100644 --- a/etc/WebGUI.conf.original +++ b/etc/WebGUI.conf.original @@ -88,24 +88,28 @@ #"webServerPort" : 80, -# What kind of cache do you wish to use? Available types are -# WebGUI::Cache::FileCache and WebGUI::Cache::Database. -# We highly recommend the database cache if you are running -# sites with more than a few hundred pages, or if you're -# running in a multi-server environment. The file cache is better -# for very small sites. +# The cacheServers directive tells WebGUI how to connect to +# memcached. If a "socket" is specified it will be used instead +# of the host and port info, and this should be the +# path to the unix socket that you started memcached with. "host" +# and "port" are used to tell WebGUI how to connect to +# memcached over TCP. And since this is an array you can specify +# as many server connections as you have memcached servers -"cacheType" : "WebGUI::Cache::FileCache", +"cacheServers" : [ + { "socket" : "/tmp/memcached.sock", "host" : "127.0.0.1", "port" : "11211" } +], -# Tell WebGUI where to store cached files. Defaults to the -# /tmp or c:\temp folder depending upon your operating system. +# 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. -# "fileCacheRoot" : "/path/to/cache", - -# Set this to 1 to disable WebGUI's caching subsystems. This is -# mainly useful for developers. - -"disableCache" : 0, +"hotSessionFlushToDb" : 600, # The database connection string. It usually takes the form of # DBI::;host: @@ -857,8 +861,6 @@ "WebGUI::Workflow::Activity::ArchiveOldStories", "WebGUI::Workflow::Activity::ArchiveOldThreads", "WebGUI::Workflow::Activity::CalendarUpdateFeeds", - "WebGUI::Workflow::Activity::CleanDatabaseCache", - "WebGUI::Workflow::Activity::CleanFileCache", "WebGUI::Workflow::Activity::CleanLoginHistory", "WebGUI::Workflow::Activity::CleanTempStorage", "WebGUI::Workflow::Activity::CreateCronJob", diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 202fab508..195322ac3 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -31,7 +31,6 @@ use WebGUI::AssetVersioning; use strict; use Tie::IxHash; use WebGUI::AdminConsole; -use WebGUI::Cache; use WebGUI::Form; use WebGUI::HTML; use WebGUI::HTMLForm; @@ -1778,19 +1777,16 @@ sub new { return undef unless $revisionDate; } - my $cache = WebGUI::Cache->new($session, ["asset",$assetId,$revisionDate]); - my $properties = $cache->get; - if (exists $properties->{assetId}) { - # got properties from cache - } - else { + my $properties = eval{$session->cache->get(["asset",$assetId,$revisionDate])}; + unless (exists $properties->{assetId}) { $properties = WebGUI::Asset->assetDbProperties($session, $assetId, $class, $revisionDate); unless (exists $properties->{assetId}) { $session->errorHandler->error("Asset $assetId $class $revisionDate is missing properties. Consult your database tables for corruption. "); return undef; } - $cache->set($properties,60*60*24); + eval{ $session->cache->set(["asset",$assetId,$revisionDate], $properties, 60*60*24) }; } + if (defined $properties) { my $object = { _session=>$session, _properties => $properties }; bless $object, $class; @@ -2345,10 +2341,11 @@ sub publish { my $idList = $self->session->db->quoteAndJoin($assetIds); $self->session->db->write("update asset set state='published', stateChangedBy=".$self->session->db->quote($self->session->user->userId).", stateChanged=".$self->session->datetime->time()." where assetId in (".$idList.")"); - my $cache = WebGUI::Cache->new($self->session); foreach my $id (@{$assetIds}) { - # we do the purge directly cuz it's a lot faster than instantiating all these assets - $cache->deleteChunk(["asset",$id]); + my $asset = WebGUI::Asset->newByDynamicClass($self->session, $id); + if (defined $asset) { + $asset->purgeCache; + } } $self->{_properties}{state} = "published"; @@ -2378,7 +2375,7 @@ sub purgeCache { $stow->delete('assetLineage'); $stow->delete('assetClass'); $stow->delete('assetRevision'); - WebGUI::Cache->new($self->session,["asset",$self->getId,$self->get("revisionDate")])->deleteChunk(["asset",$self->getId]); + eval{$self->session->cache->delete(["asset",$self->getId,$self->get("revisionDate")])}; } diff --git a/lib/WebGUI/Asset/File.pm b/lib/WebGUI/Asset/File.pm index 5d8922056..19b5410b9 100644 --- a/lib/WebGUI/Asset/File.pm +++ b/lib/WebGUI/Asset/File.pm @@ -17,7 +17,6 @@ package WebGUI::Asset::File; use strict; use base 'WebGUI::Asset'; use Carp; -use WebGUI::Cache; use WebGUI::Storage; use WebGUI::SQL; use WebGUI::Utility; @@ -448,7 +447,7 @@ Extends the master method to clear the view cache. sub purgeCache { my $self = shift; - WebGUI::Cache->new($self->session,"view_".$self->getId)->delete; + eval{$self->session->cache->delete("view_".$self->getId)}; $self->SUPER::purgeCache; } @@ -608,7 +607,7 @@ Generate the view method for the Asset, and handle caching. sub view { my $self = shift; if (!$self->session->var->isAdminOn && $self->get("cacheTimeout") > 10) { - my $out = WebGUI::Cache->new($self->session,"view_".$self->getId)->get; + my $out = eval{$self->session->cache->get("view_".$self->getId)}; return $out if $out; } my %var = %{$self->get}; @@ -618,7 +617,7 @@ sub view { $var{fileSize} = formatBytes($self->get("assetSize")); my $out = $self->processTemplate(\%var,undef,$self->{_viewTemplate}); if (!$self->session->var->isAdminOn && $self->get("cacheTimeout") > 10) { - WebGUI::Cache->new($self->session,"view_".$self->getId)->set($out,$self->get("cacheTimeout")); + eval{$self->session->cache->set("view_".$self->getId, $out, $self->get("cacheTimeout"))}; } return $out; } diff --git a/lib/WebGUI/Asset/File/Image.pm b/lib/WebGUI/Asset/File/Image.pm index c4166da6c..711ae6b4c 100644 --- a/lib/WebGUI/Asset/File/Image.pm +++ b/lib/WebGUI/Asset/File/Image.pm @@ -222,8 +222,9 @@ Renders this asset. sub view { my $self = shift; + my $cache = $self->session->cache; if (!$self->session->var->isAdminOn && $self->get("cacheTimeout") > 10) { - my $out = WebGUI::Cache->new($self->session,"view_".$self->getId)->get; + my $out = eval{$cache->get("view_".$self->getId)}; return $out if $out; } my %var = %{$self->get}; @@ -247,7 +248,7 @@ sub view { my $form = $self->session->form; my $out = $self->processTemplate(\%var,undef,$self->{_viewTemplate}); if (!$self->session->var->isAdminOn && $self->get("cacheTimeout") > 10) { - WebGUI::Cache->new($self->session,"view_".$self->getId)->set($out,$self->get("cacheTimeout")); + eval{$cache->set("view_".$self->getId, $out, $self->get("cacheTimeout"))}; } return $out; } @@ -310,16 +311,7 @@ sub www_undo { my $previous = (@{$self->getRevisions()})[1]; # instantiate assetId if ($previous) { - # my $session = $self->session; - - # my $cache = WebGUI::Cache->new($self->session, ["asset",$self->getId,$self->getRevisionDate]); - # $cache->flush; - # my $cache = WebGUI::Cache->new($previous->session, ["asset",$previous->getId,$previous->getRevisionDate]); - # $cache->flush; - $self = $self->purgeRevision(); - # $self = undef; - # $self = WebGUI::Asset->new($previous->session, $previous->getId, ref $previous, $previous->getRevisionDate); $self = $previous; $self->generateThumbnail; } diff --git a/lib/WebGUI/Asset/File/ZipArchive.pm b/lib/WebGUI/Asset/File/ZipArchive.pm index 7a11d4838..9fbca6fd7 100644 --- a/lib/WebGUI/Asset/File/ZipArchive.pm +++ b/lib/WebGUI/Asset/File/ZipArchive.pm @@ -220,8 +220,9 @@ used to show the file to administrators. sub view { my $self = shift; + my $cache = $self->session->cache; if (!$self->session->var->isAdminOn && $self->get("cacheTimeout") > 10) { - my $out = WebGUI::Cache->new($self->session,"view_".$self->getId)->get; + my $out = eval{$cache->get("view_".$self->getId)}; return $out if $out; } my %var = %{$self->get}; @@ -244,7 +245,7 @@ sub view { $var{noFileSpecified} = $i18n->get('noFileSpecified'); my $out = $self->processTemplate(\%var,undef,$self->{_viewTemplate}); if (!$self->session->var->isAdminOn && $self->get("cacheTimeout") > 10) { - WebGUI::Cache->new($self->session,"view_".$self->getId)->set($out,$self->get("cacheTimeout")); + eval{$cache->set("view_".$self->getId, $out, $self->get("cacheTimeout"))}; } return $out; } diff --git a/lib/WebGUI/Asset/Post.pm b/lib/WebGUI/Asset/Post.pm index ad8d9e113..4f23e02fe 100644 --- a/lib/WebGUI/Asset/Post.pm +++ b/lib/WebGUI/Asset/Post.pm @@ -16,7 +16,6 @@ use Tie::IxHash; use WebGUI::Asset; use WebGUI::Asset::Template; use WebGUI::Asset::Post::Thread; -use WebGUI::Cache; use WebGUI::Group; use WebGUI::HTML; use WebGUI::HTMLForm; @@ -1188,7 +1187,7 @@ Extend the base class to handle caching. sub purgeCache { my $self = shift; - WebGUI::Cache->new($self->session,"view_".$self->getThread->getId)->delete if ($self->getThread); + eval{$self->session->cache->delete("view_".$self->getThread->getId)} if ($self->getThread); $self->SUPER::purgeCache; } diff --git a/lib/WebGUI/Asset/Post/Thread.pm b/lib/WebGUI/Asset/Post/Thread.pm index 970a7e6d8..02f8dd9c1 100644 --- a/lib/WebGUI/Asset/Post/Thread.pm +++ b/lib/WebGUI/Asset/Post/Thread.pm @@ -13,7 +13,6 @@ package WebGUI::Asset::Post::Thread; use strict; use WebGUI::Asset::Template; use WebGUI::Asset::Post; -use WebGUI::Cache; use WebGUI::Group; use WebGUI::International; use WebGUI::Paginator; @@ -1026,8 +1025,9 @@ sub view { my $currentPost = shift || $self; $self->markRead; $self->incrementViews unless ($self->session->form->process("func") eq 'rate'); + my $cache = $self->session->cache; if ($self->session->user->isVisitor && !$self->session->form->process("layout")) { - my $out = WebGUI::Cache->new($self->session,"view_".$self->getId)->get; + my $out = eval{$cache->get("view_".$self->getId)}; return $out if $out; } $self->session->scratch->set("discussionLayout",$self->session->form->process("layout")) if ($self->session->form->process("layout")); @@ -1134,7 +1134,7 @@ sub view { my $out = $self->processTemplate($var,undef,$self->{_viewTemplate}); if ($self->session->user->isVisitor && !$self->session->form->process("layout")) { - WebGUI::Cache->new($self->session,"view_".$self->getId)->set($out,$self->getThread->getParent->get("visitorCacheTimeout")); + eval{$cache->set("view_".$self->getId, $out, $self->getThread->getParent->get("visitorCacheTimeout"))}; } return $out; } diff --git a/lib/WebGUI/Asset/Shortcut.pm b/lib/WebGUI/Asset/Shortcut.pm index d6fa45878..9b0f6edc0 100644 --- a/lib/WebGUI/Asset/Shortcut.pm +++ b/lib/WebGUI/Asset/Shortcut.pm @@ -481,10 +481,10 @@ expired, or if the user's profile field has changed. sub getOverrides { my $self = shift; my $session = $self->session; - my $cache = WebGUI::Cache->new($self->session,$self->_overridesCacheTag); + my $cache = $session->cache; my $u = WebGUI::User->new($self->session, $self->discernUserId); - my $overridesRef = $cache->get; + my $overridesRef = eval{$cache->get($self->_overridesCacheTag)}; ##If admin mode is not on, and the cache is valid, and not expired, and the user object was not updated, ##return the cached value. if ( ! $session->var->isAdminOn @@ -532,7 +532,7 @@ sub getOverrides { } } $overrides{userLastUpdated} = $session->user->get('lastUpdated'); - $cache->set(\%overrides, 60*60); + eval{$cache->set($self->_overridesCacheTag, \%overrides, 60*60)}; $overridesRef = \%overrides; return %{ $overridesRef }; } @@ -879,7 +879,7 @@ Delete any cached overrides. sub uncacheOverrides { my $self = shift; - WebGUI::Cache->new($self->session,$self->_overridesCacheTag)->delete; + eval{$self->session->cache->delete($self->_overridesCacheTag)}; } #------------------------------------------------------------------- diff --git a/lib/WebGUI/Asset/Sku/Product.pm b/lib/WebGUI/Asset/Sku/Product.pm index ae1de8152..599f47435 100644 --- a/lib/WebGUI/Asset/Sku/Product.pm +++ b/lib/WebGUI/Asset/Sku/Product.pm @@ -13,7 +13,6 @@ package WebGUI::Asset::Sku::Product; use strict; use Tie::CPHash; use Tie::IxHash; -use WebGUI::Cache; use WebGUI::HTMLForm; use WebGUI::Storage; use WebGUI::SQL; @@ -789,7 +788,7 @@ Extends the base class to handle cleaning up the cache for this asset. sub purgeCache { my $self = shift; - WebGUI::Cache->new($self->session,"view_".$self->getId)->delete; + $self->session->cache->delete("view_".$self->getId); $self->SUPER::purgeCache; } @@ -1674,8 +1673,9 @@ sub view { my $self = shift; my $error = shift; my $session = $self->session; + my $cache = $session->cache; if (!$session->var->isAdminOn && $self->get("cacheTimeout") > 10){ - my $out = WebGUI::Cache->new($self->session,"view_".$self->getId)->get; + my $out = $cache->get("view_".$self->getId); return $out if $out; } my (%data, $segment, %var, @featureloop, @benefitloop, @specificationloop, @accessoryloop, @relatedloop); @@ -1878,7 +1878,7 @@ sub view { my $out = $self->processTemplate(\%var,undef,$self->{_viewTemplate}); if (!$self->session->var->isAdminOn && $self->get("cacheTimeout") > 10 && $self->{_hasAddedToCart} != 1){ - WebGUI::Cache->new($self->session,"view_".$self->getId)->set($out,$self->get("cacheTimeout")); + $cache->set("view_".$self->getId, $out, $self->get("cacheTimeout")); } return $out; } diff --git a/lib/WebGUI/Asset/Snippet.pm b/lib/WebGUI/Asset/Snippet.pm index 6ff5d2c55..e6c4124b0 100644 --- a/lib/WebGUI/Asset/Snippet.pm +++ b/lib/WebGUI/Asset/Snippet.pm @@ -250,9 +250,11 @@ Extending purgeCache to handle caching of the rendered snippet sub purgeCache { my $self = shift; - - WebGUI::Cache->new($self->session,"view__".$self->getId)->delete; - WebGUI::Cache->new($self->session,"view_1_".$self->getId)->delete; + my $cache = $self->session->cache; + eval { + $cache->delete("view__".$self->getId); + $cache->delete("view_1_".$self->getId); + }; $self->SUPER::purgeCache(); } @@ -279,7 +281,7 @@ sub view { || $self->get("cacheTimeout") <= 10 || ($versionTag && $versionTag->getId eq $self->get("tagId")); unless ($noCache) { - my $out = WebGUI::Cache->new($session,"view_".$calledAsWebMethod."_".$self->getId)->get; + my $out = eval{$session->cache->get("view_".$calledAsWebMethod."_".$self->getId)}; return $out if $out; } my $output = $self->get('usePacked') @@ -292,7 +294,7 @@ sub view { } WebGUI::Macro::process($session,\$output); unless ($noCache) { - WebGUI::Cache->new($session,"view_".$calledAsWebMethod."_".$self->getId)->set($output,$self->get("cacheTimeout")); + eval{$session->cache->set("view_".$calledAsWebMethod."_".$self->getId, $output, $self->get("cacheTimeout"))}; } return $output; } diff --git a/lib/WebGUI/Asset/Wobject/Article.pm b/lib/WebGUI/Asset/Wobject/Article.pm index 285d4c32d..cc02a5558 100644 --- a/lib/WebGUI/Asset/Wobject/Article.pm +++ b/lib/WebGUI/Asset/Wobject/Article.pm @@ -13,7 +13,6 @@ package WebGUI::Asset::Wobject::Article; use strict; use Tie::IxHash; use WebGUI::International; -use WebGUI::Cache; use WebGUI::Paginator; use WebGUI::Asset::Wobject; use WebGUI::Storage; @@ -319,7 +318,7 @@ See WebGUI::Asset::purgeCache() for details. sub purgeCache { my $self = shift; - WebGUI::Cache->new($self->session,"view_".$self->getId)->delete; + eval{$self->session->cache->delete("view_".$self->getId)}; $self->SUPER::purgeCache; } @@ -348,9 +347,10 @@ returns the output. sub view { my $self = shift; + my $cache = $self->session->cache; if (!$self->session->var->isAdminOn && $self->get("cacheTimeout") > 10 && !$self->session->form->process("overrideTemplateId") && !$self->session->form->process($self->paginateVar) && !$self->session->form->process("makePrintable")) { - my $out = WebGUI::Cache->new($self->session,"view_".$self->getId)->get; + my $out = eval{$cache->get("view_".$self->getId)}; return $out if $out; } my %var; @@ -414,7 +414,7 @@ sub view { my $out = $self->processTemplate(\%var,undef,$self->{_viewTemplate}); if (!$self->session->var->isAdminOn && $self->get("cacheTimeout") > 10 && !$self->session->form->process("overrideTemplateId") && !$self->session->form->process($self->paginateVar) && !$self->session->form->process("makePrintable")) { - WebGUI::Cache->new($self->session,"view_".$self->getId)->set($out,$self->get("cacheTimeout")); + eval{$cache->set("view_".$self->getId, $out, $self->get("cacheTimeout"))}; } return $out; } diff --git a/lib/WebGUI/Asset/Wobject/Collaboration.pm b/lib/WebGUI/Asset/Wobject/Collaboration.pm index 0f3efef69..867b58478 100644 --- a/lib/WebGUI/Asset/Wobject/Collaboration.pm +++ b/lib/WebGUI/Asset/Wobject/Collaboration.pm @@ -13,7 +13,6 @@ package WebGUI::Asset::Wobject::Collaboration; use strict; use Tie::IxHash; use WebGUI::Group; -use WebGUI::Cache; use WebGUI::HTML; use WebGUI::International; use WebGUI::Paginator; @@ -1404,8 +1403,11 @@ Extend the base method to delete view and visitor caches. sub purgeCache { my $self = shift; - WebGUI::Cache->new($self->session,"view_".$self->getId)->delete; - WebGUI::Cache->new($self->session,$self->_visitorCacheKey)->delete; + my $cache = $self->session->cache; + eval { + $cache->delete("view_".$self->getId); + $cache->delete($self->_visitorCacheKey); + }; $self->next::method; } @@ -1549,8 +1551,9 @@ Render the CS, and handle local caching. sub view { my $self = shift; + my $cache = $self->session->cache; if ($self->_visitorCacheOk) { - my $out = WebGUI::Cache->new($self->session,$self->_visitorCacheKey)->get; + my $out = eval{$cache->get($self->_visitorCacheKey)}; $self->session->errorHandler->debug("HIT") if $out; return $out if $out; } @@ -1561,7 +1564,7 @@ sub view { $self->prepareView unless ($self->{_viewTemplate}); my $out = $self->processTemplate($self->getViewTemplateVars,undef,$self->{_viewTemplate}); if ($self->_visitorCacheOk) { - WebGUI::Cache->new($self->session,$self->_visitorCacheKey)->set($out,$self->get("visitorCacheTimeout")); + eval{$cache->set($self->_visitorCacheKey, $out, $self->get("visitorCacheTimeout"))}; } return $out; } diff --git a/lib/WebGUI/Asset/Wobject/EventManagementSystem.pm b/lib/WebGUI/Asset/Wobject/EventManagementSystem.pm index 8f1d9f56a..b8f1424e4 100644 --- a/lib/WebGUI/Asset/Wobject/EventManagementSystem.pm +++ b/lib/WebGUI/Asset/Wobject/EventManagementSystem.pm @@ -25,7 +25,6 @@ use WebGUI::Asset::Sku::EMSBadge; use WebGUI::Asset::Sku::EMSTicket; use WebGUI::Asset::Sku::EMSRibbon; use WebGUI::Asset::Sku::EMSToken; -use WebGUI::Cache; use WebGUI::Exception; use WebGUI::FormValidator; use WebGUI::HTMLForm; diff --git a/lib/WebGUI/Asset/Wobject/Folder.pm b/lib/WebGUI/Asset/Wobject/Folder.pm index 21a50c3ea..d7d8b1018 100644 --- a/lib/WebGUI/Asset/Wobject/Folder.pm +++ b/lib/WebGUI/Asset/Wobject/Folder.pm @@ -16,7 +16,6 @@ package WebGUI::Asset::Wobject::Folder; use strict; use WebGUI::Asset::Wobject; -use WebGUI::Cache; use WebGUI::Utility; our @ISA = qw(WebGUI::Asset::Wobject); @@ -208,7 +207,7 @@ See WebGUI::Asset::purgeCache() for details. sub purgeCache { my $self = shift; - WebGUI::Cache->new($self->session,"view_".$self->getId)->delete; + eval{$self->session->cache->delete("view_".$self->getId)}; $self->SUPER::purgeCache; } @@ -225,8 +224,9 @@ sub view { my $self = shift; # Use cached version for visitors + my $cache = $self->session->cache; if ($self->session->user->isVisitor) { - my $out = WebGUI::Cache->new($self->session,"view_".$self->getId)->get; + my $out = eval{$cache->get("view_".$self->getId)}; return $out if $out; } @@ -291,8 +291,7 @@ sub view { # Update the cache if ($self->session->user->isVisitor) { - WebGUI::Cache->new($self->session,"view_".$self->getId) - ->set($out,$self->get("visitorCacheTimeout")); + eval{$cache->set("view_".$self->getId, $out, $self->get("visitorCacheTimeout"))}; } return $out; diff --git a/lib/WebGUI/Asset/Wobject/HttpProxy.pm b/lib/WebGUI/Asset/Wobject/HttpProxy.pm index bb0d06273..a05e9806a 100644 --- a/lib/WebGUI/Asset/Wobject/HttpProxy.pm +++ b/lib/WebGUI/Asset/Wobject/HttpProxy.pm @@ -20,7 +20,6 @@ use WebGUI::International; use WebGUI::Storage; use WebGUI::Asset::Wobject; use WebGUI::Asset::Wobject::HttpProxy::Parse; -use WebGUI::Cache; use WebGUI::Macro; use Apache2::Upload; @@ -277,8 +276,11 @@ See WebGUI::Asset::purgeCache() for details. sub purgeCache { my $self = shift; - WebGUI::Cache->new($self->session,$self->get("proxiedUrl"),"URL")->delete; - WebGUI::Cache->new($self->session,$self->get("proxiedUrl"),"HEADER")->delete; + my $cache = $self->session->cache; + eval { + $cache->delete([$self->get("proxiedUrl"),"URL"]); + $cache->delete([$self->get("proxiedUrl"),"HEADER"]); + }; $self->SUPER::purgeCache; } @@ -320,12 +322,12 @@ sub view { my $requestMethod = $self->session->env->get("REQUEST_METHOD") || "GET"; ### Do we have cached content to get? - my $cacheContent = WebGUI::Cache->new($self->session,$proxiedUrl,"URL"); - my $cacheHeader = WebGUI::Cache->new($self->session,$proxiedUrl,"HEADER"); - if ($requestMethod =~ /^GET$/i) - { - $var{header} = $cacheHeader->get; - $var{content} = $cacheContent->get; + my $cache = $self->session->cache; + if ($requestMethod =~ /^GET$/i) { + eval { + $var{header} = $cache->get([$proxiedUrl,'HEADER']); + $var{content} = $cache->get([$proxiedUrl,"URL"]); + }; } # Unless we have cached content @@ -465,8 +467,10 @@ sub view { $var{content} = sprintf $i18n->get('fetch page error'), $proxiedUrl, $proxiedUrl, $response->status_line; } unless ($self->get("cacheTimeout") <= 10) { - $cacheContent->set($var{content},$self->get("cacheTimeout")); - $cacheHeader->set($var{header},$self->get("cacheTimeout")); + eval{ + $cache->set([$proxiedUrl,'URL'], $var{content}, $self->get("cacheTimeout")); + $cache->set([$proxiedUrl,'HEADER'], $var{header}, $self->get("cacheTimeout")); + }; } } diff --git a/lib/WebGUI/Asset/Wobject/Layout.pm b/lib/WebGUI/Asset/Wobject/Layout.pm index 9ebdf7369..5ac97afdf 100644 --- a/lib/WebGUI/Asset/Wobject/Layout.pm +++ b/lib/WebGUI/Asset/Wobject/Layout.pm @@ -18,7 +18,6 @@ use strict; use WebGUI::AdSpace; use WebGUI::Asset::Wobject; use WebGUI::Utility; -use WebGUI::Cache; our @ISA = qw(WebGUI::Asset::Wobject); @@ -413,13 +412,13 @@ sub www_view { if ($session->env->sslRequest) { $cacheKey .= '_ssl'; } - my $cache = WebGUI::Cache->new($session, $cacheKey); - my $out = $cache->get if defined $cache; + my $cache = $session->cache; + my $out = eval{$cache->get($cacheKey)}; unless ($out) { $self->prepareView; $session->stow->set("cacheFixOverride", 1); $out = $self->processStyle($self->view, { noHeadTags => 1 }); - $cache->set($out, 60); + eval{$cache->set($cacheKey, $out, 60)}; $session->stow->delete("cacheFixOverride"); } # keep those ads rotating even though the output is cached diff --git a/lib/WebGUI/Asset/Wobject/Matrix.pm b/lib/WebGUI/Asset/Wobject/Matrix.pm index 876c0842d..cc9f3b83d 100644 --- a/lib/WebGUI/Asset/Wobject/Matrix.pm +++ b/lib/WebGUI/Asset/Wobject/Matrix.pm @@ -505,8 +505,9 @@ sub getListings { $session->var->isAdminOn || $self->get("listingsCacheTimeout") <= 10 || ($versionTag && $versionTag->getId eq $self->get("tagId")); + my $cache = $session->cache; unless ($noCache) { - $listingsEncoded = WebGUI::Cache->new($session,"matrixListings_".$self->getId)->get; + $listingsEncoded = eval{$cache->get("matrixListings_".$self->getId)}; } if ($listingsEncoded){ @@ -546,9 +547,7 @@ assetData.revisionDate } $listingsEncoded = JSON->new->encode($listings); - WebGUI::Cache->new($session,"matrixListings_".$self->getId)->set( - $listingsEncoded,$self->get("listingsCacheTimeout") - ); + eval{$cache->set("matrixListings_".$self->getId, $listingsEncoded, $self->get("listingsCacheTimeout"))}; } return $listings; } @@ -687,8 +686,9 @@ sub view { $session->var->isAdminOn || $self->get("statisticsCacheTimeout") <= 10 || ($versionTag && $versionTag->getId eq $self->get("tagId")); + my $cache = $session->cache; unless ($noCache) { - $varStatisticsEncoded = WebGUI::Cache->new($session,"matrixStatistics_".$self->getId)->get; + $varStatisticsEncoded = eval{$cache->get("matrixStatistics_".$self->getId)}; } if ($varStatisticsEncoded){ @@ -837,9 +837,7 @@ sub view { [$self->getId]); $varStatisticsEncoded = JSON->new->encode($varStatistics); - WebGUI::Cache->new($session,"matrixStatistics_".$self->getId)->set( - $varStatisticsEncoded,$self->get("statisticsCacheTimeout") - ); + eval{$cache->set("matrixStatistics_".$self->getId, $varStatisticsEncoded, $self->get("statisticsCacheTimeout"))}; } foreach my $statistic (keys %{$varStatistics}) { diff --git a/lib/WebGUI/Asset/Wobject/MessageBoard.pm b/lib/WebGUI/Asset/Wobject/MessageBoard.pm index 7061ce22e..f48bbce0f 100644 --- a/lib/WebGUI/Asset/Wobject/MessageBoard.pm +++ b/lib/WebGUI/Asset/Wobject/MessageBoard.pm @@ -12,7 +12,6 @@ package WebGUI::Asset::Wobject::MessageBoard; use strict; use Tie::IxHash; -use WebGUI::Cache; use WebGUI::Asset::Wobject; use WebGUI::International; use WebGUI::SQL; @@ -91,7 +90,7 @@ See WebGUI::Asset::purgeCache() for details. sub purgeCache { my $self = shift; - WebGUI::Cache->new($self->session,"view_".$self->getId)->delete; + eval{$self->session->cache->delete("view_".$self->getId)}; $self->SUPER::purgeCache; } @@ -105,8 +104,9 @@ See WebGUI::Asset::view() for details. sub view { my $self = shift; + my $cache = $self->session->cache; if ($self->session->user->isVisitor) { - my $out = WebGUI::Cache->new($self->session,"view_".$self->getId)->get; + my $out = eval{$cache->get("view_".$self->getId)}; return $out if $out; } my %var; @@ -171,7 +171,7 @@ sub view { my $out = $self->processTemplate(\%var,undef,$self->{_viewTemplate}); if ($self->session->user->isVisitor) { - WebGUI::Cache->new($self->session,"view_".$self->getId)->set($out,$self->get("visitorCacheTimeout")); + eval{$cache->set("view_".$self->getId, $out, $self->get("visitorCacheTimeout"))}; } return $out; } diff --git a/lib/WebGUI/Asset/Wobject/MultiSearch.pm b/lib/WebGUI/Asset/Wobject/MultiSearch.pm index 15e9a7d8c..345d35aee 100644 --- a/lib/WebGUI/Asset/Wobject/MultiSearch.pm +++ b/lib/WebGUI/Asset/Wobject/MultiSearch.pm @@ -24,7 +24,6 @@ use Tie::IxHash; use JSON; use WebGUI::International; use WebGUI::SQL; -use WebGUI::Cache; use WebGUI::Asset::Wobject; use WebGUI::Utility; @@ -114,7 +113,7 @@ See WebGUI::Asset::purgeCache() for details. sub purgeCache { my $self = shift; - WebGUI::Cache->new($self->session,"view_".$self->getId)->delete; + eval{$self->session->cache->delete("view_".$self->getId)}; $self->SUPER::purgeCache; } @@ -129,8 +128,9 @@ to be displayed within the page style sub view { my $self = shift; + my $cache = $self->session->cache; if (!$self->session->var->isAdminOn && $self->get("cacheTimeout") > 10) { - my $out = WebGUI::Cache->new($self->session,"view_".$self->getId)->get; + my $out = eval{$cache->get("view_".$self->getId)}; return $out if $out; } my $i18n = WebGUI::International->new($self->session, 'Asset_MultiSearch'); @@ -143,7 +143,7 @@ sub view { my $out = $self->processTemplate(\%var,undef,$self->{_viewTemplate}); if (!$self->session->var->isAdminOn && $self->get("cacheTimeout") > 10) { - WebGUI::Cache->new($self->session,"view_".$self->getId)->set($out,$self->get("cacheTimeout")); + eval{$cache->set("view_".$self->getId, $out, $self->get("cacheTimeout"))}; } return $out; } diff --git a/lib/WebGUI/Asset/Wobject/SQLReport.pm b/lib/WebGUI/Asset/Wobject/SQLReport.pm index 73e0528a6..89b7a01de 100644 --- a/lib/WebGUI/Asset/Wobject/SQLReport.pm +++ b/lib/WebGUI/Asset/Wobject/SQLReport.pm @@ -18,7 +18,6 @@ use WebGUI::Paginator; use WebGUI::SQL; use WebGUI::Utility; use WebGUI::Asset::Wobject; -use WebGUI::Cache; use WebGUI::Text qw(:csv); our @ISA = qw(WebGUI::Asset::Wobject); @@ -518,7 +517,7 @@ See WebGUI::Asset::purgeCache() for details. sub purgeCache { my $self = shift; - WebGUI::Cache->new($self->session,"view_".$self->getId)->delete; + eval{$self->session->cache->delete("view_".$self->getId)}; $self->SUPER::purgeCache; } @@ -533,8 +532,9 @@ if the user is not in Admin Mode. sub view { my $self = shift; + my $cache = $self->session->cache; if (!$self->session->var->isAdminOn && $self->get("cacheTimeout") > 10) { - my $out = WebGUI::Cache->new($self->session,"view_".$self->getId)->get; + my $out = eval{$cache->get("view_".$self->getId)}; return $out if $out; } # Initiate an empty debug loop @@ -560,7 +560,7 @@ sub view { my $out = $self->processTemplate($var,undef,$self->{_viewTemplate}); if (!$self->session->var->isAdminOn && $self->get("cacheTimeout") > 10) { - WebGUI::Cache->new($self->session,"view_".$self->getId)->set($out,$self->get("cacheTimeout")); + eval{$cache->set("view_".$self->getId, $out, $self->get("cacheTimeout"))}; } return $out; } diff --git a/lib/WebGUI/Asset/Wobject/Survey.pm b/lib/WebGUI/Asset/Wobject/Survey.pm index 58022db24..48294ed87 100644 --- a/lib/WebGUI/Asset/Wobject/Survey.pm +++ b/lib/WebGUI/Asset/Wobject/Survey.pm @@ -1378,7 +1378,6 @@ See WebGUI::Asset::purgeCache() for details. sub purgeCache { my $self = shift; - WebGUI::Cache->new( $self->session, 'view_' . $self->getId )->delete; return $self->SUPER::purgeCache; } diff --git a/lib/WebGUI/Asset/Wobject/SyndicatedContent.pm b/lib/WebGUI/Asset/Wobject/SyndicatedContent.pm index aaaff5316..5ccf47c86 100644 --- a/lib/WebGUI/Asset/Wobject/SyndicatedContent.pm +++ b/lib/WebGUI/Asset/Wobject/SyndicatedContent.pm @@ -13,7 +13,6 @@ package WebGUI::Asset::Wobject::SyndicatedContent; use strict; use HTML::Entities; use Tie::IxHash; -use WebGUI::Cache; use WebGUI::Exception; use WebGUI::HTML; use WebGUI::International; @@ -136,16 +135,16 @@ sub generateFeed { # build one feed out of many my $newlyCached = 0; + my $cache = $self->session->cache; foreach my $url (split(/\s+/, $self->get('rssUrl'))) { $log->info("Processing FEED: ".$url); $url =~ s/^feed:/http:/; if ($self->get('processMacroInRssUrl')) { WebGUI::Macro::process($self->session, \$url); } - my $cache = WebGUI::Cache->new($self->session, $url, "RSS"); - my $value = $cache->get; + my $value = eval{$cache->get($url)}; unless ($value) { - $value = $cache->setByHTTP($url, $self->get("cacheTimeout")); + $value = eval{$cache->setByHttp($url, $self->get("cacheTimeout"))}; $newlyCached = 1; } # if the content can be downgraded, it is either valid latin1 or didn't have @@ -328,7 +327,7 @@ See WebGUI::Asset::purgeCache() for details. sub purgeCache { my $self = shift; - WebGUI::Cache->new($self->session,"view_".$self->getId)->delete; + eval{$self->session->cache->delete("view_".$self->getId)}; $self->next::method; } @@ -345,8 +344,8 @@ sub view { my $session = $self->session; # try the cached version - my $cache = WebGUI::Cache->new($session,"view_".$self->getId); - my $out = $cache->get; + my $cache = $session->cache; + my $out = eval{$cache->get("view_".$self->getId)}; return $out if ($out ne "" && !$session->var->isAdminOn); #return $out if $out; @@ -354,7 +353,7 @@ sub view { my $feed = $self->generateFeed; $out = $self->processTemplate($self->getTemplateVariables($feed),undef,$self->{_viewTemplate}); if (!$session->var->isAdminOn && $self->get("cacheTimeout") > 10) { - $cache->set($out,$self->get("cacheTimeout")); + eval{$cache->set("view_".$self->getId, $out, $self->get("cacheTimeout"))}; } return $out; } diff --git a/lib/WebGUI/Asset/Wobject/Thingy.pm b/lib/WebGUI/Asset/Wobject/Thingy.pm index a75e09679..8cfd2cdf6 100644 --- a/lib/WebGUI/Asset/Wobject/Thingy.pm +++ b/lib/WebGUI/Asset/Wobject/Thingy.pm @@ -2662,7 +2662,7 @@ sub www_export { push(@fieldLabels,@metaDataFields) } - $query = WebGUI::Cache->new($self->session,"query_".$thingId)->get; + $query = eval{$session->cache->get("query_".$thingId)}; $sth = $session->db->read($query); ### Loop through the returned structure and put it through Text::CSV @@ -3307,7 +3307,7 @@ sequenceNumber'); } # store query in cache for thirty minutes - WebGUI::Cache->new($self->session,"query_".$thingId)->set($query,30*60); + eval{$self->session->cache->set("query_".$thingId, $query, 30*60)}; $paginatePage = $self->session->form->param('pn') || 1; $currentUrl = $self->session->url->append($currentUrl, "orderBy=".$orderBy) if $orderBy; diff --git a/lib/WebGUI/AssetLineage.pm b/lib/WebGUI/AssetLineage.pm index 659b1d9f1..cc9a1c444 100644 --- a/lib/WebGUI/AssetLineage.pm +++ b/lib/WebGUI/AssetLineage.pm @@ -147,14 +147,16 @@ sub cascadeLineage { "UPDATE asset SET lineage=CONCAT(?,SUBSTRING(lineage,?)) WHERE lineage LIKE ?", [$newLineage, length($oldLineage) + 1, $oldLineage . '%'] ); - my $cache = WebGUI::Cache->new($self->session); if ($records > 20) { - $cache->flush; + eval{$self->session->cache->flush}; } else { my $descendants = $self->session->db->read("SELECT assetId FROM asset WHERE lineage LIKE ?", [$newLineage . '%']); while (my ($assetId, $lineage) = $descendants->array) { - $cache->deleteChunk(["asset",$assetId]); + my $asset = WebGUI::Asset->newByDynamicClass($self->session, $assetId); + if (defined $asset) { + $asset->purgeCache; + } } $descendants->finish; } @@ -265,10 +267,8 @@ sub getFirstChild { my $lineage = $assetLineage->{firstChild}{$self->getId}; unless ($lineage) { ($lineage) = $self->session->db->quickArray("select min(asset.lineage) from asset,assetData where asset.parentId=? and asset.assetId=assetData.assetId and asset.state='published'",[$self->getId]); - unless ($self->session->config->get("disableCache")) { - $assetLineage->{firstChild}{$self->getId} = $lineage; - $self->session->stow->set("assetLineage", $assetLineage); - } + $assetLineage->{firstChild}{$self->getId} = $lineage; + $self->session->stow->set("assetLineage", $assetLineage); } $child = WebGUI::Asset->newByLineage($self->session,$lineage); $self->cacheChild(first => $child); diff --git a/lib/WebGUI/AssetTrash.pm b/lib/WebGUI/AssetTrash.pm index 03e2e94ee..6590bc591 100644 --- a/lib/WebGUI/AssetTrash.pm +++ b/lib/WebGUI/AssetTrash.pm @@ -191,7 +191,6 @@ sub purge { # clean up cache $outputSub->($i18n->get('Clearing cache')); - WebGUI::Cache->new($session)->deleteChunk(["asset",$self->getId]); $self->purgeCache; # delete stuff out of the asset tables diff --git a/lib/WebGUI/Cache.pm b/lib/WebGUI/Cache.pm index 05f7cfb2f..f0005864a 100644 --- a/lib/WebGUI/Cache.pm +++ b/lib/WebGUI/Cache.pm @@ -19,7 +19,17 @@ use File::Path (); use HTTP::Headers; use HTTP::Request; use LWP::UserAgent; -use Digest::MD5; +use Memcached::libmemcached; +use Storable (); +use WebGUI::Exception; +use Params::Validate qw(:all); +Params::Validate::validation_options( on_fail => sub { + my $error = shift; + warn "Error in Cache params: ".$error; + WebGUI::Error::InvalidParam->throw( error => $error ); + } ); + + =head1 NAME @@ -39,11 +49,12 @@ A base class for all Cache modules to extend. $cache->set($value); $cache->setByHTTP("http://www.google.com/"); - my $value = $cache->get; + my $value = $cache->get($name); + my ($val1, $val2) = @{$cache->mget([$name1, $name2])}; - $cache->delete; - $cache->deleteChunk("my app cache"); - $cache->deleteChunk([ "my app", $assetId ]); + $cache->delete($name); + + $cache->flush; =head1 METHODS @@ -54,14 +65,99 @@ These methods are available from this class: #------------------------------------------------------------------- -=head2 delete ( ) +=head2 delete ( name ) + +Delete a key from the cache. + +Throws WebGUI::Error::InvalidParam, WebGUI::Error::Connection and WebGUI::Error. + +=head3 name Delete a key from the cache. Must be overridden. =cut sub delete { + my $self = shift; + my $debug = $self->withDebug; + my ($name) = ($debug) ? validate_pos(@_, { type => SCALAR | ARRAYREF }) : @_; + my $key = $self->parseKey($name); + if ($debug) { + $self->session->log->debug("Called delete() on cache key $key."); + } + my $memcached = $self->getMemcached; + Memcached::libmemcached::memcached_delete($memcached, $key); + if ($debug) { + my $log = $self->session->log; + if ($memcached->errstr eq 'SYSTEM ERROR Unknown error: 0') { + $log->debug("Cannot connect to memcached server."); + WebGUI::Error::Connection->throw( + error => "Cannot connect to memcached server." + ); + } + elsif ($memcached->errstr eq 'NOT FOUND' ) { + $log->debug("The cache key $key has no value."); + WebGUI::Error::ObjectNotFound->throw( + error => "The cache key $key has no value.", + id => $key, + ); + } + elsif ($memcached->errstr eq 'NO SERVERS DEFINED') { + $log->warn("No memcached servers specified in config file."); + WebGUI::Error->throw( + error => "No memcached servers specified in config file." + ); + } + elsif ($memcached->errstr ne 'SUCCESS' # deleted + && $memcached->errstr ne 'PROTOCOL ERROR' # doesn't exist to delete + ) { + $log->debug("Couldn't delete $key from cache because ".$memcached->errstr); + WebGUI::Error->throw( + error => "Couldn't delete $key from cache because ".$memcached->errstr + ); + } + } +} +#------------------------------------------------------------------- + +=head2 flush ( ) + +Empties the caching system. + +Throws WebGUI::Error::Connection and WebGUI::Error. + +=cut + +sub flush { + my ($self) = @_; + my $debug = $self->withDebug; + if ($debug) { + $self->session->log->debug("Called flush() on cache."); + } + my $memcached = $self->getMemcached; + Memcached::libmemcached::memcached_flush($memcached); + if ($debug) { + my $log = $self->session->log; + if ($memcached->errstr eq 'SYSTEM ERROR Unknown error: 0') { + $log->debug("Cannot connect to memcached server."); + WebGUI::Error::Connection->throw( + error => "Cannot connect to memcached server." + ); + } + elsif ($memcached->errstr eq 'NO SERVERS DEFINED') { + $log->warn("No memcached servers specified in config file."); + WebGUI::Error->throw( + error => "No memcached servers specified in config file." + ); + } + elsif ($memcached->errstr ne 'SUCCESS') { + $log->debug("Couldn't flush cache because ".$memcached->errstr); + WebGUI::Error->throw( + error => "Couldn't flush cache because ".$memcached->errstr + ); + } + } } #------------------------------------------------------------------- @@ -70,15 +166,62 @@ sub delete { Deletes a bunch of keys from the cache based upon a partial composite key. Unless overridden by the cache subclass this will just flush the whole cache. -=head3 key +Throws WebGUI::Error::InvalidObject, WebGUI::Error::InvalidParam, WebGUI::Error::ObjectNotFound, WebGUI::Error::Connection and WebGUI::Error. + +=head3 name An array reference representing the portion of the key to delete. So if you have a key like ["asset","abc","def"] and you want to delete all items that match abc, you'd specify ["asset","abc"]. =cut -sub deleteChunk { - my $self = shift; - $self->flush; +sub get { + my $self = shift; + my $debug = $self->withDebug; + my ($name) = ($debug) ? validate_pos(@_, { type => SCALAR | ARRAYREF }) : @_; + my $key = $self->parseKey($name); + if ($debug) { + $self->session->log->debug("Called get() on cache key $key."); + } + my $memcached = $self->getMemcached; + my $content = Memcached::libmemcached::memcached_get($memcached, $key); + $content = Storable::thaw($content); + if ($debug) { + my $log = $self->session->log; + if ($memcached->errstr eq 'SUCCESS') { + unless (ref $content) { + $log->debug("Couldn't thaw value for $key."); + WebGUI::Error::InvalidObject->throw( + error => "Couldn't thaw value for $key." + ); + } + return ${$content}; + } + elsif ($memcached->errstr eq 'NOT FOUND' ) { + $log->debug("The cache key $key has no value."); + WebGUI::Error::ObjectNotFound->throw( + error => "The cache key $key has no value.", + id => $key, + ); + } + elsif ($memcached->errstr eq 'NO SERVERS DEFINED') { + $log->warn("No memcached servers specified in config file."); + WebGUI::Error->throw( + error => "No memcached servers specified in config file." + ); + } + elsif ($memcached->errstr eq 'SYSTEM ERROR Unknown error: 0') { + $log->debug("Cannot connect to memcached server."); + WebGUI::Error::Connection->throw( + error => "Cannot connect to memcached server." + ); + } + $log->debug("Couldn't get $key from cache because ".$memcached->errstr); + WebGUI::Error->throw( + error => "Couldn't get $key from cache because ".$memcached->errstr + ); + return undef; + } + return (ref $content) ? ${$content} : undef; } #------------------------------------------------------------------- @@ -96,49 +239,99 @@ sub flush { #------------------------------------------------------------------- -=head2 get ( ) +=head2 mget ( names ) + +Retrieves multiple values from cache at once, which is much faster than retrieving one at a time. Returns an array reference containing the values in the order they were requested. + +Throws WebGUI::Error::InvalidParam, WebGUI::Error::Connection and WebGUI::Error. + +=head3 names Retrieves a key value from the cache. Must be overridden. =cut -sub get { - +sub mget { + my $self = shift; + my $debug = $self->withDebug; + my ($names) = ($debug) ? validate_pos(@_, { type => ARRAYREF }) : @_; + my @keys = map { $self->parseKey($_) } @{ $names }; + my $log = $self->session->log; + if ($debug) { + $log->debug("Called mget() for keys (".join(", ",@keys).") on cache."); + } + my %result; + my $memcached = $self->getMemcached; + $memcached->mget_into_hashref(\@keys, \%result); + if ($debug) { + if ($memcached->errstr eq 'SYSTEM ERROR Unknown error: 0') { + $log->debug("Cannot connect to memcached server."); + WebGUI::Error::Connection->throw( + error => "Cannot connect to memcached server." + ); + } + elsif ($memcached->errstr eq 'NO SERVERS DEFINED') { + $log->warn("No memcached servers specified in config file."); + WebGUI::Error->throw( + error => "No memcached servers specified in config file." + ); + } + } + # no other useful status messages are returned + my @values; + foreach my $key (@keys) { + my $content = Storable::thaw($result{$key}); + unless (ref $content) { + $log->debug("Cannot thaw key $key.") if ($debug); + next; + } + push @values, ${$content}; + } + return \@values; } #------------------------------------------------------------------- -=head2 new ( session, key, [ namespace ] ) +=head2 new ( session, withDebug ) -The new method will return a handler for the configured caching mechanism. Defaults to WebGUI::Cache::FileCache. You must override this method when building your own cache plug-in. +Constructor. Will return a handler for the configured caching mechanism. Defaults to WebGUI::Cache::FileCache. You must override this method when building your own cache plug-in. + +Throws WebGUI::Error::InvalidParam. =head3 session A reference to the current session. -=head3 key +=head3 withDebug -A key to store the value under or retrieve it from. Can either be a scalar or an array reference of pieces (called -a composite key). Composite keys are useful for deleting a chunk (see deleteChunk()) of cache data all at once, and -for using multi-level identifiers like assetId/revisionDate. - -=head3 namespace - -A subdivider to store this cache under. When building your own cache plug-in default this to the WebGUI config file. +A boolean indicating you want to enable parameter validation, exception handling, and debug logging. Note that this will make the cahe system up to 3 times slower. It will still be very fast, but not production fast. =cut sub new { - my $class = shift; - my $session = shift; - if ($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,@_); - } + my ($class, $session, $withDebug) = validate_pos(@_, + 1, + { isa => 'WebGUI::Session' }, + { type => SCALAR | UNDEF, optional=>1, default=>0 }, + ); + if ($withDebug) { + my $log = $session->log; + $log->debug("Instanciated cache object."); + $log->debug("Cache debugging ".($withDebug ? "enabled" : "disabled")."."); + } + my $config = $session->config; + my $namespace = $config->getFilename; + my $memcached = Memcached::libmemcached::memcached_create(); # no exception because always returns success + foreach my $server (@{$config->get('cacheServers')}) { + if (exists $server->{socket}) { + Memcached::libmemcached::memcached_server_add_unix_socket($memcached, $server->{socket}); # no exception because always returns success + } + else { + Memcached::libmemcached::memcached_server_add($memcached, $server->{host}, $server->{port}); # no exception because always returns success + } + } + bless {_memcached => $memcached, _namespace => $namespace, _session => $session, _withDebug=>$withDebug}, $class; } #------------------------------------------------------------------- @@ -147,24 +340,27 @@ sub new { Returns a formatted string version of the key. A class method. -=head3 key +Throws WebGUI::Error::InvalidParam. + +=head3 name Can either be a text key, or a composite key. If it's a composite key, it will be an array reference of strings that can be joined together to create a key. You might want to use a composite key in order to be able to delete large portions of cache all at once. For instance, if you have a key of ["asset","abc","def"] you can delete all cache matching ["asset","abc"]. =cut sub parseKey { - my $class = shift; + my $self = shift; + my ($name) = ($self->withDebug) ? validate_pos(@_, { type => SCALAR | ARRAYREF }) : @_; + + # prepend namespace to the key + my @key = ($self->{_namespace}); + # check for composite or simple key, make array from either - my @key; - if (! $_[0]) { - return; - } - elsif (ref $_[0] eq 'ARRAY') { - @key = @{ +shift }; + if (ref $name eq 'ARRAY') { + push @key, @{ $name }; } else { - @key = shift; + push @key, $name; } foreach my $part (@key) { # convert to octets, then md5 them @@ -191,7 +387,11 @@ sub session { =head2 set ( value [, ttl] ) -Sets a key value to the cache. Must be overridden. +Throws WebGUI::Error::InvalidParam, WebGUI::Error::Connection, and WebGUI::Error. + +=head3 name + +The name of the key to set. =head3 value @@ -204,19 +404,54 @@ A time in seconds for the cache to exist. When you override default it to 60 sec =cut sub set { - + my $self = shift; + my $debug = $self->withDebug; + my ($name, $value, $ttl) = ($debug) ? validate_pos(@_, { type => SCALAR | ARRAYREF }, { type => SCALAR | ARRAYREF | HASHREF }, { type => SCALAR | UNDEF, optional => 1 }) : @_; + $ttl ||= 60; + my $key = $self->parseKey($name); + if ($debug) { + $self->session->log->debug("Called set() on cache key $key with $value as the value."); + } + my $frozenValue = Storable::nfreeze(\(scalar $value)); # Storable doesn't like non-reference arguments, so we wrap it in a scalar ref. + my $memcached = $self->getMemcached; + Memcached::libmemcached::memcached_set($memcached, $key, $frozenValue, $ttl); + if ($debug) { + my $log = $self->session->log; + if ($memcached->errstr eq 'SUCCESS') { + return $value; + } + elsif ($memcached->errstr eq 'SYSTEM ERROR Unknown error: 0') { + $log->debug("Cannot connect to memcached server."); + WebGUI::Error::Connection->throw( + error => "Cannot connect to memcached server." + ); + } + elsif ($memcached->errstr eq 'NO SERVERS DEFINED') { + $log->warn("No memcached servers specified in config file."); + WebGUI::Error->throw( + error => "No memcached servers specified in config file." + ); + } + $log->debug("Couldn't set $key to cache because ".$memcached->errstr); + WebGUI::Error->throw( + error => "Couldn't set $key to cache because ".$memcached->errstr + ); + } + return $value; } #------------------------------------------------------------------- -=head2 setByHTTP ( url [, ttl ] ) +=head2 setByHttp ( url [, ttl ] ) Retrieves a document via HTTP and stores it in the cache and returns the content as a string. No need to override. +Throws WebGUI::Error::InvalidParam, WebGUI::Error::Connection, and WebGUI::Error. + =head3 url -The URL of the document to retrieve. It must begin with the standard "http://". +The URL of the document to retrieve. It must begin with the standard "http://". This will be used as the key for this cache entry. =head3 ttl @@ -224,11 +459,14 @@ The time to live for this content. This is the amount of time (in seconds) that =cut -sub setByHTTP { - my $self = shift; - my $url = shift; - my $ttl = shift; - my $userAgent = new LWP::UserAgent; +sub setByHttp { + my $self = shift; + my $debug = $self->withDebug; + my ($url, $ttl) = ($debug) ? validate_pos(@_, { type => SCALAR }, { type => SCALAR, optional => 1 }) : @_; + if ($debug) { + $self->session->log->debug("Called setByHttp() with URL $url."); + } + my $userAgent = new LWP::UserAgent; $userAgent->env_proxy; $userAgent->agent("WebGUI/".$WebGUI::VERSION); $userAgent->timeout(30); @@ -239,27 +477,71 @@ sub setByHTTP { my $request = HTTP::Request->new(GET => $url, $header); my $response = $userAgent->request($request); if ($response->is_error) { - $self->session->errorHandler->error($url." could not be retrieved."); + $self->session->log->error("$url could not be retrieved."); + if ($debug) { + WebGUI::Error::Connection->throw( + error => "Couldn't fetch $url because ".$response->message, + resource => $url, + ); + } } - else { - $self->set($response->decoded_content,$ttl); - } - return $response->decoded_content; + return $self->set($url, $response->decoded_content, $ttl); } + #------------------------------------------------------------------- -=head2 stats ( ) +=head2 withDebug () -Return a formatted text string describing cache usage. Must be overridden. +Returns a boolean indicating whether the cache system should log debug, validate parameters, and throw exceptions. =cut -sub stats { - +sub withDebug { + my $self = shift; + return $self->{_withDebug}; } + +=head1 EXCEPTIONS + +This class throws a lot of inconvenient exceptions. However, because cache should be treated as optional, none of them matter except for testing, debugging, or in very specific use cases. Therefore the best practice is to simply call each method with an eval wrapper, and then not even bother testing for specific exceptions like this: + + my $value = eval { $session->cache->get($key) }; + unless (defined $value) { + $value = $db->fetchValueFromTheDatabase; + } + +If you want to see what exceptions are being thrown, or anything else about the internal operations of the cache system, simply turn on DEBUG mode in your log. Everything you want will be there. + +NOTE: In order for exceptions to be thrown and logged with debug must be passed into the constructor. + +The exceptions that can be thrown are: + +=head2 WebGUI::Error + +When an uknown exception happens, or there are no configured memcahed servers in the cacheServers directive in your config file. + +=head2 WebGUI::Error::Connection + +When it can't connect to the memcached servers that are configured, or to the http server in the case of the setByHttp method. + +=head2 WebGUI::Error::InvalidParam + +When you pass in the wrong arguments. + +=head2 WebGUI::Error::ObjectNotFound + +When you request a cache key that doesn't exist on any configured memcached server. + +=head2 WebGUI::Error::InvalidObject + +When an object can't be thawed from cache due to corruption of some sort. + +=cut + + 1; diff --git a/lib/WebGUI/Exception.pm b/lib/WebGUI/Exception.pm index 3d4ac9872..634356477 100644 --- a/lib/WebGUI/Exception.pm +++ b/lib/WebGUI/Exception.pm @@ -15,51 +15,6 @@ package WebGUI::Exception; =cut use strict; -use Exception::Class ( - - 'WebGUI::Error' => { - description => "A general error occured.", - }, - 'WebGUI::Error::OverrideMe' => { - isa => 'WebGUI::Error', - description => 'This method should be overridden by subclasses.', - }, - 'WebGUI::Error::MethodNotFound' => { - isa => 'WebGUI::Error', - description => q|Called a method that doesn't exist.|, - fields => 'method' - }, - 'WebGUI::Error::InvalidObject' => { - isa => 'WebGUI::Error::InvalidParam', - description => "Expected to get a reference to an object type that wasn't gotten.", - fields => ["expected","got"], - }, - 'WebGUI::Error::InvalidParam' => { - isa => 'WebGUI::Error', - description => "Expected to get a param we didn't get.", - fields => ["param"], - }, - 'WebGUI::Error::ObjectNotFound' => { - isa => 'WebGUI::Error', - description => "The object you were trying to retrieve does not exist.", - fields => ["id"], - }, - 'WebGUI::Error::ObjectNotFound::Template' => { - isa => 'WebGUI::Error', - description => "The template an asset was trying to retrieve does not exist.", - fields => [qw/templateId assetId/], - }, - 'WebGUI::Error::InvalidFile' => { - isa => 'WebGUI::Error', - description => "The file you have provided has errors.", - fields => [qw{ brokenFile brokenLine }], - }, - 'WebGUI::Error::Template' => { - isa => 'WebGUI::Error', - description => "A template has errors that prevent it from being processed.", - }, -); - =head1 NAME @@ -94,6 +49,9 @@ B: Though the package name is WebGUI::Exception, the handler objects that These exception classes are defined in this class: +=cut + +#------------------------------------------------------------------- =head2 WebGUI::Error @@ -123,6 +81,30 @@ A read only exception method that returns the line number where the exception wa A read only exception method that returns the package name where the exception was thrown. +=cut + +#------------------------------------------------------------------- + +=head2 WebGUI::Error::OverrideMe + +An interface was not overriden as expected. + +=cut + +#------------------------------------------------------------------- + +=head2 WebGUI::Error::MethodNotFound + +Tried calling a method that doesn't exist. + +=head3 method + +The method called. + +=cut + +#------------------------------------------------------------------- + =head2 WebGUI::Error::InvalidObject Used when looking to make sure objects are passed in that you expect. ISA WebGUI::Error::InvalidParam. @@ -135,6 +117,10 @@ The type of object expected ("HASH", "ARRAY", "WebGUI::User", etc). The object type we got. +=cut + +#------------------------------------------------------------------- + =head2 WebGUI::Error::InvalidParam Used when an invalid parameter is passed into a subroutine. @@ -143,6 +129,10 @@ Used when an invalid parameter is passed into a subroutine. Used to return the bad parameter, if present. +=cut + +#------------------------------------------------------------------- + =head2 WebGUI::Error::ObjectNotFound Used when an object is trying to be retrieved, but does not exist. ISA WebGUI::Error. @@ -151,20 +141,132 @@ Used when an object is trying to be retrieved, but does not exist. ISA WebGUI::E The id of the object to be retrieved. -=head2 WebGUI::Error::MethodNotFound +=cut -Tried calling a method that doesn't exist. +#------------------------------------------------------------------- -=head3 method +=head2 WebGUI::Error::ObjectNotFound::Template -The method called. +Used when a template is trying to be retrieved, but does not exist. ISA WebGUI::Error::ObjectNotFound. -=head2 WebGUI::Error::OverrideMe +=head3 templateId | id | assetId -An interface was not overriden as expected. +The id of the object to be retrieved. =cut +#------------------------------------------------------------------- + +=head2 WebGUI::Error::InvalidFile + +Used when accessing a file and there are formatting or data problems found in the file. ISA WebGUI::Error. + +=head3 brokenFile + +The filename. + +=head3 brokenLine + +The line the error was found on. + +=cut + +#------------------------------------------------------------------- + +=head2 WebGUI::Error::Template + +Used when a template has parsing errors. ISA WebGUI::Error. + +=cut + +#------------------------------------------------------------------- + +=head2 WebGUI::Error::Connection + +Used when connecting to an external resource and it fails for some reason. ISA WebGUI::Error. + +=head3 resource + +The name or configuration or URL of the resource trying to be accessed. + +=cut + +use Exception::Class ( + + 'WebGUI::Error' => { + description => "A general error occured.", + }, + + + 'WebGUI::Error::OverrideMe' => { + isa => 'WebGUI::Error', + description => 'This method should be overridden by subclasses.', + }, + + + 'WebGUI::Error::MethodNotFound' => { + isa => 'WebGUI::Error', + description => q|Called a method that doesn't exist.|, + fields => 'method' + }, + + + 'WebGUI::Error::InvalidObject' => { + isa => 'WebGUI::Error::InvalidParam', + description => "Expected to get a reference to an object type that wasn't gotten.", + fields => ["expected","got"], + }, + + + 'WebGUI::Error::InvalidParam' => { + isa => 'WebGUI::Error', + description => "Expected to get a param we didn't get.", + fields => ["param"], + }, + + + 'WebGUI::Error::ObjectNotFound' => { + isa => 'WebGUI::Error', + description => "The object you were trying to retrieve does not exist.", + fields => ["id"], + }, + + + 'WebGUI::Error::ObjectNotFound::Template' => { + isa => 'WebGUI::Error', + description => "The template an asset was trying to retrieve does not exist.", + fields => [qw/templateId assetId/], + }, + + + 'WebGUI::Error::InvalidFile' => { + isa => 'WebGUI::Error', + description => "The file you have provided has errors.", + fields => [qw{ brokenFile brokenLine }], + }, + + + 'WebGUI::Error::Template' => { + isa => 'WebGUI::Error', + description => "A template has errors that prevent it from being processed.", + }, + + + 'WebGUI::Error::Connection' => { + isa => 'WebGUI::Error', + description => "Couldn't establish a connection.", + fields => [qw{ resource }], + }, + +); + + + + + + + + 1; diff --git a/lib/WebGUI/Group.pm b/lib/WebGUI/Group.pm index c7b594861..8e1542be8 100644 --- a/lib/WebGUI/Group.pm +++ b/lib/WebGUI/Group.pm @@ -127,7 +127,7 @@ not be added to any group. Groups may not be added to themselves. sub addGroups { my $self = shift; my $groups = shift; - WebGUI::Cache->new($self->session, $self->getId)->delete; + eval{$self->session->cache->delete($self->getId)}; GROUP: foreach my $gid (@{$groups}) { next if ($gid eq '1'); next if ($gid eq $self->getId); @@ -232,12 +232,14 @@ sub clearCaches { my $self = shift; ##Clear my cache and the cache of all groups above me. my $groups = $self->getAllGroupsFor(); + my $cache = $self->session->cache; foreach my $group ( $self->getId, @{ $groups } ) { - WebGUI::Cache->new($self->session, $group)->delete; + eval{$cache->delete($group)}; } - $self->session->stow->delete("groupObj"); - $self->session->stow->delete("isInGroup"); - $self->session->stow->delete("gotGroupsInGroup"); + my $stow = $self->session->stow; + $stow->delete("groupObj"); + $stow->delete("isInGroup"); + $stow->delete("gotGroupsInGroup"); } #------------------------------------------------------------------- @@ -560,8 +562,8 @@ sub getAllUsers { my $withoutExpired = shift; my $loopCount = shift; my $expireTime = 0; - my $cache = WebGUI::Cache->new($self->session, $self->getId); - my $value = $cache->get; + my $cache = $self->session->cache; + my $value = eval{$cache->get($self->getId)}; return $value if defined $value; my @users = (); push @users, @@ -586,7 +588,7 @@ sub getAllUsers { } my %users = map { $_ => 1 } @users; @users = keys %users; - $cache->set(\@users, $self->groupCacheTimeout); + eval{$cache->set($self->getId, \@users, $self->groupCacheTimeout)}; return \@users; } diff --git a/lib/WebGUI/Operation/Cache.pm b/lib/WebGUI/Operation/Cache.pm index 042a83993..6715b894c 100644 --- a/lib/WebGUI/Operation/Cache.pm +++ b/lib/WebGUI/Operation/Cache.pm @@ -12,7 +12,6 @@ package WebGUI::Operation::Cache; use strict; use WebGUI::AdminConsole; -use WebGUI::Cache; use WebGUI::International; use WebGUI::Form; @@ -93,7 +92,7 @@ sub www_flushCache { return $session->privilege->adminOnly unless canView($session); # Flush the cache - WebGUI::Cache->new($session)->flush; + eval{$session->cache->flush}; return www_manageCache($session); } @@ -110,20 +109,15 @@ provides an option to clear the cache. sub www_manageCache { my $session = shift; return $session->privilege->adminOnly unless canView($session); - my $cache = WebGUI::Cache->new($session); my $flushURL = $session->url->page('op=flushCache'); my $i18n = WebGUI::International->new($session); - my $output - = '' - . '' - . '' - . '' - . '
'.$i18n->get('cache type').':'.ref($cache).'
'.$i18n->get('cache statistics').':
'.$cache->stats.'
 ' - . WebGUI::Form::button($session, { + my $output = + WebGUI::Form::formHeader($session) + .WebGUI::Form::button($session, { value => $i18n->get("clear cache"), extras => qq{onclick="document.location.href='$flushURL';"}, }) - . '
' + .WebGUI::Form::formFooter($session) ; return _submenu($session,$output); diff --git a/lib/WebGUI/Operation/Settings.pm b/lib/WebGUI/Operation/Settings.pm index dbbb2e9ff..33293730e 100644 --- a/lib/WebGUI/Operation/Settings.pm +++ b/lib/WebGUI/Operation/Settings.pm @@ -726,8 +726,7 @@ sub www_saveSettings { $session->db->write( "UPDATE userProfileData SET showMessageOnLoginSeen=0" ); - # Delete the user cache - WebGUI::Cache->new( $session, [ "user" ] )->deleteChunk( [ "user" ] ); + eval{$session->cache->flush}; } return www_editSettings($session, { errors => \@errors, message => $i18n->get("editSettings done") }); diff --git a/lib/WebGUI/Operation/Statistics.pm b/lib/WebGUI/Operation/Statistics.pm index fe2713536..38c28cc1b 100644 --- a/lib/WebGUI/Operation/Statistics.pm +++ b/lib/WebGUI/Operation/Statistics.pm @@ -12,7 +12,6 @@ package WebGUI::Operation::Statistics; use strict; use WebGUI::AdminConsole; -use WebGUI::Cache; use WebGUI::International; use WebGUI::Workflow::Cron; use WebGUI::DateTime; @@ -180,10 +179,10 @@ sub www_viewStatistics { my ($output, $data); my $i18n = WebGUI::International->new($session); my $url = "http://update.webgui.org/latest-version.txt"; - my $cache = WebGUI::Cache->new($session,$url,"URL"); - my $version = $cache->get; + my $cache = $session->cache; + my $version = eval{$cache->get($url)}; if (not defined $version) { - $version = $cache->setByHTTP($url,43200); + $version = eval{$cache->setByHttp($url, 43200)}; } chomp $version; $output .= ''; diff --git a/lib/WebGUI/Session.pm b/lib/WebGUI/Session.pm index 1ffcd69a5..3b5063a3f 100644 --- a/lib/WebGUI/Session.pm +++ b/lib/WebGUI/Session.pm @@ -15,6 +15,7 @@ package WebGUI::Session; =cut use strict; +use WebGUI::Cache; use WebGUI::Config; use WebGUI::SQL; use WebGUI::User; @@ -109,6 +110,28 @@ sub asset { #------------------------------------------------------------------- +=head2 cache ( ) + +Returns a WebGUI::Cache object, which is connected to the WebGUI memcached server. + +=cut + +sub cache { + my $self = shift; + unless (exists $self->{_cache}) { + my $cache = WebGUI::Cache->new($self); + if (defined $cache) { + $self->{_cache} = $cache; + } + else { + $self->log->fatal("Couldn't connect to WebGUI memcached server, and can't continue without it."); + } + } + return $self->{_cache}; +} + +#------------------------------------------------------------------- + =head2 close Cleans up a WebGUI session information from memory and disconnects from any resources opened by the session. @@ -121,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}; } } @@ -445,7 +468,6 @@ sub open { $sessionId = $self->id->generate unless $self->id->valid($sessionId); my $noFuss = shift; $self->{_var} = WebGUI::Session::Var->new($self,$sessionId, $noFuss); - $self->errorHandler->warn("You've disabled cache in your config file and that can cause many problems on a production site.") if ($config->get("disableCache")); return $self; } diff --git a/lib/WebGUI/Session/Scratch.pm b/lib/WebGUI/Session/Scratch.pm index fb6add7d3..c7343a708 100644 --- a/lib/WebGUI/Session/Scratch.pm +++ b/lib/WebGUI/Session/Scratch.pm @@ -62,7 +62,10 @@ sub delete { my $name = shift; return undef unless ($name); my $value = delete $self->{_data}{$name}; - $self->session->db->write("delete from userSessionScratch where name=? and sessionId=?", [$name, $self->session->getId]); + my $session = $self->session; + my $id = $session->getId; + eval{$session->cache->set(["sessionscratch",$id], $self->{_data}, $session->setting->get('sessionTimeout'))}; + $session->db->write("delete from userSessionScratch where name=? and sessionId=?", [$name, $id]); return $value; } @@ -78,7 +81,10 @@ Deletes all scratch variables for this session. sub deleteAll { my $self = shift; delete $self->{_data}; - $self->session->db->write("delete from userSessionScratch where sessionId=?", [$self->session->getId]); + my $session = $self->session; + my $id = $session->getId; + eval{$session->cache->delete(["sessionscratch",$id])}; + $session->db->write("delete from userSessionScratch where sessionId=?", [$id]); } @@ -99,7 +105,9 @@ sub deleteName { my $name = shift; return undef unless ($name); delete $self->{_data}{$name}; - $self->session->db->write("delete from userSessionScratch where name=?", [$name]); + my $session = $self->session; + eval{$session->cache->flush}; + $session->db->write("delete from userSessionScratch where name=?", [$name]); } #------------------------------------------------------------------- @@ -124,7 +132,9 @@ sub deleteNameByValue { my $value = shift; return undef unless ($name and defined $value); delete $self->{_data}{$name} if ($self->{_data}{$name} eq $value); - $self->session->db->write("delete from userSessionScratch where name=? and value=?", [$name,$value]); + my $session = $self->session; + eval{$session->cache->flush}; + $session->db->write("delete from userSessionScratch where name=? and value=?", [$name,$value]); } @@ -155,8 +165,7 @@ The name of the variable. =cut sub get { - my $self = shift; - my $var = shift; + my ($self, $var) = @_; return $self->{_data}{$var}; } @@ -174,10 +183,12 @@ The current session. =cut sub new { - my $class = shift; - my $session = shift; - my $data = $session->db->buildHashRef("select name,value from userSessionScratch where sessionId=?",[$session->getId], {noOrder => 1}); - bless {_session=>$session, _data=>$data}, $class; + my ($class, $session) = @_; + my $scratch = eval{$session->cache->get(["sessionscratch",$session->getId])}; + unless (ref $scratch eq "HASH") { + $scratch = $session->db->buildHashRef("select name,value from userSessionScratch where sessionId=?",[$session->getId], {noOrder => 1}); + } + bless {_session=>$session, _data=>$scratch}, $class; } @@ -212,12 +223,13 @@ The value of the scratch variable. Must be a string no longer than 16000 charac =cut sub set { - my $self = shift; - my $name = shift; - my $value = shift; + my ($self, $name, $value) = @_; return undef unless ($name); $self->{_data}{$name} = $value; - $self->session->db->write("insert into userSessionScratch (sessionId, name, value) values (?,?,?) on duplicate key update value=VALUES(value)", [$self->session->getId, $name, $value]); + my $session = $self->session; + my $id = $session->getId; + eval{$session->cache->set(["sessionscratch",$id], $self->{_data}, $session->setting->get('sessionTimeout'))}; + $session->db->write("replace into userSessionScratch (sessionId, name, value) values (?,?,?)", [$id, $name, $value]); } diff --git a/lib/WebGUI/Session/Stow.pm b/lib/WebGUI/Session/Stow.pm index 5345b07cf..181517cad 100644 --- a/lib/WebGUI/Session/Stow.pm +++ b/lib/WebGUI/Session/Stow.pm @@ -118,7 +118,6 @@ sub get { my $self = shift; my $var = shift; my $opt = shift || {}; - return undef if $self->session->config->get("disableCache"); my $value = $self->{_data}{$var}; return undef unless defined $value; my $ref = ref $value; @@ -190,8 +189,6 @@ The value of the stow variable. Any scalar or reference. sub set { my $self = shift; - $self->session->errorHandler->debug('Stow->set() is being called but cache has been disabled') - if $self->session->config->get("disableCache"); my $name = shift; my $value = shift; return undef unless ($name); diff --git a/lib/WebGUI/Session/Var.pm b/lib/WebGUI/Session/Var.pm index d472c0cab..7cae0609d 100644 --- a/lib/WebGUI/Session/Var.pm +++ b/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"); + eval{$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}); } diff --git a/lib/WebGUI/User.pm b/lib/WebGUI/User.pm index 0008a94ce..a849befa8 100644 --- a/lib/WebGUI/User.pm +++ b/lib/WebGUI/User.pm @@ -15,7 +15,6 @@ package WebGUI::User; =cut use strict; -use WebGUI::Cache; use WebGUI::Group; use WebGUI::DatabaseLink; use WebGUI::Exception; @@ -282,13 +281,12 @@ Saves the user object into the cache. sub cache { my $self = shift; - my $cache = WebGUI::Cache->new($self->session,["user",$self->userId]); # copy user object my %userData; for my $k (qw(_userId _user _profile)) { $userData{$k} = $self->{$k}; } - $cache->set(\%userData, 60*60*24); + eval{$self->session->cache->set(["user",$self->userId], \%userData, 60*60*24)}; } #------------------------------------------------------------------- @@ -1062,8 +1060,7 @@ sub new { my $userId = shift || 1; my $overrideId = shift; $userId = _create($session, $overrideId) if ($userId eq "new"); - my $cache = WebGUI::Cache->new($session,["user",$userId]); - my $self = $cache->get || {}; + my $self = eval{$session->cache->get(["user",$userId])} || {}; bless $self, $class; $self->{_session} = $session; unless ($self->{_userId} && $self->{_user}{username}) { @@ -1337,8 +1334,7 @@ Deletes this user object out of the cache. sub uncache { my $self = shift; - my $cache = WebGUI::Cache->new($self->session,["user",$self->userId]); - $cache->delete; + eval{$self->session->cache->delete(["user",$self->userId])}; } #---------------------------------------------------------------------------- diff --git a/lib/WebGUI/Workflow/Activity/CleanDatabaseCache.pm b/lib/WebGUI/Workflow/Activity/CleanDatabaseCache.pm deleted file mode 100644 index bd7a241a4..000000000 --- a/lib/WebGUI/Workflow/Activity/CleanDatabaseCache.pm +++ /dev/null @@ -1,94 +0,0 @@ -package WebGUI::Workflow::Activity::CleanDatabaseCache; - - -=head1 LEGAL - - ------------------------------------------------------------------- - WebGUI is Copyright 2001-2009 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::Workflow::Activity'; -use WebGUI::Cache::Database; - -=head1 NAME - -Package WebGUI::Workflow::Activity::CleanDatabaseCache - -=head1 DESCRIPTION - -This activity deletes entries from the database cache if the cache size has gotten too big. - -=head1 SYNOPSIS - -See WebGUI::Workflow::Activity for details on how to use any activity. - -=head1 METHODS - -These methods are available from this class: - -=cut - - -#------------------------------------------------------------------- - -=head2 definition ( session, definition ) - -See WebGUI::Workflow::Activity::definition() for details. - -=cut - -sub definition { - my $class = shift; - my $session = shift; - my $definition = shift; - my $i18n = WebGUI::International->new($session, "Workflow_Activity_CleanDatabaseCache"); - push(@{$definition}, { - name=>$i18n->get("activityName"), - properties=> { - sizeLimit => { - fieldType=>"integer", - label=>$i18n->get("size limit"), - subtext=>$i18n->get("bytes"), - defaultValue=>100000000, - hoverHelp=>$i18n->get("size limit help") - } - } - }); - return $class->SUPER::definition($session,$definition); -} - - -#------------------------------------------------------------------- - -=head2 execute ( ) - -See WebGUI::Workflow::Activity::execute() for details. - -=cut - -sub execute { - my $self = shift; - my $size = $self->get("sizeLimit") + 10; - my $expiresModifier = 0; - my $cache = WebGUI::Cache::Database->new($self->session); - while ($size > $self->get("sizeLimit")) { - $size = $cache->getNamespaceSize($expiresModifier); - $expiresModifier += 60 * 30; # add 30 minutes each pass - } - return $self->COMPLETE; -} - - - -1; - - diff --git a/lib/WebGUI/Workflow/Activity/CleanFileCache.pm b/lib/WebGUI/Workflow/Activity/CleanFileCache.pm deleted file mode 100644 index c37cfcf0f..000000000 --- a/lib/WebGUI/Workflow/Activity/CleanFileCache.pm +++ /dev/null @@ -1,107 +0,0 @@ -package WebGUI::Workflow::Activity::CleanFileCache; - - -=head1 LEGAL - - ------------------------------------------------------------------- - WebGUI is Copyright 2001-2009 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::Workflow::Activity'; -use WebGUI::Cache::FileCache; - -=head1 NAME - -Package WebGUI::Workflow::Activity::CleanFileCache - -=head1 DESCRIPTION - -This activity deletes files from the file cache if the file cache has gotten too big. - -=head1 SYNOPSIS - -See WebGUI::Workflow::Activity for details on how to use any activity. - -=head1 METHODS - -These methods are available from this class: - -=cut - - -#------------------------------------------------------------------- - -=head2 definition ( session, definition ) - -See WebGUI::Workflow::Activity::definition() for details. - -=cut - -sub definition { - my $class = shift; - my $session = shift; - my $definition = shift; - my $i18n = WebGUI::International->new($session, "Workflow_Activity_CleanFileCache"); - push(@{$definition}, { - name=>$i18n->get("activityName"), - properties=> { - sizeLimit => { - fieldType=>"integer", - label=>$i18n->get("size limit"), - subtext=>$i18n->get("bytes"), - defaultValue=>100000000, - hoverHelp=>$i18n->get("size limit help") - } - } - }); - return $class->SUPER::definition($session,$definition); -} - - -#------------------------------------------------------------------- - -=head2 execute ( ) - -See WebGUI::Workflow::Activity::execute() for details. - -=cut - -sub execute { - my $self = shift; - my $size = $self->get("sizeLimit") + 10; - my $expiresModifier = 0; - - # Purge expired content cache - my $cache = WebGUI::Cache::FileCache->new($self->session); - while ($size > $self->get("sizeLimit")) { - $size = $cache->getNamespaceSize($expiresModifier); - $expiresModifier += 60 * 30; # add 30 minutes each pass - } - - $size = $self->get("sizeLimit") + 10; - $expiresModifier = 0; - - # Purge expired rss cache - my $rssCache = WebGUI::Cache::FileCache->new($self->session, undef, 'RSS'); - while ($size > $self->get("sizeLimit")) { - $size = $rssCache->getNamespaceSize($expiresModifier); - $expiresModifier += 60 * 30; # add 30 minutes each pass - } - - return $self->COMPLETE; -} - - - -1; - - diff --git a/lib/WebGUI/i18n/English/WebGUI.pm b/lib/WebGUI/i18n/English/WebGUI.pm index b53e6ce3d..f8947e664 100644 --- a/lib/WebGUI/i18n/English/WebGUI.pm +++ b/lib/WebGUI/i18n/English/WebGUI.pm @@ -3463,14 +3463,6 @@ a user.|, message => q|Cache|, lastUpdated => 1031514049 }, - 'cache type' => { - message => q|Cache type|, - lastUpdated => 1031514049 - }, - 'cache statistics' => { - message => q|Cache Statistics|, - lastUpdated => 1031514049 - }, 'clear cache' => { message => q|Clear Cache|, lastUpdated => 1031514049 diff --git a/sbin/preload.exclude.example b/sbin/preload.exclude.example index 9b2667aeb..c7fa1cc35 100644 --- a/sbin/preload.exclude.example +++ b/sbin/preload.exclude.example @@ -2,7 +2,6 @@ # that you don't want to be loaded by modperl. This will decrease the overall # size of your modperl instances, which will increase performance, and reduce # memory use. -WebGUI::Cache::Database WebGUI::Auth::LDAP WebGUI::Asset::Wobject::WSClient WebGUI::Asset::File::ZipArchive diff --git a/sbin/testEnvironment.pl b/sbin/testEnvironment.pl index 90d0aa07a..8e581afa8 100755 --- a/sbin/testEnvironment.pl +++ b/sbin/testEnvironment.pl @@ -133,6 +133,7 @@ checkModule('Digest::SHA', '5.47' ); checkModule("CSS::Minifier::XS", "0.03" ); checkModule("JavaScript::Minifier::XS", "0.05" ); checkModule("Readonly", "1.03" ); +checkModule("Memcached::libmemcached", "0.3102" ); failAndExit("Required modules are missing, running no more checks.") if $missingModule; diff --git a/t/Cache.t b/t/Cache.t new file mode 100644 index 000000000..45289b163 --- /dev/null +++ b/t/Cache.t @@ -0,0 +1,145 @@ +# vim:syntax=perl +#------------------------------------------------------------------- +# WebGUI is Copyright 2001-2009 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 +#------------------------------------------------------------------ + +# Write a little about what this script tests. +# +# + +use FindBin; +use strict; +use lib "$FindBin::Bin/lib"; +use Test::More; +use WebGUI::Test; # Must use this before any other WebGUI modules +use WebGUI::Session; +use WebGUI::Cache; + +#---------------------------------------------------------------------------- +# Init +my $session = WebGUI::Test->session; + + +#---------------------------------------------------------------------------- +# Tests + +plan tests => 11; # Increment this number for each test you create + +#---------------------------------------------------------------------------- + +my $cache = WebGUI::Cache->new($session, 1); +isa_ok($cache, 'WebGUI::Cache'); +is($cache->parseKey("andy"), $session->config->getFilename.":andy", "parseKey single key"); +is($cache->parseKey(["andy","red"]), $session->config->getFilename.":andy:red", "parseKey composite key"); +$cache->set("Shawshank","Prison"); +is($cache->get("Shawshank"), "Prison", "set/get"); +$cache->set(["andy", "dufresne"], "Prisoner"); +is($cache->get(["andy", "dufresne"]), "Prisoner", "set/get composite"); +my ($a, $b) = @{$cache->mget(["Shawshank",["andy", "dufresne"]])}; +is($a, "Prison", "mget first value"); +is($b, "Prisoner", "mget second value"); +$cache->delete("Shawshank"); +is(eval{$cache->get("Shawshank")}, undef, 'delete'); +$cache->flush; +is(eval{$cache->get(["andy", "dufresne"])}, undef, 'flush'); +$cache->setByHttp("http://www.google.com/"); +cmp_ok($cache->get("http://www.google.com/"), 'ne', '', 'setByHttp'); +my $longValue ='abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*( + '; +$cache->set("really-long-value",$longValue); +is($cache->get("really-long-value"), $longValue, "set/get really long value"); + + +#---------------------------------------------------------------------------- +# Cleanup +END { + +} +#vim:ft=perl diff --git a/t/Session/Stow.t b/t/Session/Stow.t index 84fa329ac..566ebe685 100644 --- a/t/Session/Stow.t +++ b/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); -} diff --git a/t/Session/Var.t b/t/Session/Var.t index 4667ed1ff..68345c504 100644 --- a/t/Session/Var.t +++ b/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'); diff --git a/t/lib/WebGUI/Test.pm b/t/lib/WebGUI/Test.pm index 178462f05..0c6196b2a 100644 --- a/t/lib/WebGUI/Test.pm +++ b/t/lib/WebGUI/Test.pm @@ -32,9 +32,10 @@ BEGIN { if ( $^O eq 'darwin' && $Config::Config{osvers} lt '8.0.0' ) { unshift @INC, sub { return undef unless $_[1] =~ m/^Apache2|APR/; - my $buffer = '1'; - open my $fh, '<', \$buffer; - return $fh; + return IO::File->new( $INC{'Class/Null.pm'}, &IO::File::O_RDONLY ); + #my $buffer = '1'; + #open my $fh, '<', \$buffer; + #return $fh; }; no warnings 'redefine';