From 1f41a72140fd04267583b130f30581bff8c8de7c Mon Sep 17 00:00:00 2001 From: JT Smith Date: Thu, 24 Sep 2009 16:49:32 -0500 Subject: [PATCH 01/23] a start on a new memcached based cache system --- lib/WebGUI/Cache.pm | 219 +++++++++++++++----------- lib/WebGUI/Cache/Database.pm | 205 ------------------------ lib/WebGUI/Cache/FileCache.pm | 284 ---------------------------------- sbin/testmc.pl | 141 +++++++++++++++++ 4 files changed, 271 insertions(+), 578 deletions(-) delete mode 100644 lib/WebGUI/Cache/Database.pm delete mode 100644 lib/WebGUI/Cache/FileCache.pm create mode 100644 sbin/testmc.pl diff --git a/lib/WebGUI/Cache.pm b/lib/WebGUI/Cache.pm index 05f7cfb2f..e51b1d789 100644 --- a/lib/WebGUI/Cache.pm +++ b/lib/WebGUI/Cache.pm @@ -15,11 +15,13 @@ package WebGUI::Cache; =cut use strict; -use File::Path (); +use Digest::MD5; use HTTP::Headers; use HTTP::Request; use LWP::UserAgent; -use Digest::MD5; +use Memcached::libmemcached; +use Storable (); + =head1 NAME @@ -27,19 +29,19 @@ Package WebGUI::Cache =head1 DESCRIPTION -A base class for all Cache modules to extend. +An API that allows you to cache items to a memcached server. =head1 SYNOPSIS use WebGUI::Cache; - my $cache = WebGUI::Cache->new($session, "my app cache"); - my $cache = WebGUI::Cache->new($session, [ "my app", $assetId, $version ]); + my $cache = WebGUI::Cache->new($session); - $cache->set($value); - $cache->setByHTTP("http://www.google.com/"); + $cache->set($name, $value); + $cache->set(\@nameSegments, $value); + $cache->setByHttp($name, "http://www.google.com/"); - my $value = $cache->get; + my $value = $cache->get($name); $cache->delete; $cache->deleteChunk("my app cache"); @@ -54,62 +56,98 @@ These methods are available from this class: #------------------------------------------------------------------- -=head2 delete ( ) +=head2 delete ( name ) -Delete a key from the cache. Must be overridden. +Delete a key from the cache. + +=head3 name + +The key to delete. =cut sub delete { - -} - -#------------------------------------------------------------------- - -=head2 deleteChunk ( key ) - -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 - -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; + my ($self, $name) = @_; + Memcached::libmemcached::memcached_delete($self->getMemcached, $self->parseKey($name)); } #------------------------------------------------------------------- =head2 flush ( ) -Flushes the caching system. Must be overridden. +Empties the caching system. =cut sub flush { - my $self = shift; - File::Path::rmtree($self->session->config->get("uploadsPath")."/temp"); + my ($self) = @_; + Memcached::libmemcached::memcached_flush($self->getMemcached); } #------------------------------------------------------------------- -=head2 get ( ) +=head2 get ( name ) -Retrieves a key value from the cache. Must be overridden. +Retrieves a key value from the cache. + +=head3 name + +The key to retrieve. =cut sub get { + my ($self, $name) = @_; + my $content = Memcached::libmemcached::memcached_get($self->getMemcached, $self->parseKey($name)); + $content = Storable::thaw($content); + return undef unless $content && ref $content; + return ${$content}; +} +#------------------------------------------------------------------- + +=head2 getMemcached ( ) + +Returns a reference to the Memcached::libmemcached object. + +=cut + +sub getMemcached { + my ($self) = @_; + return $self->{_memcached}; } #------------------------------------------------------------------- -=head2 new ( session, key, [ namespace ] ) +=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. + +=head3 names + +An array reference of keys to retrieve. + +=cut + +sub mget { + my ($self, $names) = @_; + my @parsedNames = (); + foreach my $name (@{$names}) { + push @parsedNames, $self->parseKey($name); + } + $self->getMemcached->mget_into_hashref($self->getMemcached, \@parsedNames, my $result); + my @values = (); + foreach my $name (@{$names}) { + my $parsedName = shift @parsedNames; + push @values, ${$result->{$parsedName}}; + } + return \@values; +} + +#------------------------------------------------------------------- + +=head2 new ( session, [ namespace ] ) 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. @@ -117,12 +155,6 @@ The new method will return a handler for the configured caching mechanism. Defa A reference to the current session. -=head3 key - -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. @@ -130,49 +162,52 @@ A subdivider to store this cache under. When building your own cache plug-in def =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, $namespace) = @_; + my $config = $session->config; + $namespace ||= $config->getFilename; + my $memcached = Memcached::libmemcached::memcached_create(); + foreach my $server (@{$config->get('cacheServers')}) { + if (exists $server->{socket}) { + Memcached::libmemcached::memcached_server_add_unix_socket($memcached, $server->{socket}); + } + else { + Memcached::libmemcached::memcached_server_add($memcached, $server->{host}, $server->{port}); + } + } + bless {_memcached => $memcached, _namespace => $namespace, _sesssion => $session}, $class; } #------------------------------------------------------------------- -=head2 parseKey ( key ) +=head2 parseKey ( name ) -Returns a formatted string version of the key. A class method. +Returns a formatted string version of the key. -=head3 key +=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, $name) = @_; + + # prepend namespace to the key + my @key = ($self->{_namespace}); + # check for composite or simple key, make array from either - my @key; - if (! $_[0]) { - return; + if (! $name) { + # throw exception because no key was specified } - elsif (ref $_[0] eq 'ARRAY') { - @key = @{ +shift }; + elsif (ref $name eq 'ARRAY') { + @key = @{ $name }; } else { - @key = shift; + @key = $name; } - foreach my $part (@key) { - # convert to octets, then md5 them - utf8::encode($part); - $part = Digest::MD5::md5_base64($part); - $part =~ tr{/}{-}; - } - return join('/', @key); + + # merge key parts + return join(':', @key); } #------------------------------------------------------------------- @@ -184,18 +219,23 @@ Returns a reference to the current session. =cut sub session { - $_[0]->{_session}; + my ($self) = @_; + $self->{_session}; } #------------------------------------------------------------------- -=head2 set ( value [, ttl] ) +=head2 set ( name, value [, ttl] ) -Sets a key value to the cache. Must be overridden. +Sets a key value to the cache. + +=head3 name + +The name of the key to set. =head3 value -A scalar value to store. +A scalar value to store. You can also pass a hash reference or an array reference. =head3 ttl @@ -204,16 +244,24 @@ A time in seconds for the cache to exist. When you override default it to 60 sec =cut sub set { - + my ($self, $name, $value, $ttl) = @_; + $ttl ||= 60; + $value = Storable::nfreeze(\(scalar $value)); # Storable doesn't like non-reference arguments, so we wrap it in a scalar ref. + Memcached::libmemcached::memcached_set($self->getMemcached, $self->parseKey($name), $value, $ttl); + return $value; } #------------------------------------------------------------------- -=head2 setByHTTP ( url [, ttl ] ) +=head2 setByHttp ( name, url [, ttl ] ) Retrieves a document via HTTP and stores it in the cache and returns the content as a string. No need to override. +=head3 name + +The name of the key to store the request under. + =head3 url The URL of the document to retrieve. It must begin with the standard "http://". @@ -224,27 +272,20 @@ 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, $name, $url, $ttl) = @_; + my $userAgent = new LWP::UserAgent; $userAgent->env_proxy; - $userAgent->agent("WebGUI/".$WebGUI::VERSION); - $userAgent->timeout(30); - my $header = new HTTP::Headers; - my $referer = "http://webgui.http.request/".$self->session->env->get("SERVER_NAME").$self->session->env->get("REQUEST_URI"); - chomp $referer; - $header->referer($referer); - my $request = HTTP::Request->new(GET => $url, $header); + $userAgent->agent("WebGUI/".$WebGUI::VERSION); + $userAgent->timeout(30); + my $request = HTTP::Request->new(GET => $url); 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."); + # show throw exception + return undef; } - else { - $self->set($response->decoded_content,$ttl); - } - return $response->decoded_content; + return $self->set($response->decoded_content, $ttl); } #------------------------------------------------------------------- diff --git a/lib/WebGUI/Cache/Database.pm b/lib/WebGUI/Cache/Database.pm deleted file mode 100644 index b292ffb2b..000000000 --- a/lib/WebGUI/Cache/Database.pm +++ /dev/null @@ -1,205 +0,0 @@ -package WebGUI::Cache::Database; - -=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::Cache"; -use Storable (); - -=head1 NAME - -Package WebGUI::Cache::Database - -=head1 DESCRIPTION - -This package provides a means for WebGUI to cache data to the database. - -=head1 SYNOPSIS - - use WebGUI::Cache::Database; - -=head1 METHODS - -These methods are available from this class: - -=cut - - - - -#------------------------------------------------------------------- - -=head2 delete ( ) - -Remove content from the filesystem cache. - -=cut - -sub delete { - my $self = shift; - $self->session->db->write("delete from cache where namespace=? and cachekey=?",[$self->{_namespace}, $self->{_key}]); -} - -#------------------------------------------------------------------- - -=head2 deleteChunk ( key ) - -Remove a partial composite key from the cache. - -=head3 key - -A partial composite key to remove. - -=cut - -sub deleteChunk { - my $self = shift; - my $key = $self->parseKey(shift); - $self->session->db->write("delete from cache where namespace=? and cachekey like ?",[$self->{_namespace}, $key.'%']); -} - -#------------------------------------------------------------------- - -=head2 flush ( ) - -Remove all objects from the filecache system. - -=cut - -sub flush { - my $self = shift; - $self->SUPER::flush(); - $self->session->db->write("delete from cache where namespace=?",[$self->{_namespace}]); -} - -#------------------------------------------------------------------- - -=head2 get ( ) - -Retrieve content from the database cache. - -=cut - -sub get { - my $self = shift; - my $session = $self->session; - return undef if ($session->config->get("disableCache")); - my $sth = $session->db->dbh->prepare("select content from cache where namespace=? and cachekey=? and expires>?"); - $sth->execute($self->{_namespace},$self->{_key},time()); - my $data = $sth->fetchrow_arrayref; - $sth->finish; - my $content = $data->[0]; - return undef unless ($content); - # Storable doesn't like non-reference arguments, so we wrap it in a scalar ref. - eval { - $content = Storable::thaw($content); - }; - return undef unless $content && ref $content; - return $$content; -} - -#------------------------------------------------------------------- - -=head2 getNamespaceSize ( ) - -Returns the size (in bytes) of the current cache under this namespace. Consequently it also cleans up expired cache items. - -=cut - -sub getNamespaceSize { - my $self = shift; - my $expiresModifier = shift || 0; - $self->session->db->write("delete from cache where expires < ?",[time()+$expiresModifier]); - my ($size) = $self->session->db->quickArray("select sum(size) from cache where namespace=?",[$self->{_namespace}]); - return $size; -} - -#------------------------------------------------------------------- - -=head2 new ( session, key [, namespace ] ) - -Constructor. - -=head3 session - -A reference to the current session. - -=head3 key - -A key unique to this namespace. It is used to uniquely identify the cached content. - -=head3 namespace - -Defaults to the config filename for the current site. The only reason to override the default is if you want the cached content to be shared among all WebGUI instances on this machine. A common alternative namespace is "URL", which is typically used when caching content using the setByHTTP method. - -=cut - -sub new { - my $cache; - my $class = shift; - my $session = shift; - my $key = $class->parseKey(shift); - my $namespace = shift || $session->config->getFilename; - bless {_session=>$session, _key=>$key, _namespace=>$namespace}, $class; -} - - -#------------------------------------------------------------------- - -=head2 set ( content [, ttl ] ) - -Save content to the filesystem cache. - -=head3 content - -A scalar variable containing the content to be set. - -=head3 ttl - -The time to live for this content. This is the amount of time (in seconds) that the content will remain in the cache. Defaults to "60". - -=cut - -sub set { - my $self = shift; - # Storable doesn't like non-reference arguments, so we wrap it in a scalar ref. - my $content = Storable::nfreeze(\(scalar shift)); - my $ttl = shift || 60; - my $size = length($content); - # getting better performance using native dbi than webgui sql - my $dbh = $self->session->db->dbh; - my $sth = $dbh->prepare("replace into cache (namespace,cachekey,expires,size,content) values (?,?,?,?,?)"); - $sth->execute($self->{_namespace}, $self->{_key}, time()+$ttl, $size, $content); - $sth->finish; -} - - -#------------------------------------------------------------------- - -=head2 stats ( ) - -Returns statistic information about the caching system. - -=cut - -sub stats { - my $self = shift; - my ($size) = $self->session->db->quickArray("select sum(size) from cache where namespace=?",[$self->{_namespace}]); - return $size." bytes"; -} - -1; - - diff --git a/lib/WebGUI/Cache/FileCache.pm b/lib/WebGUI/Cache/FileCache.pm deleted file mode 100644 index 0ce7a2a35..000000000 --- a/lib/WebGUI/Cache/FileCache.pm +++ /dev/null @@ -1,284 +0,0 @@ -package WebGUI::Cache::FileCache; - -=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 Storable (); -use File::Path (); -use File::Find (); - -our @ISA = qw(WebGUI::Cache); - -=head1 NAME - -Package WebGUI::Cache::FileCache - -=head1 DESCRIPTION - -This package provides a means for WebGUI to cache data to the filesystem. - -=head1 SYNOPSIS - - use WebGUI::Cache::FileCache; - -=head1 METHODS - -These methods are available from this class: - -=cut - - - - -#------------------------------------------------------------------- - -=head2 delete ( ) - -Remove content from the filesystem cache. - -=cut - -sub delete { - my $self = shift; - my $folder = $self->getFolder; - if (-e $folder) { - File::Path::rmtree($folder); - } -} - -#------------------------------------------------------------------- - -=head2 deleteChunk ( key ) - -Remove a partial composite key from the cache. - -=head3 key - -A partial composite key to remove. - -=cut - -sub deleteChunk { - my $self = shift; - my $folder = $self->getNamespaceRoot."/".$self->parseKey(shift); - if (-e $folder) { - File::Path::rmtree($folder); - } -} - -#------------------------------------------------------------------- - -=head2 flush ( ) - -Remove all objects from the filecache system. - -=cut - -sub flush { - my $self = shift; - $self->SUPER::flush(); - my $folder = $self->getNamespaceRoot; - if (-e $folder) { - File::Path::rmtree($folder); - } -} - -#------------------------------------------------------------------- - -=head2 get ( ) - -Retrieve content from the filesystem cache. - -=cut - -sub get { - my $self = shift; - return undef if ($self->session->config->get("disableCache")); - my $folder = $self->getFolder; - if (-e $folder."/expires" && -e $folder."/cache" && open(my $FILE,"<",$folder."/expires")) { - my $expires = <$FILE>; - close($FILE); - return undef if ($expires < time); - my $value; - eval {$value = Storable::retrieve($folder."/cache")}; - if (ref $value eq "SCALAR") { - return $$value; - } else { - return $value; - } - } - return undef; -} - -#------------------------------------------------------------------- - -=head2 getFolder ( ) - -Returns the path to the cache folder for this key. - -=cut - -sub getFolder { - my $self = shift; - return $self->getNamespaceRoot()."/".$self->{_key}; -} - -#------------------------------------------------------------------- - -=head2 getNamespaceRoot ( ) - -Figures out what the cache root for this namespace should be. A class method. - -=cut - -sub getNamespaceRoot { - my $self = shift; - my $root = $self->session->config->get("fileCacheRoot"); - unless ($root) { - if ($self->session->os->get("windowsish")) { - $root = $self->session->env->get("TEMP") || $self->session->env->get("TMP") || "/temp"; - } else { - $root = "/tmp"; - } - $root .= "/WebGUICache"; - } - $root .= "/".$self->{_namespace}; - return $root; -} - -#------------------------------------------------------------------- - -=head2 getNamespaceSize ( ) - -Returns the size (in bytes) of the current cache under this namespace. Consequently it also cleans up expired cache items. - -=cut - -sub getNamespaceSize { - my $self = shift; - my $expiresModifier = shift || 0; - my $cacheSize = 0; - File::Find::find({ - no_chdir => 1, - wanted => sub { - return - unless $File::Find::name =~ m/expires$/; - if ( open my $FILE, "<", $File::Find::name ) { - my $expires = <$FILE>; - close $FILE; - if ($expires < time + $expiresModifier) { - File::Path::rmtree($File::Find::dir); - $File::Find::prune = 1; - return - } - else { - $cacheSize += -s $File::Find::dir.'/cache'; - } - } - }, - }, $self->getNamespaceRoot); - return $cacheSize; -} - -#------------------------------------------------------------------- - -=head2 new ( session, key [, namespace ] ) - -Constructor. - -=head3 session - -A reference to the current session. - -=head3 key - -A key unique to this namespace. It is used to uniquely identify the cached content. - -=head3 namespace - -Defaults to the config filename for the current site. The only reason to override the default is if you want the cached content to be shared among all WebGUI instances on this machine. A common alternative namespace is "URL", which is typically used when caching content using the setByHTTP method. - -=cut - -sub new { - my $cache; - my $class = shift; - my $session = shift; - my $key = $class->parseKey(shift); - my $namespace = shift || $session->config->getFilename; - bless {_session=>$session, _key=>$key, _namespace=>$namespace}, $class; -} - - -#------------------------------------------------------------------- - -=head2 set ( content [, ttl ] ) - -Save content to the filesystem cache. - -=head3 content - -A scalar variable containing the content to be set. - -=head3 ttl - -The time to live for this content. This is the amount of time (in seconds) that the content will remain in the cache. Defaults to "60". - -=cut - -sub set { - my $self = shift; - my $content = shift; - my $ttl = shift || 60; - my $oldumask = umask(); - umask(0000); - my $path = $self->getFolder(); - unless (-e $path) { - eval {File::Path::mkpath($path,0)}; - if ($@) { - $self->session->errorHandler->error("Couldn't create cache folder: ".$path." : ".$@); - return undef; - } - } - my $value; - unless (ref $content) { - $value = \$content; - } else { - $value = $content; - } - Storable::nstore($value, $path."/cache"); - open my $FILE, ">", $path."/expires"; - print $FILE time + $ttl; - close $FILE; - umask($oldumask); -} - - -#------------------------------------------------------------------- - -=head2 stats ( ) - -Returns statistic information about the caching system. - -=cut - -sub stats { - my $self = shift; - return $self->getNamespaceSize." bytes"; -} - -1; - - diff --git a/sbin/testmc.pl b/sbin/testmc.pl new file mode 100644 index 000000000..0d847e4a7 --- /dev/null +++ b/sbin/testmc.pl @@ -0,0 +1,141 @@ +#!/usr/bin/env 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 +#------------------------------------------------------------------- + +$|++; # disable output buffering +our ($webguiRoot, $configFile, $help, $man); + +BEGIN { + $webguiRoot = ".."; + unshift (@INC, $webguiRoot."/lib"); +} + +use strict; +use Pod::Usage; +use Getopt::Long; +use WebGUI::Session; +use Config::JSON; +use WebGUI::Cache; +use Time::HiRes; + +# Get parameters here, including $help +GetOptions( + 'configFile=s' => \$configFile, + 'help' => \$help, + 'man' => \$man, +); + +pod2usage( verbose => 1 ) if $help; +pod2usage( verbose => 2 ) if $man; +pod2usage( msg => "Must specify a config file!" ) unless $configFile; +my $session = start( $webguiRoot, $configFile ); +print "creating cache object\n"; +my $cache = WebGUI::Cache->new($session); +print "setting cache\n"; +my $t = [Time::HiRes::gettimeofday]; +my @keys; +my $sth = $session->db->read("select assetId, revisionDate, title from assetData"); +while (my ($id, $rev, $title) = $sth->array) { + push @keys, [$id, $rev]; + $cache->set([$id,$rev],$title); +} +print "Took ".Time::HiRes::tv_interval($t)." seconds to set ".scalar(@keys)." cache objects.\n"; +print "fetching cache\n"; +my $t = [Time::HiRes::gettimeofday]; +foreach my $key (@keys) { + my $value = $cache->get($key); +} +print "Took ".Time::HiRes::tv_interval($t)." seconds to get ".scalar(@keys)." cache objects.\n"; +print "done\n"; + + +finish($session); + +#---------------------------------------------------------------------------- +# Your sub here + +#---------------------------------------------------------------------------- +sub start { + my $webguiRoot = shift; + my $configFile = shift; + my $session = WebGUI::Session->open($webguiRoot,$configFile); + $session->user({userId=>3}); + + ## If your script is adding or changing content you need these lines, otherwise leave them commented + # + # my $versionTag = WebGUI::VersionTag->getWorking($session); + # $versionTag->set({name => 'Name Your Tag'}); + # + ## + + return $session; +} + +#---------------------------------------------------------------------------- +sub finish { + my $session = shift; + + ## If your script is adding or changing content you need these lines, otherwise leave them commented + # + # my $versionTag = WebGUI::VersionTag->getWorking($session); + # $versionTag->commit; + ## + + $session->var->end; + $session->close; +} + +__END__ + + +=head1 NAME + +utility - A template for WebGUI utility scripts + +=head1 SYNOPSIS + + utility --configFile config.conf ... + + utility --help + +=head1 DESCRIPTION + +This WebGUI utility script helps you... + +=head1 ARGUMENTS + +=head1 OPTIONS + +=over + +=item B<--configFile config.conf> + +The WebGUI config file to use. Only the file name needs to be specified, +since it will be looked up inside WebGUI's configuration directory. +This parameter is required. + +=item B<--help> + +Shows a short summary and usage + +=item B<--man> + +Shows this document + +=back + +=head1 AUTHOR + +Copyright 2001-2009 Plain Black Corporation. + +=cut + +#vim:ft=perl From c6d6882f4ad0ec3cd618d9d41ac99174f9c3ec27 Mon Sep 17 00:00:00 2001 From: JT Smith Date: Thu, 24 Sep 2009 21:34:34 -0500 Subject: [PATCH 02/23] starting on a test kid for the new cache library --- t/Cache.t | 49 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 49 insertions(+) create mode 100644 t/Cache.t diff --git a/t/Cache.t b/t/Cache.t new file mode 100644 index 000000000..e526e7085 --- /dev/null +++ b/t/Cache.t @@ -0,0 +1,49 @@ +# 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 => 3; # Increment this number for each test you create + +#---------------------------------------------------------------------------- + +my $cache = WebGUI::Cache->new($session); +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"); + + + + +#---------------------------------------------------------------------------- +# Cleanup +END { + +} +#vim:ft=perl From 4b974d644bf4ff241b14c1f924315fef75267954 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 24 Sep 2009 19:49:30 -0700 Subject: [PATCH 03/23] Restore original Darwin buffer hack. --- t/lib/WebGUI/Test.pm | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) 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'; From 180c207335190327a967dc824a3915fdc0bd09f4 Mon Sep 17 00:00:00 2001 From: JT Smith Date: Thu, 24 Sep 2009 21:55:38 -0500 Subject: [PATCH 04/23] fixed a bug in parseKey --- lib/WebGUI/Cache.pm | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/lib/WebGUI/Cache.pm b/lib/WebGUI/Cache.pm index e51b1d789..c9ba5a1d6 100644 --- a/lib/WebGUI/Cache.pm +++ b/lib/WebGUI/Cache.pm @@ -43,9 +43,9 @@ An API that allows you to cache items to a memcached server. my $value = $cache->get($name); - $cache->delete; - $cache->deleteChunk("my app cache"); - $cache->deleteChunk([ "my app", $assetId ]); + $cache->delete($name); + + $cache->flush; =head1 METHODS @@ -200,10 +200,10 @@ sub parseKey { # throw exception because no key was specified } elsif (ref $name eq 'ARRAY') { - @key = @{ $name }; + push @key, @{ $name }; } else { - @key = $name; + push @key, $name; } # merge key parts From 65239eee4d17084fa34f38fd8256339fc8073128 Mon Sep 17 00:00:00 2001 From: JT Smith Date: Thu, 24 Sep 2009 22:31:19 -0500 Subject: [PATCH 05/23] mget not working, but it's better than it was --- lib/WebGUI/Cache.pm | 9 +++++---- t/Cache.t | 10 ++++++++-- 2 files changed, 13 insertions(+), 6 deletions(-) diff --git a/lib/WebGUI/Cache.pm b/lib/WebGUI/Cache.pm index c9ba5a1d6..c05f24386 100644 --- a/lib/WebGUI/Cache.pm +++ b/lib/WebGUI/Cache.pm @@ -136,11 +136,12 @@ sub mget { foreach my $name (@{$names}) { push @parsedNames, $self->parseKey($name); } - $self->getMemcached->mget_into_hashref($self->getMemcached, \@parsedNames, my $result); + my %result; + $self->getMemcached->mget_into_hashref(\@parsedNames, \%result); my @values = (); - foreach my $name (@{$names}) { - my $parsedName = shift @parsedNames; - push @values, ${$result->{$parsedName}}; + foreach my $name (@parsedNames) { + next unless ref $result{$name}; + push @values, ${$result{$name}}; } return \@values; } diff --git a/t/Cache.t b/t/Cache.t index e526e7085..0de17d40c 100644 --- a/t/Cache.t +++ b/t/Cache.t @@ -29,7 +29,7 @@ my $session = WebGUI::Test->session; #---------------------------------------------------------------------------- # Tests -plan tests => 3; # Increment this number for each test you create +plan tests => 7; # Increment this number for each test you create #---------------------------------------------------------------------------- @@ -37,7 +37,13 @@ my $cache = WebGUI::Cache->new($session); 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"); From 3c36b404b48bfa33975c18387667ff3834f5046d Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 24 Sep 2009 20:40:09 -0700 Subject: [PATCH 06/23] Try to optimize mget in Cache.pm --- lib/WebGUI/Cache.pm | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/lib/WebGUI/Cache.pm b/lib/WebGUI/Cache.pm index c05f24386..bdbe9c248 100644 --- a/lib/WebGUI/Cache.pm +++ b/lib/WebGUI/Cache.pm @@ -132,13 +132,10 @@ An array reference of keys to retrieve. sub mget { my ($self, $names) = @_; - my @parsedNames = (); - foreach my $name (@{$names}) { - push @parsedNames, $self->parseKey($name); - } + my @parsedNames = map { $self->parseKey($_) } @{ $names }; my %result; $self->getMemcached->mget_into_hashref(\@parsedNames, \%result); - my @values = (); + my @values; foreach my $name (@parsedNames) { next unless ref $result{$name}; push @values, ${$result{$name}}; From 9569d0c3abc51a1fd565bd3603135d7af09ec6db Mon Sep 17 00:00:00 2001 From: JT Smith Date: Thu, 24 Sep 2009 22:46:39 -0500 Subject: [PATCH 07/23] fixed the remaining bugs in mget --- lib/WebGUI/Cache.pm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lib/WebGUI/Cache.pm b/lib/WebGUI/Cache.pm index c05f24386..419752cd7 100644 --- a/lib/WebGUI/Cache.pm +++ b/lib/WebGUI/Cache.pm @@ -140,8 +140,9 @@ sub mget { $self->getMemcached->mget_into_hashref(\@parsedNames, \%result); my @values = (); foreach my $name (@parsedNames) { - next unless ref $result{$name}; - push @values, ${$result{$name}}; + my $content = Storable::thaw($result{$name}); + next unless ref $content; + push @values, ${$content}; } return \@values; } From 66db563c390ad4d7bcd6cba9fd78528a2966fb6b Mon Sep 17 00:00:00 2001 From: JT Smith Date: Thu, 24 Sep 2009 23:12:20 -0500 Subject: [PATCH 08/23] basics all tested --- lib/WebGUI/Cache.pm | 17 +++-------------- t/Cache.t | 9 +++++++-- 2 files changed, 10 insertions(+), 16 deletions(-) diff --git a/lib/WebGUI/Cache.pm b/lib/WebGUI/Cache.pm index d84598723..2d932d259 100644 --- a/lib/WebGUI/Cache.pm +++ b/lib/WebGUI/Cache.pm @@ -245,8 +245,8 @@ A time in seconds for the cache to exist. When you override default it to 60 sec sub set { my ($self, $name, $value, $ttl) = @_; $ttl ||= 60; - $value = Storable::nfreeze(\(scalar $value)); # Storable doesn't like non-reference arguments, so we wrap it in a scalar ref. - Memcached::libmemcached::memcached_set($self->getMemcached, $self->parseKey($name), $value, $ttl); + my $frozenValue = Storable::nfreeze(\(scalar $value)); # Storable doesn't like non-reference arguments, so we wrap it in a scalar ref. + Memcached::libmemcached::memcached_set($self->getMemcached, $self->parseKey($name), $frozenValue, $ttl); return $value; } @@ -284,20 +284,9 @@ sub setByHttp { # show throw exception return undef; } - return $self->set($response->decoded_content, $ttl); + return $self->set($name, $response->decoded_content, $ttl); } -#------------------------------------------------------------------- - -=head2 stats ( ) - -Return a formatted text string describing cache usage. Must be overridden. - -=cut - -sub stats { - -} 1; diff --git a/t/Cache.t b/t/Cache.t index 0de17d40c..2cf4ea095 100644 --- a/t/Cache.t +++ b/t/Cache.t @@ -29,7 +29,7 @@ my $session = WebGUI::Test->session; #---------------------------------------------------------------------------- # Tests -plan tests => 7; # Increment this number for each test you create +plan tests => 10; # Increment this number for each test you create #---------------------------------------------------------------------------- @@ -44,7 +44,12 @@ 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($cache->get("Shawshank"), undef, 'delete'); +$cache->flush; +is($cache->get(["andy", "dufresne"]), undef, 'flush'); +$cache->setByHttp("google", "http://www.google.com/"); +cmp_ok($cache->get("google"), 'ne', '', 'setByHttp'); #---------------------------------------------------------------------------- From 46737d6945b79c5fe3ae4a76f290c1b6643920c8 Mon Sep 17 00:00:00 2001 From: JT Smith Date: Thu, 24 Sep 2009 23:28:45 -0500 Subject: [PATCH 09/23] starting migration to memcached --- docs/upgrades/upgrade_7.8.1-8.0.0.pl | 22 ++++ etc/WebGUI.conf.original | 21 ---- .../Workflow/Activity/CleanDatabaseCache.pm | 94 --------------- .../Workflow/Activity/CleanFileCache.pm | 107 ------------------ 4 files changed, 22 insertions(+), 222 deletions(-) delete mode 100644 lib/WebGUI/Workflow/Activity/CleanDatabaseCache.pm delete mode 100644 lib/WebGUI/Workflow/Activity/CleanFileCache.pm 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..00dff6aca 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,31 @@ 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->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..34e395040 100644 --- a/etc/WebGUI.conf.original +++ b/etc/WebGUI.conf.original @@ -88,25 +88,6 @@ #"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. - -"cacheType" : "WebGUI::Cache::FileCache", - -# Tell WebGUI where to store cached files. Defaults to the -# /tmp or c:\temp folder depending upon your operating system. - -# "fileCacheRoot" : "/path/to/cache", - -# Set this to 1 to disable WebGUI's caching subsystems. This is -# mainly useful for developers. - -"disableCache" : 0, - # The database connection string. It usually takes the form of # DBI::;host: @@ -857,8 +838,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/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; - - From 880ee820093a922454fb3aeffc07eadc76eeee51 Mon Sep 17 00:00:00 2001 From: JT Smith Date: Thu, 24 Sep 2009 23:51:29 -0500 Subject: [PATCH 10/23] continuing new cache integration --- docs/gotcha.txt | 12 ++++++++++++ docs/migration.txt | 9 +++++++++ lib/WebGUI/Session.pm | 22 ++++++++++++++++++++++ sbin/testEnvironment.pl | 1 + 4 files changed, 44 insertions(+) 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/lib/WebGUI/Session.pm b/lib/WebGUI/Session.pm index 1ffcd69a5..4e0f6ad92 100644 --- a/lib/WebGUI/Session.pm +++ b/lib/WebGUI/Session.pm @@ -109,6 +109,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. 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; From 09358cbfe71ca6c3551f7a724a02642e53c8d5a2 Mon Sep 17 00:00:00 2001 From: JT Smith Date: Fri, 25 Sep 2009 10:07:04 -0500 Subject: [PATCH 11/23] started params validate work --- lib/WebGUI/Cache.pm | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/lib/WebGUI/Cache.pm b/lib/WebGUI/Cache.pm index 2d932d259..70a63b3a5 100644 --- a/lib/WebGUI/Cache.pm +++ b/lib/WebGUI/Cache.pm @@ -21,6 +21,10 @@ use HTTP::Request; use LWP::UserAgent; use Memcached::libmemcached; use Storable (); +use WebGUI::Error; +use Params::Validate qw(:all); +Params::Validate::validation_options( on_fail => sub { WebGUI::Error::InvalidParam->throw( error => shift ) } ); + =head1 NAME @@ -67,6 +71,12 @@ The key to delete. =cut sub delete { + validate(@_, + { name => { + type => SCALAR + } + }); + my ($self, $name) = @_; Memcached::libmemcached::memcached_delete($self->getMemcached, $self->parseKey($name)); } From a34f584780a68f854678e825823b4631bf5ab873 Mon Sep 17 00:00:00 2001 From: JT Smith Date: Fri, 25 Sep 2009 15:22:11 -0500 Subject: [PATCH 12/23] Added WebGUI::Error::Connection, and fixed docs --- lib/WebGUI/Exception.pm | 204 ++++++++++++++++++++++++++++++---------- 1 file changed, 153 insertions(+), 51 deletions(-) diff --git a/lib/WebGUI/Exception.pm b/lib/WebGUI/Exception.pm index 3d4ac9872..59525b158 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,11 @@ B: Though the package name is WebGUI::Exception, the handler objects that These exception classes are defined in this class: +=cut + +use Exception::Class ( + +#------------------------------------------------------------------- =head2 WebGUI::Error @@ -123,6 +83,48 @@ 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 + + 'WebGUI::Error' => { + description => "A general error occured.", + }, + + +#------------------------------------------------------------------- + +=head2 WebGUI::Error::OverrideMe + +An interface was not overriden as expected. + +=cut + + 'WebGUI::Error::OverrideMe' => { + isa => 'WebGUI::Error', + description => 'This method should be overridden by subclasses.', + }, + + +#------------------------------------------------------------------- + +=head2 WebGUI::Error::MethodNotFound + +Tried calling a method that doesn't exist. + +=head3 method + +The method called. + +=cut + + 'WebGUI::Error::MethodNotFound' => { + isa => 'WebGUI::Error', + description => q|Called a method that doesn't exist.|, + fields => 'method' + }, + + +#------------------------------------------------------------------- + =head2 WebGUI::Error::InvalidObject Used when looking to make sure objects are passed in that you expect. ISA WebGUI::Error::InvalidParam. @@ -135,6 +137,17 @@ The type of object expected ("HASH", "ARRAY", "WebGUI::User", etc). The object type we got. +=cut + + 'WebGUI::Error::InvalidObject' => { + isa => 'WebGUI::Error::InvalidParam', + description => "Expected to get a reference to an object type that wasn't gotten.", + fields => ["expected","got"], + }, + + +#------------------------------------------------------------------- + =head2 WebGUI::Error::InvalidParam Used when an invalid parameter is passed into a subroutine. @@ -143,6 +156,17 @@ Used when an invalid parameter is passed into a subroutine. Used to return the bad parameter, if present. +=cut + + 'WebGUI::Error::InvalidParam' => { + isa => 'WebGUI::Error', + description => "Expected to get a param we didn't get.", + fields => ["param"], + }, + + +#------------------------------------------------------------------- + =head2 WebGUI::Error::ObjectNotFound Used when an object is trying to be retrieved, but does not exist. ISA WebGUI::Error. @@ -151,20 +175,98 @@ 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. + 'WebGUI::Error::ObjectNotFound' => { + isa => 'WebGUI::Error', + description => "The object you were trying to retrieve does not exist.", + fields => ["id"], + }, -=head3 method -The method called. +#------------------------------------------------------------------- -=head2 WebGUI::Error::OverrideMe +=head2 WebGUI::Error::ObjectNotFound::Template -An interface was not overriden as expected. +Used when a template is trying to be retrieved, but does not exist. ISA WebGUI::Error::ObjectNotFound. + +=head3 templateId | id | assetId + +The id of the object to be retrieved. =cut + 'WebGUI::Error::ObjectNotFound::Template' => { + isa => 'WebGUI::Error', + description => "The template an asset was trying to retrieve does not exist.", + fields => [qw/templateId assetId/], + }, + + +#------------------------------------------------------------------- + +=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 + + 'WebGUI::Error::InvalidFile' => { + isa => 'WebGUI::Error', + description => "The file you have provided has errors.", + fields => [qw{ brokenFile brokenLine }], + }, + + +#------------------------------------------------------------------- + +=head2 WebGUI::Error::Template + +Used when a template has parsing errors. ISA WebGUI::Error. + +=cut + + 'WebGUI::Error::Template' => { + isa => 'WebGUI::Error', + description => "A template has errors that prevent it from being processed.", + }, + + +#------------------------------------------------------------------- + +=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 + + 'WebGUI::Error::Connection' => { + isa => 'WebGUI::Error', + description => "Couldn't establish a connection.", + fields => [qw{ resource }], + }, + +); + + + + + + + + 1; From af705232a84b67d66edf5f2497dfbd9f6af94e79 Mon Sep 17 00:00:00 2001 From: JT Smith Date: Fri, 25 Sep 2009 18:41:03 -0500 Subject: [PATCH 13/23] added exceptions, docs, and removed disableCache --- etc/WebGUI.conf.original | 12 +++ lib/WebGUI/AssetLineage.pm | 6 +- lib/WebGUI/Cache.pm | 183 +++++++++++++++++++++++++++++-------- lib/WebGUI/Exception.pm | 122 ++++++++++++------------- lib/WebGUI/Session.pm | 1 - lib/WebGUI/Session/Stow.pm | 3 - t/Cache.t | 4 +- 7 files changed, 224 insertions(+), 107 deletions(-) diff --git a/etc/WebGUI.conf.original b/etc/WebGUI.conf.original index 34e395040..a3ba08a9f 100644 --- a/etc/WebGUI.conf.original +++ b/etc/WebGUI.conf.original @@ -88,6 +88,18 @@ #"webServerPort" : 80, +# 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 + + "cacheServers" : [ + { "socket" : "/tmp/memcached.sock", "host" : "127.0.0.1", "port" : "11211" } +], + # The database connection string. It usually takes the form of # DBI::;host: diff --git a/lib/WebGUI/AssetLineage.pm b/lib/WebGUI/AssetLineage.pm index 659b1d9f1..3a948c69d 100644 --- a/lib/WebGUI/AssetLineage.pm +++ b/lib/WebGUI/AssetLineage.pm @@ -265,10 +265,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/Cache.pm b/lib/WebGUI/Cache.pm index 70a63b3a5..4fecdfe74 100644 --- a/lib/WebGUI/Cache.pm +++ b/lib/WebGUI/Cache.pm @@ -21,7 +21,7 @@ use HTTP::Request; use LWP::UserAgent; use Memcached::libmemcached; use Storable (); -use WebGUI::Error; +use WebGUI::Exception; use Params::Validate qw(:all); Params::Validate::validation_options( on_fail => sub { WebGUI::Error::InvalidParam->throw( error => shift ) } ); @@ -71,14 +71,29 @@ The key to delete. =cut sub delete { - validate(@_, - { name => { - type => SCALAR - } - }); - - my ($self, $name) = @_; - Memcached::libmemcached::memcached_delete($self->getMemcached, $self->parseKey($name)); + my ($self, $name) = validate_pos(@_, + 1, + { type => SCALAR | ARRAYREF }, + ); + my $memcached = $self->getMemcached; + Memcached::libmemcached::memcached_delete($memcached, $self->parseKey($name)); + if ($memcached->errstr eq 'SYSTEM ERROR Unknown error: 0') { + WebGUI::Error::Connection->throw( + error => "Cannot connect to memcached server." + ); + } + elsif ($memcached->errstr eq 'NO SERVERS DEFINED') { + 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 + ) { + WebGUI::Error->throw( + error => "Couldn't delete $name from cache because ".$memcached->errstr + ); + } } #------------------------------------------------------------------- @@ -91,7 +106,23 @@ Empties the caching system. sub flush { my ($self) = @_; - Memcached::libmemcached::memcached_flush($self->getMemcached); + my $memcached = $self->getMemcached; + Memcached::libmemcached::memcached_flush($memcached); + if ($memcached->errstr eq 'SYSTEM ERROR Unknown error: 0') { + WebGUI::Error::Connection->throw( + error => "Cannot connect to memcached server." + ); + } + elsif ($memcached->errstr eq 'NO SERVERS DEFINED') { + WebGUI::Error->throw( + error => "No memcached servers specified in config file." + ); + } + elsif ($memcached->errstr ne 'SUCCESS') { + WebGUI::Error->throw( + error => "Couldn't flush cache because ".$memcached->errstr + ); + } } #------------------------------------------------------------------- @@ -107,10 +138,35 @@ The key to retrieve. =cut sub get { - my ($self, $name) = @_; - my $content = Memcached::libmemcached::memcached_get($self->getMemcached, $self->parseKey($name)); + my ($self, $name) = validate_pos(@_, + 1, + { type => SCALAR | ARRAYREF }, + ); + my $memcached = $self->getMemcached; + my $content = Memcached::libmemcached::memcached_get($memcached, $self->parseKey($name)); + if ($memcached->errstr eq 'NOT FOUND' ) { + WebGUI::Error::ObjectNotFound->throw( + error => "The cache key $name has no value.", + id => $name, + ); + } + elsif ($memcached->errstr eq 'NO SERVERS DEFINED') { + WebGUI::Error->throw( + error => "No memcached servers specified in config file." + ); + } + elsif ($memcached->errstr eq 'SYSTEM ERROR Unknown error: 0') { + WebGUI::Error::Connection->throw( + error => "Cannot connect to memcached server." + ); + } + elsif ($memcached->errstr ne 'SUCCESS') { + WebGUI::Error->throw( + error => "Couldn't get $name from cache because ".$memcached->errstr + ); + } $content = Storable::thaw($content); - return undef unless $content && ref $content; + return undef unless ref $content; return ${$content}; } @@ -141,10 +197,25 @@ An array reference of keys to retrieve. =cut sub mget { - my ($self, $names) = @_; + my ($self, $names) = validate_pos(@_, + 1, + { type => ARRAYREF }, + ); my @parsedNames = map { $self->parseKey($_) } @{ $names }; my %result; - $self->getMemcached->mget_into_hashref(\@parsedNames, \%result); + my $memcached = $self->getMemcached; + $memcached->mget_into_hashref(\@parsedNames, \%result); + if ($memcached->errstr eq 'SYSTEM ERROR Unknown error: 0') { + WebGUI::Error::Connection->throw( + error => "Cannot connect to memcached server." + ); + } + elsif ($memcached->errstr eq 'NO SERVERS DEFINED') { + WebGUI::Error->throw( + error => "No memcached servers specified in config file." + ); + } + # no other useful status messages are returned my @values; foreach my $name (@parsedNames) { my $content = Storable::thaw($result{$name}); @@ -156,7 +227,7 @@ sub mget { #------------------------------------------------------------------- -=head2 new ( session, [ namespace ] ) +=head2 new ( session ) 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. @@ -164,23 +235,23 @@ The new method will return a handler for the configured caching mechanism. Defa A reference to the current session. -=head3 namespace - -A subdivider to store this cache under. When building your own cache plug-in default this to the WebGUI config file. - =cut sub new { - my ($class, $session, $namespace) = @_; + my ($class, $session) = validate_pos(@_, + 1, + { isa => 'WebGUI::Session' }, + ); + my ($class, $session) = @_; my $config = $session->config; - $namespace ||= $config->getFilename; - my $memcached = Memcached::libmemcached::memcached_create(); + 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}); + 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}); + Memcached::libmemcached::memcached_server_add($memcached, $server->{host}, $server->{port}); # no exception because always returns success } } bless {_memcached => $memcached, _namespace => $namespace, _sesssion => $session}, $class; @@ -199,16 +270,16 @@ Can either be a text key, or a composite key. If it's a composite key, it will b =cut sub parseKey { - my ($self, $name) = @_; + my ($self, $name) = validate_pos(@_, + 1, + { type => SCALAR | ARRAYREF }, + ); # prepend namespace to the key my @key = ($self->{_namespace}); # check for composite or simple key, make array from either - if (! $name) { - # throw exception because no key was specified - } - elsif (ref $name eq 'ARRAY') { + if (ref $name eq 'ARRAY') { push @key, @{ $name }; } else { @@ -253,10 +324,30 @@ A time in seconds for the cache to exist. When you override default it to 60 sec =cut sub set { - my ($self, $name, $value, $ttl) = @_; - $ttl ||= 60; + my ($self, $name, $value, $ttl) = validate_pos(@_, + 1, + { type => SCALAR | ARRAYREF }, + { type => SCALAR }, + { type => SCALAR | UNDEF, optional => 1, default=> 60 }, + ); my $frozenValue = Storable::nfreeze(\(scalar $value)); # Storable doesn't like non-reference arguments, so we wrap it in a scalar ref. - Memcached::libmemcached::memcached_set($self->getMemcached, $self->parseKey($name), $frozenValue, $ttl); + my $memcached = $self->getMemcached; + Memcached::libmemcached::memcached_set($memcached, $self->parseKey($name), $frozenValue, $ttl); + if ($memcached->errstr eq 'SYSTEM ERROR Unknown error: 0') { + WebGUI::Error::Connection->throw( + error => "Cannot connect to memcached server." + ); + } + elsif ($memcached->errstr eq 'NO SERVERS DEFINED') { + WebGUI::Error->throw( + error => "No memcached servers specified in config file." + ); + } + elsif ($memcached->errstr ne 'SUCCESS') { + WebGUI::Error->throw( + error => "Couldn't set $name to cache because ".$memcached->errstr + ); + } return $value; } @@ -282,22 +373,42 @@ The time to live for this content. This is the amount of time (in seconds) that =cut sub setByHttp { - my ($self, $name, $url, $ttl) = @_; + my ($self, $name, $url, $ttl) = validate_pos(@_, + 1, + { type => SCALAR | ARRAYREF }, + { type => SCALAR }, + { type => SCALAR, optional => 1 }, + ); my $userAgent = new LWP::UserAgent; $userAgent->env_proxy; $userAgent->agent("WebGUI/".$WebGUI::VERSION); $userAgent->timeout(30); my $request = HTTP::Request->new(GET => $url); + + my $response = $userAgent->request($request); if ($response->is_error) { $self->session->log->error($url." could not be retrieved."); - # show throw exception - return undef; + WebGUI::Error::Connection->throw( + error => "Couldn't fetch $url because ".$response->message, + resource => $url, + ); } return $self->set($name, $response->decoded_content, $ttl); } +=head1 EXCEPTIONS + +This class throws a huge number of exceptions about everything you can imagine, and many things you can't. 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; + } + +=cut + 1; diff --git a/lib/WebGUI/Exception.pm b/lib/WebGUI/Exception.pm index 59525b158..634356477 100644 --- a/lib/WebGUI/Exception.pm +++ b/lib/WebGUI/Exception.pm @@ -51,8 +51,6 @@ These exception classes are defined in this class: =cut -use Exception::Class ( - #------------------------------------------------------------------- =head2 WebGUI::Error @@ -85,11 +83,6 @@ A read only exception method that returns the package name where the exception w =cut - 'WebGUI::Error' => { - description => "A general error occured.", - }, - - #------------------------------------------------------------------- =head2 WebGUI::Error::OverrideMe @@ -98,12 +91,6 @@ An interface was not overriden as expected. =cut - 'WebGUI::Error::OverrideMe' => { - isa => 'WebGUI::Error', - description => 'This method should be overridden by subclasses.', - }, - - #------------------------------------------------------------------- =head2 WebGUI::Error::MethodNotFound @@ -116,13 +103,6 @@ The method called. =cut - 'WebGUI::Error::MethodNotFound' => { - isa => 'WebGUI::Error', - description => q|Called a method that doesn't exist.|, - fields => 'method' - }, - - #------------------------------------------------------------------- =head2 WebGUI::Error::InvalidObject @@ -139,13 +119,6 @@ The object type we got. =cut - 'WebGUI::Error::InvalidObject' => { - isa => 'WebGUI::Error::InvalidParam', - description => "Expected to get a reference to an object type that wasn't gotten.", - fields => ["expected","got"], - }, - - #------------------------------------------------------------------- =head2 WebGUI::Error::InvalidParam @@ -158,13 +131,6 @@ Used to return the bad parameter, if present. =cut - 'WebGUI::Error::InvalidParam' => { - isa => 'WebGUI::Error', - description => "Expected to get a param we didn't get.", - fields => ["param"], - }, - - #------------------------------------------------------------------- =head2 WebGUI::Error::ObjectNotFound @@ -177,13 +143,6 @@ The id of the object to be retrieved. =cut - 'WebGUI::Error::ObjectNotFound' => { - isa => 'WebGUI::Error', - description => "The object you were trying to retrieve does not exist.", - fields => ["id"], - }, - - #------------------------------------------------------------------- =head2 WebGUI::Error::ObjectNotFound::Template @@ -196,13 +155,6 @@ The id of the object to be retrieved. =cut - 'WebGUI::Error::ObjectNotFound::Template' => { - isa => 'WebGUI::Error', - description => "The template an asset was trying to retrieve does not exist.", - fields => [qw/templateId assetId/], - }, - - #------------------------------------------------------------------- =head2 WebGUI::Error::InvalidFile @@ -219,13 +171,6 @@ The line the error was found on. =cut - 'WebGUI::Error::InvalidFile' => { - isa => 'WebGUI::Error', - description => "The file you have provided has errors.", - fields => [qw{ brokenFile brokenLine }], - }, - - #------------------------------------------------------------------- =head2 WebGUI::Error::Template @@ -234,12 +179,6 @@ Used when a template has parsing errors. ISA WebGUI::Error. =cut - 'WebGUI::Error::Template' => { - isa => 'WebGUI::Error', - description => "A template has errors that prevent it from being processed.", - }, - - #------------------------------------------------------------------- =head2 WebGUI::Error::Connection @@ -252,6 +191,67 @@ 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.", diff --git a/lib/WebGUI/Session.pm b/lib/WebGUI/Session.pm index 4e0f6ad92..e4a0c139b 100644 --- a/lib/WebGUI/Session.pm +++ b/lib/WebGUI/Session.pm @@ -467,7 +467,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/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/t/Cache.t b/t/Cache.t index 2cf4ea095..f5684b189 100644 --- a/t/Cache.t +++ b/t/Cache.t @@ -45,9 +45,9 @@ my ($a, $b) = @{$cache->mget(["Shawshank",["andy", "dufresne"]])}; is($a, "Prison", "mget first value"); is($b, "Prisoner", "mget second value"); $cache->delete("Shawshank"); -is($cache->get("Shawshank"), undef, 'delete'); +is(eval{$cache->get("Shawshank")}, undef, 'delete'); $cache->flush; -is($cache->get(["andy", "dufresne"]), undef, 'flush'); +is(eval{$cache->get(["andy", "dufresne"])}, undef, 'flush'); $cache->setByHttp("google", "http://www.google.com/"); cmp_ok($cache->get("google"), 'ne', '', 'setByHttp'); From ccff9c7014a1facec81b3453166dd07533cf58a9 Mon Sep 17 00:00:00 2001 From: JT Smith Date: Fri, 25 Sep 2009 22:24:33 -0500 Subject: [PATCH 14/23] Converted all existing uses of cache. --- lib/WebGUI/Asset.pm | 13 ++++++------- lib/WebGUI/Asset/File.pm | 7 +++---- lib/WebGUI/Asset/File/Image.pm | 14 +++----------- lib/WebGUI/Asset/File/ZipArchive.pm | 5 +++-- lib/WebGUI/Asset/Post.pm | 3 +-- lib/WebGUI/Asset/Post/Thread.pm | 6 +++--- lib/WebGUI/Asset/Shortcut.pm | 8 ++++---- lib/WebGUI/Asset/Sku/Product.pm | 8 ++++---- lib/WebGUI/Asset/Snippet.pm | 10 +++++----- lib/WebGUI/Asset/Wobject/Article.pm | 8 ++++---- lib/WebGUI/Asset/Wobject/Collaboration.pm | 11 ++++++----- .../Asset/Wobject/EventManagementSystem.pm | 1 - lib/WebGUI/Asset/Wobject/Folder.pm | 9 ++++----- lib/WebGUI/Asset/Wobject/HttpProxy.pm | 17 ++++++++--------- lib/WebGUI/Asset/Wobject/Layout.pm | 7 +++---- lib/WebGUI/Asset/Wobject/Matrix.pm | 14 ++++++-------- lib/WebGUI/Asset/Wobject/MessageBoard.pm | 8 ++++---- lib/WebGUI/Asset/Wobject/MultiSearch.pm | 8 ++++---- lib/WebGUI/Asset/Wobject/SQLReport.pm | 8 ++++---- lib/WebGUI/Asset/Wobject/Survey.pm | 1 - lib/WebGUI/Asset/Wobject/SyndicatedContent.pm | 15 +++++++-------- lib/WebGUI/Asset/Wobject/Thingy.pm | 4 ++-- lib/WebGUI/AssetLineage.pm | 3 +-- lib/WebGUI/AssetTrash.pm | 1 - lib/WebGUI/Group.pm | 18 ++++++++++-------- lib/WebGUI/Operation/Cache.pm | 16 +++++----------- lib/WebGUI/Operation/Settings.pm | 3 +-- lib/WebGUI/Operation/Statistics.pm | 7 +++---- lib/WebGUI/Session.pm | 1 + lib/WebGUI/User.pm | 10 +++------- lib/WebGUI/i18n/English/WebGUI.pm | 8 -------- 31 files changed, 108 insertions(+), 144 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 202fab508..3c81459f3 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,8 +1777,7 @@ sub new { return undef unless $revisionDate; } - my $cache = WebGUI::Cache->new($session, ["asset",$assetId,$revisionDate]); - my $properties = $cache->get; + my $properties = $session->cache->get(["asset",$assetId,$revisionDate]); if (exists $properties->{assetId}) { # got properties from cache } @@ -2345,10 +2343,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 +2377,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]); + $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..260072765 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; + $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 = $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")); + $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..153896865 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 = $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")); + $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..0a4e44553 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 = $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")); + $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..565301fad 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); + $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..5388754f5 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 = $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")); + $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..68c0e00ed 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 = $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); + $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; + $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..dd9b6e68a 100644 --- a/lib/WebGUI/Asset/Snippet.pm +++ b/lib/WebGUI/Asset/Snippet.pm @@ -250,9 +250,9 @@ 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 $self->session->cache; + $cache->delete("view__".$self->getId); + $cache->delete("view_1_".$self->getId); $self->SUPER::purgeCache(); } @@ -279,7 +279,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 = $session->cache("view_".$calledAsWebMethod."_".$self->getId); return $out if $out; } my $output = $self->get('usePacked') @@ -292,7 +292,7 @@ sub view { } WebGUI::Macro::process($session,\$output); unless ($noCache) { - WebGUI::Cache->new($session,"view_".$calledAsWebMethod."_".$self->getId)->set($output,$self->get("cacheTimeout")); + $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..f0d5774b7 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; + $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 = $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")); + $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..0cf10f27d 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,9 @@ 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; + $cache->delete("view_".$self->getId); + $cache->delete($self->_visitorCacheKey); $self->next::method; } @@ -1549,8 +1549,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 = $cache->get($self->_visitorCacheKey); $self->session->errorHandler->debug("HIT") if $out; return $out if $out; } @@ -1561,7 +1562,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")); + $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..567f301c1 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; + $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 = $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")); + $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..b0b271c32 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,9 @@ 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; + $cache->delete([$self->get("proxiedUrl"),"URL"]); + $cache->delete([$self->get("proxiedUrl"),"HEADER"]); $self->SUPER::purgeCache; } @@ -320,12 +320,11 @@ 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"); + my $cache = $self->session->cache; if ($requestMethod =~ /^GET$/i) { - $var{header} = $cacheHeader->get; - $var{content} = $cacheContent->get; + $var{header} = $cache->get([$proxiedUrl,'HEADER']); + $var{content} = $cache->get([$proxiedUrl,"URL"]); } # Unless we have cached content @@ -465,8 +464,8 @@ 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")); + $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..9efedb3e9 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 = $cache->get($cacheKey); unless ($out) { $self->prepareView; $session->stow->set("cacheFixOverride", 1); $out = $self->processStyle($self->view, { noHeadTags => 1 }); - $cache->set($out, 60); + $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..147f038ee 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 = $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") - ); + $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 = $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") - ); + $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..a640113d4 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; + $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 = $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")); + $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..046f07b40 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; + $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 = $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")); + $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..1e65e7c8f 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; + $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 = $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")); + $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..a1722c820 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 = $cache->get($url); unless ($value) { - $value = $cache->setByHTTP($url, $self->get("cacheTimeout")); + $value = $cache->setByHttp($url, $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; + $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 = $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")); + $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..4ccff1dca 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 = $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); + $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 3a948c69d..98aedb717 100644 --- a/lib/WebGUI/AssetLineage.pm +++ b/lib/WebGUI/AssetLineage.pm @@ -147,9 +147,8 @@ 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; + $self->session->cache->flush; } else { my $descendants = $self->session->db->read("SELECT assetId FROM asset WHERE lineage LIKE ?", [$newLineage . '%']); 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/Group.pm b/lib/WebGUI/Group.pm index c7b594861..1024b87b0 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; + $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; + $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 = $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); + $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..d41952a83 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; + $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..d2a4be3b5 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" ] ); + $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..94e3ca320 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 = $cache->get($url); if (not defined $version) { - $version = $cache->setByHTTP($url,43200); + $version = $cache->setByHttp($url, $url, 43200); } chomp $version; $output .= ''; diff --git a/lib/WebGUI/Session.pm b/lib/WebGUI/Session.pm index e4a0c139b..12b75faf6 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; diff --git a/lib/WebGUI/User.pm b/lib/WebGUI/User.pm index 0008a94ce..597fecc42 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); + $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 = $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; + $self->session->cache->delete(["user",$self->userId]); } #---------------------------------------------------------------------------- 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 From ebb6134c2dffe53a6511ec6759225b20591e6f9d Mon Sep 17 00:00:00 2001 From: JT Smith Date: Fri, 25 Sep 2009 22:50:59 -0500 Subject: [PATCH 15/23] bug fixes --- lib/WebGUI/Asset.pm | 6 +- lib/WebGUI/Asset/File.pm | 6 +- lib/WebGUI/Asset/File/Image.pm | 4 +- lib/WebGUI/Asset/File/ZipArchive.pm | 4 +- lib/WebGUI/Asset/Post.pm | 2 +- lib/WebGUI/Asset/Post/Thread.pm | 4 +- lib/WebGUI/Asset/Shortcut.pm | 6 +- lib/WebGUI/Asset/Snippet.pm | 8 +- lib/WebGUI/Asset/Wobject/Article.pm | 6 +- lib/WebGUI/Asset/Wobject/Collaboration.pm | 10 +- lib/WebGUI/Asset/Wobject/Folder.pm | 6 +- lib/WebGUI/Asset/Wobject/HttpProxy.pm | 21 ++- lib/WebGUI/Asset/Wobject/Layout.pm | 4 +- lib/WebGUI/Asset/Wobject/Matrix.pm | 8 +- lib/WebGUI/Asset/Wobject/MessageBoard.pm | 6 +- lib/WebGUI/Asset/Wobject/MultiSearch.pm | 6 +- lib/WebGUI/Asset/Wobject/SQLReport.pm | 6 +- lib/WebGUI/Asset/Wobject/SyndicatedContent.pm | 10 +- lib/WebGUI/Asset/Wobject/Thingy.pm | 4 +- lib/WebGUI/AssetLineage.pm | 7 +- lib/WebGUI/Group.pm | 8 +- lib/WebGUI/Operation/Cache.pm | 2 +- lib/WebGUI/Operation/Settings.pm | 2 +- lib/WebGUI/Operation/Statistics.pm | 4 +- lib/WebGUI/User.pm | 6 +- sbin/preload.exclude.example | 1 - sbin/testmc.pl | 141 ------------------ 27 files changed, 84 insertions(+), 214 deletions(-) delete mode 100644 sbin/testmc.pl diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 3c81459f3..c61a95efc 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -1777,7 +1777,7 @@ sub new { return undef unless $revisionDate; } - my $properties = $session->cache->get(["asset",$assetId,$revisionDate]); + my $properties = eval{$session->cache->get(["asset",$assetId,$revisionDate])}; if (exists $properties->{assetId}) { # got properties from cache } @@ -1787,7 +1787,7 @@ sub new { $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 }; @@ -2377,7 +2377,7 @@ sub purgeCache { $stow->delete('assetLineage'); $stow->delete('assetClass'); $stow->delete('assetRevision'); - $self->session->cache->delete(["asset",$self->getId,$self->get("revisionDate")]); + 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 260072765..19b5410b9 100644 --- a/lib/WebGUI/Asset/File.pm +++ b/lib/WebGUI/Asset/File.pm @@ -447,7 +447,7 @@ Extends the master method to clear the view cache. sub purgeCache { my $self = shift; - $self->session->cache->delete("view_".$self->getId); + eval{$self->session->cache->delete("view_".$self->getId)}; $self->SUPER::purgeCache; } @@ -607,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 = $self->session->cache->get("view_".$self->getId); + my $out = eval{$self->session->cache->get("view_".$self->getId)}; return $out if $out; } my %var = %{$self->get}; @@ -617,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) { - $self->session->cache->set("view_".$self->getId, $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 153896865..711ae6b4c 100644 --- a/lib/WebGUI/Asset/File/Image.pm +++ b/lib/WebGUI/Asset/File/Image.pm @@ -224,7 +224,7 @@ sub view { my $self = shift; my $cache = $self->session->cache; if (!$self->session->var->isAdminOn && $self->get("cacheTimeout") > 10) { - my $out = $cache->get("view_".$self->getId); + my $out = eval{$cache->get("view_".$self->getId)}; return $out if $out; } my %var = %{$self->get}; @@ -248,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) { - $cache->set("view_".$self->getId, $out, $self->get("cacheTimeout")); + eval{$cache->set("view_".$self->getId, $out, $self->get("cacheTimeout"))}; } return $out; } diff --git a/lib/WebGUI/Asset/File/ZipArchive.pm b/lib/WebGUI/Asset/File/ZipArchive.pm index 0a4e44553..9fbca6fd7 100644 --- a/lib/WebGUI/Asset/File/ZipArchive.pm +++ b/lib/WebGUI/Asset/File/ZipArchive.pm @@ -222,7 +222,7 @@ sub view { my $self = shift; my $cache = $self->session->cache; if (!$self->session->var->isAdminOn && $self->get("cacheTimeout") > 10) { - my $out = $cache->get("view_".$self->getId); + my $out = eval{$cache->get("view_".$self->getId)}; return $out if $out; } my %var = %{$self->get}; @@ -245,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) { - $cache->set("view_".$self->getId, $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 565301fad..4f23e02fe 100644 --- a/lib/WebGUI/Asset/Post.pm +++ b/lib/WebGUI/Asset/Post.pm @@ -1187,7 +1187,7 @@ Extend the base class to handle caching. sub purgeCache { my $self = shift; - $self->session->cache->delete("view_".$self->getThread->getId) 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 5388754f5..02f8dd9c1 100644 --- a/lib/WebGUI/Asset/Post/Thread.pm +++ b/lib/WebGUI/Asset/Post/Thread.pm @@ -1027,7 +1027,7 @@ sub view { $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 = $cache->get("view_".$self->getId); + 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")) { - $cache->set("view_".$self->getId, $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 68c0e00ed..9b0f6edc0 100644 --- a/lib/WebGUI/Asset/Shortcut.pm +++ b/lib/WebGUI/Asset/Shortcut.pm @@ -484,7 +484,7 @@ sub getOverrides { my $cache = $session->cache; my $u = WebGUI::User->new($self->session, $self->discernUserId); - my $overridesRef = $cache->get($self->_overridesCacheTag); + 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($self->_overridesCacheTag, \%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; - $self->session->cache->delete($self->_overridesCacheTag); + eval{$self->session->cache->delete($self->_overridesCacheTag)}; } #------------------------------------------------------------------- diff --git a/lib/WebGUI/Asset/Snippet.pm b/lib/WebGUI/Asset/Snippet.pm index dd9b6e68a..e6e6fbded 100644 --- a/lib/WebGUI/Asset/Snippet.pm +++ b/lib/WebGUI/Asset/Snippet.pm @@ -251,8 +251,10 @@ Extending purgeCache to handle caching of the rendered snippet sub purgeCache { my $self = shift; my $self->session->cache; - $cache->delete("view__".$self->getId); - $cache->delete("view_1_".$self->getId); + eval { + $cache->delete("view__".$self->getId); + $cache->delete("view_1_".$self->getId); + }; $self->SUPER::purgeCache(); } @@ -292,7 +294,7 @@ sub view { } WebGUI::Macro::process($session,\$output); unless ($noCache) { - $session->cache->set("view_".$calledAsWebMethod."_".$self->getId, $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 f0d5774b7..cc02a5558 100644 --- a/lib/WebGUI/Asset/Wobject/Article.pm +++ b/lib/WebGUI/Asset/Wobject/Article.pm @@ -318,7 +318,7 @@ See WebGUI::Asset::purgeCache() for details. sub purgeCache { my $self = shift; - $self->session->cache->delete("view_".$self->getId); + eval{$self->session->cache->delete("view_".$self->getId)}; $self->SUPER::purgeCache; } @@ -350,7 +350,7 @@ sub view { 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 = $cache->get("view_".$self->getId); + 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")) { - $cache->set("view_".$self->getId, $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 0cf10f27d..867b58478 100644 --- a/lib/WebGUI/Asset/Wobject/Collaboration.pm +++ b/lib/WebGUI/Asset/Wobject/Collaboration.pm @@ -1404,8 +1404,10 @@ Extend the base method to delete view and visitor caches. sub purgeCache { my $self = shift; my $cache = $self->session->cache; - $cache->delete("view_".$self->getId); - $cache->delete($self->_visitorCacheKey); + eval { + $cache->delete("view_".$self->getId); + $cache->delete($self->_visitorCacheKey); + }; $self->next::method; } @@ -1551,7 +1553,7 @@ sub view { my $self = shift; my $cache = $self->session->cache; if ($self->_visitorCacheOk) { - my $out = $cache->get($self->_visitorCacheKey); + my $out = eval{$cache->get($self->_visitorCacheKey)}; $self->session->errorHandler->debug("HIT") if $out; return $out if $out; } @@ -1562,7 +1564,7 @@ sub view { $self->prepareView unless ($self->{_viewTemplate}); my $out = $self->processTemplate($self->getViewTemplateVars,undef,$self->{_viewTemplate}); if ($self->_visitorCacheOk) { - $cache->set($self->_visitorCacheKey, $out, $self->get("visitorCacheTimeout")); + eval{$cache->set($self->_visitorCacheKey, $out, $self->get("visitorCacheTimeout"))}; } return $out; } diff --git a/lib/WebGUI/Asset/Wobject/Folder.pm b/lib/WebGUI/Asset/Wobject/Folder.pm index 567f301c1..d7d8b1018 100644 --- a/lib/WebGUI/Asset/Wobject/Folder.pm +++ b/lib/WebGUI/Asset/Wobject/Folder.pm @@ -207,7 +207,7 @@ See WebGUI::Asset::purgeCache() for details. sub purgeCache { my $self = shift; - $self->session->cache->delete("view_".$self->getId); + eval{$self->session->cache->delete("view_".$self->getId)}; $self->SUPER::purgeCache; } @@ -226,7 +226,7 @@ sub view { # Use cached version for visitors my $cache = $self->session->cache; if ($self->session->user->isVisitor) { - my $out = $cache->get("view_".$self->getId); + my $out = eval{$cache->get("view_".$self->getId)}; return $out if $out; } @@ -291,7 +291,7 @@ sub view { # Update the cache if ($self->session->user->isVisitor) { - $cache->set("view_".$self->getId, $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 b0b271c32..a05e9806a 100644 --- a/lib/WebGUI/Asset/Wobject/HttpProxy.pm +++ b/lib/WebGUI/Asset/Wobject/HttpProxy.pm @@ -277,8 +277,10 @@ See WebGUI::Asset::purgeCache() for details. sub purgeCache { my $self = shift; my $cache = $self->session->cache; - $cache->delete([$self->get("proxiedUrl"),"URL"]); - $cache->delete([$self->get("proxiedUrl"),"HEADER"]); + eval { + $cache->delete([$self->get("proxiedUrl"),"URL"]); + $cache->delete([$self->get("proxiedUrl"),"HEADER"]); + }; $self->SUPER::purgeCache; } @@ -321,10 +323,11 @@ sub view { ### Do we have cached content to get? my $cache = $self->session->cache; - if ($requestMethod =~ /^GET$/i) - { - $var{header} = $cache->get([$proxiedUrl,'HEADER']); - $var{content} = $cache->get([$proxiedUrl,"URL"]); + if ($requestMethod =~ /^GET$/i) { + eval { + $var{header} = $cache->get([$proxiedUrl,'HEADER']); + $var{content} = $cache->get([$proxiedUrl,"URL"]); + }; } # Unless we have cached content @@ -464,8 +467,10 @@ sub view { $var{content} = sprintf $i18n->get('fetch page error'), $proxiedUrl, $proxiedUrl, $response->status_line; } unless ($self->get("cacheTimeout") <= 10) { - $cache->set([$proxiedUrl,'URL'], $var{content}, $self->get("cacheTimeout")); - $cache->set([$proxiedUrl,'HEADER'], $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 9efedb3e9..5ac97afdf 100644 --- a/lib/WebGUI/Asset/Wobject/Layout.pm +++ b/lib/WebGUI/Asset/Wobject/Layout.pm @@ -413,12 +413,12 @@ sub www_view { $cacheKey .= '_ssl'; } my $cache = $session->cache; - my $out = $cache->get($cacheKey); + my $out = eval{$cache->get($cacheKey)}; unless ($out) { $self->prepareView; $session->stow->set("cacheFixOverride", 1); $out = $self->processStyle($self->view, { noHeadTags => 1 }); - $cache->set($cacheKey, $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 147f038ee..cc9f3b83d 100644 --- a/lib/WebGUI/Asset/Wobject/Matrix.pm +++ b/lib/WebGUI/Asset/Wobject/Matrix.pm @@ -507,7 +507,7 @@ sub getListings { || ($versionTag && $versionTag->getId eq $self->get("tagId")); my $cache = $session->cache; unless ($noCache) { - $listingsEncoded = $cache->get("matrixListings_".$self->getId); + $listingsEncoded = eval{$cache->get("matrixListings_".$self->getId)}; } if ($listingsEncoded){ @@ -547,7 +547,7 @@ assetData.revisionDate } $listingsEncoded = JSON->new->encode($listings); - $cache->set("matrixListings_".$self->getId, $listingsEncoded, $self->get("listingsCacheTimeout")); + eval{$cache->set("matrixListings_".$self->getId, $listingsEncoded, $self->get("listingsCacheTimeout"))}; } return $listings; } @@ -688,7 +688,7 @@ sub view { || ($versionTag && $versionTag->getId eq $self->get("tagId")); my $cache = $session->cache; unless ($noCache) { - $varStatisticsEncoded = $cache->get("matrixStatistics_".$self->getId); + $varStatisticsEncoded = eval{$cache->get("matrixStatistics_".$self->getId)}; } if ($varStatisticsEncoded){ @@ -837,7 +837,7 @@ sub view { [$self->getId]); $varStatisticsEncoded = JSON->new->encode($varStatistics); - $cache->set("matrixStatistics_".$self->getId, $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 a640113d4..f48bbce0f 100644 --- a/lib/WebGUI/Asset/Wobject/MessageBoard.pm +++ b/lib/WebGUI/Asset/Wobject/MessageBoard.pm @@ -90,7 +90,7 @@ See WebGUI::Asset::purgeCache() for details. sub purgeCache { my $self = shift; - $self->session->cache->delete("view_".$self->getId); + eval{$self->session->cache->delete("view_".$self->getId)}; $self->SUPER::purgeCache; } @@ -106,7 +106,7 @@ sub view { my $self = shift; my $cache = $self->session->cache; if ($self->session->user->isVisitor) { - my $out = $cache->get("view_".$self->getId); + 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) { - $cache->set("view_".$self->getId, $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 046f07b40..345d35aee 100644 --- a/lib/WebGUI/Asset/Wobject/MultiSearch.pm +++ b/lib/WebGUI/Asset/Wobject/MultiSearch.pm @@ -113,7 +113,7 @@ See WebGUI::Asset::purgeCache() for details. sub purgeCache { my $self = shift; - $self->session->cache->delete("view_".$self->getId); + eval{$self->session->cache->delete("view_".$self->getId)}; $self->SUPER::purgeCache; } @@ -130,7 +130,7 @@ sub view { my $self = shift; my $cache = $self->session->cache; if (!$self->session->var->isAdminOn && $self->get("cacheTimeout") > 10) { - my $out = $cache->get("view_".$self->getId); + 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) { - $cache->set("view_".$self->getId, $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 1e65e7c8f..89b7a01de 100644 --- a/lib/WebGUI/Asset/Wobject/SQLReport.pm +++ b/lib/WebGUI/Asset/Wobject/SQLReport.pm @@ -517,7 +517,7 @@ See WebGUI::Asset::purgeCache() for details. sub purgeCache { my $self = shift; - $self->session->cache->delete("view_".$self->getId); + eval{$self->session->cache->delete("view_".$self->getId)}; $self->SUPER::purgeCache; } @@ -534,7 +534,7 @@ sub view { my $self = shift; my $cache = $self->session->cache; if (!$self->session->var->isAdminOn && $self->get("cacheTimeout") > 10) { - my $out = $cache->get("view_".$self->getId); + 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) { - $cache->set("view_".$self->getId, $out, $self->get("cacheTimeout")); + eval{$cache->set("view_".$self->getId, $out, $self->get("cacheTimeout"))}; } return $out; } diff --git a/lib/WebGUI/Asset/Wobject/SyndicatedContent.pm b/lib/WebGUI/Asset/Wobject/SyndicatedContent.pm index a1722c820..a0c73ba9a 100644 --- a/lib/WebGUI/Asset/Wobject/SyndicatedContent.pm +++ b/lib/WebGUI/Asset/Wobject/SyndicatedContent.pm @@ -142,9 +142,9 @@ sub generateFeed { if ($self->get('processMacroInRssUrl')) { WebGUI::Macro::process($self->session, \$url); } - my $value = $cache->get($url); + my $value = eval{$cache->get($url)}; unless ($value) { - $value = $cache->setByHttp($url, $url, $self->get("cacheTimeout")); + $value = eval{$cache->setByHttp($url, $url, $self->get("cacheTimeout"))}; $newlyCached = 1; } # if the content can be downgraded, it is either valid latin1 or didn't have @@ -327,7 +327,7 @@ See WebGUI::Asset::purgeCache() for details. sub purgeCache { my $self = shift; - $self->session->cache->delete("view_".$self->getId); + eval{$self->session->cache->delete("view_".$self->getId)}; $self->next::method; } @@ -345,7 +345,7 @@ sub view { # try the cached version my $cache = $session->cache; - my $out = $cache->get("view_".$self->getId); + my $out = eval{$cache->get("view_".$self->getId)}; return $out if ($out ne "" && !$session->var->isAdminOn); #return $out if $out; @@ -353,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("view_".$self->getId, $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 4ccff1dca..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 = $session->cache->get("query_".$thingId); + $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 - $self->session->cache->set("query_".$thingId, $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 98aedb717..cc9a1c444 100644 --- a/lib/WebGUI/AssetLineage.pm +++ b/lib/WebGUI/AssetLineage.pm @@ -148,12 +148,15 @@ sub cascadeLineage { [$newLineage, length($oldLineage) + 1, $oldLineage . '%'] ); if ($records > 20) { - $self->session->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; } diff --git a/lib/WebGUI/Group.pm b/lib/WebGUI/Group.pm index 1024b87b0..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; - $self->session->cache->delete($self->getId); + eval{$self->session->cache->delete($self->getId)}; GROUP: foreach my $gid (@{$groups}) { next if ($gid eq '1'); next if ($gid eq $self->getId); @@ -234,7 +234,7 @@ sub clearCaches { my $groups = $self->getAllGroupsFor(); my $cache = $self->session->cache; foreach my $group ( $self->getId, @{ $groups } ) { - $cache->delete($group); + eval{$cache->delete($group)}; } my $stow = $self->session->stow; $stow->delete("groupObj"); @@ -563,7 +563,7 @@ sub getAllUsers { my $loopCount = shift; my $expireTime = 0; my $cache = $self->session->cache; - my $value = $cache->get($self->getId); + my $value = eval{$cache->get($self->getId)}; return $value if defined $value; my @users = (); push @users, @@ -588,7 +588,7 @@ sub getAllUsers { } my %users = map { $_ => 1 } @users; @users = keys %users; - $cache->set($self->getId, \@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 d41952a83..727a36143 100644 --- a/lib/WebGUI/Operation/Cache.pm +++ b/lib/WebGUI/Operation/Cache.pm @@ -92,7 +92,7 @@ sub www_flushCache { return $session->privilege->adminOnly unless canView($session); # Flush the cache - $session->cache->flush; + eval{$session->cache->flush}; return www_manageCache($session); } diff --git a/lib/WebGUI/Operation/Settings.pm b/lib/WebGUI/Operation/Settings.pm index d2a4be3b5..33293730e 100644 --- a/lib/WebGUI/Operation/Settings.pm +++ b/lib/WebGUI/Operation/Settings.pm @@ -726,7 +726,7 @@ sub www_saveSettings { $session->db->write( "UPDATE userProfileData SET showMessageOnLoginSeen=0" ); - $session->cache->flush; + 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 94e3ca320..320b7924c 100644 --- a/lib/WebGUI/Operation/Statistics.pm +++ b/lib/WebGUI/Operation/Statistics.pm @@ -180,9 +180,9 @@ sub www_viewStatistics { my $i18n = WebGUI::International->new($session); my $url = "http://update.webgui.org/latest-version.txt"; my $cache = $session->cache; - my $version = $cache->get($url); + my $version = eval{$cache->get($url)}; if (not defined $version) { - $version = $cache->setByHttp($url, $url, 43200); + $version = eval{$cache->setByHttp($url, $url, 43200)}; } chomp $version; $output .= '
'; diff --git a/lib/WebGUI/User.pm b/lib/WebGUI/User.pm index 597fecc42..a849befa8 100644 --- a/lib/WebGUI/User.pm +++ b/lib/WebGUI/User.pm @@ -286,7 +286,7 @@ sub cache { for my $k (qw(_userId _user _profile)) { $userData{$k} = $self->{$k}; } - $self->session->cache->set(["user",$self->userId], \%userData, 60*60*24); + eval{$self->session->cache->set(["user",$self->userId], \%userData, 60*60*24)}; } #------------------------------------------------------------------- @@ -1060,7 +1060,7 @@ sub new { my $userId = shift || 1; my $overrideId = shift; $userId = _create($session, $overrideId) if ($userId eq "new"); - my $self = $session->cache->get(["user",$userId]) || {}; + my $self = eval{$session->cache->get(["user",$userId])} || {}; bless $self, $class; $self->{_session} = $session; unless ($self->{_userId} && $self->{_user}{username}) { @@ -1334,7 +1334,7 @@ Deletes this user object out of the cache. sub uncache { my $self = shift; - $self->session->cache->delete(["user",$self->userId]); + eval{$self->session->cache->delete(["user",$self->userId])}; } #---------------------------------------------------------------------------- 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/testmc.pl b/sbin/testmc.pl deleted file mode 100644 index 0d847e4a7..000000000 --- a/sbin/testmc.pl +++ /dev/null @@ -1,141 +0,0 @@ -#!/usr/bin/env 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 -#------------------------------------------------------------------- - -$|++; # disable output buffering -our ($webguiRoot, $configFile, $help, $man); - -BEGIN { - $webguiRoot = ".."; - unshift (@INC, $webguiRoot."/lib"); -} - -use strict; -use Pod::Usage; -use Getopt::Long; -use WebGUI::Session; -use Config::JSON; -use WebGUI::Cache; -use Time::HiRes; - -# Get parameters here, including $help -GetOptions( - 'configFile=s' => \$configFile, - 'help' => \$help, - 'man' => \$man, -); - -pod2usage( verbose => 1 ) if $help; -pod2usage( verbose => 2 ) if $man; -pod2usage( msg => "Must specify a config file!" ) unless $configFile; -my $session = start( $webguiRoot, $configFile ); -print "creating cache object\n"; -my $cache = WebGUI::Cache->new($session); -print "setting cache\n"; -my $t = [Time::HiRes::gettimeofday]; -my @keys; -my $sth = $session->db->read("select assetId, revisionDate, title from assetData"); -while (my ($id, $rev, $title) = $sth->array) { - push @keys, [$id, $rev]; - $cache->set([$id,$rev],$title); -} -print "Took ".Time::HiRes::tv_interval($t)." seconds to set ".scalar(@keys)." cache objects.\n"; -print "fetching cache\n"; -my $t = [Time::HiRes::gettimeofday]; -foreach my $key (@keys) { - my $value = $cache->get($key); -} -print "Took ".Time::HiRes::tv_interval($t)." seconds to get ".scalar(@keys)." cache objects.\n"; -print "done\n"; - - -finish($session); - -#---------------------------------------------------------------------------- -# Your sub here - -#---------------------------------------------------------------------------- -sub start { - my $webguiRoot = shift; - my $configFile = shift; - my $session = WebGUI::Session->open($webguiRoot,$configFile); - $session->user({userId=>3}); - - ## If your script is adding or changing content you need these lines, otherwise leave them commented - # - # my $versionTag = WebGUI::VersionTag->getWorking($session); - # $versionTag->set({name => 'Name Your Tag'}); - # - ## - - return $session; -} - -#---------------------------------------------------------------------------- -sub finish { - my $session = shift; - - ## If your script is adding or changing content you need these lines, otherwise leave them commented - # - # my $versionTag = WebGUI::VersionTag->getWorking($session); - # $versionTag->commit; - ## - - $session->var->end; - $session->close; -} - -__END__ - - -=head1 NAME - -utility - A template for WebGUI utility scripts - -=head1 SYNOPSIS - - utility --configFile config.conf ... - - utility --help - -=head1 DESCRIPTION - -This WebGUI utility script helps you... - -=head1 ARGUMENTS - -=head1 OPTIONS - -=over - -=item B<--configFile config.conf> - -The WebGUI config file to use. Only the file name needs to be specified, -since it will be looked up inside WebGUI's configuration directory. -This parameter is required. - -=item B<--help> - -Shows a short summary and usage - -=item B<--man> - -Shows this document - -=back - -=head1 AUTHOR - -Copyright 2001-2009 Plain Black Corporation. - -=cut - -#vim:ft=perl From 0c6b814ed42f011cd39c706d8c350b387f87a754 Mon Sep 17 00:00:00 2001 From: JT Smith Date: Sat, 26 Sep 2009 11:56:30 -0500 Subject: [PATCH 16/23] more bug fixes --- lib/WebGUI/Asset/Snippet.pm | 2 +- lib/WebGUI/Operation/Cache.pm | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/lib/WebGUI/Asset/Snippet.pm b/lib/WebGUI/Asset/Snippet.pm index e6e6fbded..a7ef0a824 100644 --- a/lib/WebGUI/Asset/Snippet.pm +++ b/lib/WebGUI/Asset/Snippet.pm @@ -250,7 +250,7 @@ Extending purgeCache to handle caching of the rendered snippet sub purgeCache { my $self = shift; - my $self->session->cache; + my $cache = $self->session->cache; eval { $cache->delete("view__".$self->getId); $cache->delete("view_1_".$self->getId); diff --git a/lib/WebGUI/Operation/Cache.pm b/lib/WebGUI/Operation/Cache.pm index 727a36143..6715b894c 100644 --- a/lib/WebGUI/Operation/Cache.pm +++ b/lib/WebGUI/Operation/Cache.pm @@ -112,12 +112,12 @@ sub www_manageCache { my $flushURL = $session->url->page('op=flushCache'); my $i18n = WebGUI::International->new($session); my $output = - WebGUI::Form::formHeader($session); + WebGUI::Form::formHeader($session) .WebGUI::Form::button($session, { value => $i18n->get("clear cache"), extras => qq{onclick="document.location.href='$flushURL';"}, }) - .WebGUI::Form::formFooter($session); + .WebGUI::Form::formFooter($session) ; return _submenu($session,$output); From d399f23bafe98f6e64d108ff83e8a6a549b87aad Mon Sep 17 00:00:00 2001 From: JT Smith Date: Sun, 27 Sep 2009 13:21:40 -0500 Subject: [PATCH 17/23] fixed bugs, adding logging --- lib/WebGUI/Asset/Snippet.pm | 2 +- lib/WebGUI/Cache.pm | 49 ++++++++++++++++++++++++++++++++++--- 2 files changed, 47 insertions(+), 4 deletions(-) diff --git a/lib/WebGUI/Asset/Snippet.pm b/lib/WebGUI/Asset/Snippet.pm index a7ef0a824..e6c4124b0 100644 --- a/lib/WebGUI/Asset/Snippet.pm +++ b/lib/WebGUI/Asset/Snippet.pm @@ -281,7 +281,7 @@ sub view { || $self->get("cacheTimeout") <= 10 || ($versionTag && $versionTag->getId eq $self->get("tagId")); unless ($noCache) { - my $out = $session->cache("view_".$calledAsWebMethod."_".$self->getId); + my $out = eval{$session->cache->get("view_".$calledAsWebMethod."_".$self->getId)}; return $out if $out; } my $output = $self->get('usePacked') diff --git a/lib/WebGUI/Cache.pm b/lib/WebGUI/Cache.pm index 4fecdfe74..b4aa71478 100644 --- a/lib/WebGUI/Cache.pm +++ b/lib/WebGUI/Cache.pm @@ -46,6 +46,7 @@ An API that allows you to cache items to a memcached server. $cache->setByHttp($name, "http://www.google.com/"); my $value = $cache->get($name); + my ($val1, $val2) = @{$cache->mget([$name1, $name2])}; $cache->delete($name); @@ -64,6 +65,8 @@ These methods are available from this class: Delete a key from the cache. +Throws WebGUI::Error::InvalidParam, WebGUI::Error::Connection and WebGUI::Error. + =head3 name The key to delete. @@ -75,14 +78,19 @@ sub delete { 1, { type => SCALAR | ARRAYREF }, ); + my $log = $self->session->log; + my $key = $self->parseKey($name); + $log->debug("Called delete() on cache key $key."); my $memcached = $self->getMemcached; - Memcached::libmemcached::memcached_delete($memcached, $self->parseKey($name)); + Memcached::libmemcached::memcached_delete($memcached, $key); 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." ); @@ -90,8 +98,9 @@ sub delete { 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 $name from cache because ".$memcached->errstr + error => "Couldn't delete $key from cache because ".$memcached->errstr ); } } @@ -102,6 +111,8 @@ sub delete { Empties the caching system. +Throws WebGUI::Error::Connection and WebGUI::Error. + =cut sub flush { @@ -131,6 +142,8 @@ sub flush { Retrieves a key value from the cache. +Throws WebGUI::Error::InvalidParam, WebGUI::Error::ObjectNotFound, WebGUI::Error::Connection and WebGUI::Error. + =head3 name The key to retrieve. @@ -190,6 +203,8 @@ sub getMemcached { 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 An array reference of keys to retrieve. @@ -231,6 +246,8 @@ sub mget { 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. +Throws WebGUI::Error::InvalidParam. + =head3 session A reference to the current session. @@ -263,6 +280,8 @@ sub new { Returns a formatted string version of the 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"]. @@ -309,6 +328,8 @@ sub session { Sets a key value to the cache. +Throws WebGUI::Error::InvalidParam, WebGUI::Error::Connection, and WebGUI::Error. + =head3 name The name of the key to set. @@ -358,6 +379,8 @@ sub set { 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 name The name of the key to store the request under. @@ -400,13 +423,33 @@ sub setByHttp { =head1 EXCEPTIONS -This class throws a huge number of exceptions about everything you can imagine, and many things you can't. 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: +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. + +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. + =cut From 2a94b0806cfd8ba08caa41d44a9203b27577439d Mon Sep 17 00:00:00 2001 From: JT Smith Date: Sun, 27 Sep 2009 17:33:46 -0500 Subject: [PATCH 18/23] added logging --- lib/WebGUI/Asset/Wobject/SyndicatedContent.pm | 2 +- lib/WebGUI/Cache.pm | 73 +++++++++++++------ lib/WebGUI/Operation/Statistics.pm | 2 +- t/Cache.t | 4 +- 4 files changed, 54 insertions(+), 27 deletions(-) diff --git a/lib/WebGUI/Asset/Wobject/SyndicatedContent.pm b/lib/WebGUI/Asset/Wobject/SyndicatedContent.pm index a0c73ba9a..5ccf47c86 100644 --- a/lib/WebGUI/Asset/Wobject/SyndicatedContent.pm +++ b/lib/WebGUI/Asset/Wobject/SyndicatedContent.pm @@ -144,7 +144,7 @@ sub generateFeed { } my $value = eval{$cache->get($url)}; unless ($value) { - $value = eval{$cache->setByHttp($url, $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 diff --git a/lib/WebGUI/Cache.pm b/lib/WebGUI/Cache.pm index b4aa71478..40f53ec2f 100644 --- a/lib/WebGUI/Cache.pm +++ b/lib/WebGUI/Cache.pm @@ -117,19 +117,24 @@ Throws WebGUI::Error::Connection and WebGUI::Error. sub flush { my ($self) = @_; + my $log = $self->session->log; + $log->debug("Called flush() on cache."); my $memcached = $self->getMemcached; Memcached::libmemcached::memcached_flush($memcached); 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 ); @@ -142,7 +147,7 @@ sub flush { Retrieves a key value from the cache. -Throws WebGUI::Error::InvalidParam, WebGUI::Error::ObjectNotFound, WebGUI::Error::Connection and WebGUI::Error. +Throws WebGUI::Error::InvalidObject, WebGUI::Error::InvalidParam, WebGUI::Error::ObjectNotFound, WebGUI::Error::Connection and WebGUI::Error. =head3 name @@ -155,31 +160,43 @@ sub get { 1, { type => SCALAR | ARRAYREF }, ); + my $log = $self->session->log; + my $key = $self->parseKey($name); + $log->debug("Called get() on cache key $key."); my $memcached = $self->getMemcached; - my $content = Memcached::libmemcached::memcached_get($memcached, $self->parseKey($name)); + my $content = Memcached::libmemcached::memcached_get($memcached, $key); if ($memcached->errstr eq 'NOT FOUND' ) { + $log->debug("The cache key $key has no value."); WebGUI::Error::ObjectNotFound->throw( - error => "The cache key $name has no value.", - id => $name, + 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." ); } elsif ($memcached->errstr ne 'SUCCESS') { + $log->debug("Couldn't get $key from cache because ".$memcached->errstr); WebGUI::Error->throw( - error => "Couldn't get $name from cache because ".$memcached->errstr + error => "Couldn't get $key from cache because ".$memcached->errstr ); } $content = Storable::thaw($content); - return undef unless ref $content; + unless (ref $content) { + $log->debug("Couldn't thaw value for $key."); + WebGUI::Error::InvalidObject->throw( + error => "Couldn't thaw value for $key." + ); + } return ${$content}; } @@ -216,25 +233,32 @@ sub mget { 1, { type => ARRAYREF }, ); - my @parsedNames = map { $self->parseKey($_) } @{ $names }; + my $log = $self->session->log; + my @keys = map { $self->parseKey($_) } @{ $names }; + $log->debug("Called mget() for keys (".join(", ",@keys).") on cache."); my %result; my $memcached = $self->getMemcached; - $memcached->mget_into_hashref(\@parsedNames, \%result); + $memcached->mget_into_hashref(\@keys, \%result); 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 $name (@parsedNames) { - my $content = Storable::thaw($result{$name}); - next unless ref $content; + foreach my $key (@keys) { + my $content = Storable::thaw($result{$key}); + unless (ref $content) { + $log->debug("Cannot thaw key $key."); + next; + } push @values, ${$content}; } return \@values; @@ -259,7 +283,7 @@ sub new { 1, { isa => 'WebGUI::Session' }, ); - my ($class, $session) = @_; + $session->log->debug("Instanciated cache object."); my $config = $session->config; my $namespace = $config->getFilename; my $memcached = Memcached::libmemcached::memcached_create(); # no exception because always returns success @@ -351,22 +375,28 @@ sub set { { type => SCALAR }, { type => SCALAR | UNDEF, optional => 1, default=> 60 }, ); + my $log = $self->session->log; + my $key = $self->parseKey($name); + $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, $self->parseKey($name), $frozenValue, $ttl); + Memcached::libmemcached::memcached_set($memcached, $key, $frozenValue, $ttl); 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 set $key to cache because ".$memcached->errstr); WebGUI::Error->throw( - error => "Couldn't set $name to cache because ".$memcached->errstr + error => "Couldn't set $key to cache because ".$memcached->errstr ); } return $value; @@ -381,13 +411,9 @@ Retrieves a document via HTTP and stores it in the cache and returns the content Throws WebGUI::Error::InvalidParam, WebGUI::Error::Connection, and WebGUI::Error. -=head3 name - -The name of the key to store the request under. - =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 @@ -396,12 +422,13 @@ The time to live for this content. This is the amount of time (in seconds) that =cut sub setByHttp { - my ($self, $name, $url, $ttl) = validate_pos(@_, + my ($self, $url, $ttl) = validate_pos(@_, 1, - { type => SCALAR | ARRAYREF }, { type => SCALAR }, { type => SCALAR, optional => 1 }, ); + my $log = $self->session->log; + $log->debug("Called setByHttp() with URL $url."); my $userAgent = new LWP::UserAgent; $userAgent->env_proxy; $userAgent->agent("WebGUI/".$WebGUI::VERSION); @@ -411,13 +438,13 @@ sub setByHttp { my $response = $userAgent->request($request); if ($response->is_error) { - $self->session->log->error($url." could not be retrieved."); + $log->error("$url could not be retrieved."); WebGUI::Error::Connection->throw( error => "Couldn't fetch $url because ".$response->message, resource => $url, ); } - return $self->set($name, $response->decoded_content, $ttl); + return $self->set($url, $response->decoded_content, $ttl); } diff --git a/lib/WebGUI/Operation/Statistics.pm b/lib/WebGUI/Operation/Statistics.pm index 320b7924c..38c28cc1b 100644 --- a/lib/WebGUI/Operation/Statistics.pm +++ b/lib/WebGUI/Operation/Statistics.pm @@ -182,7 +182,7 @@ sub www_viewStatistics { my $cache = $session->cache; my $version = eval{$cache->get($url)}; if (not defined $version) { - $version = eval{$cache->setByHttp($url, $url, 43200)}; + $version = eval{$cache->setByHttp($url, 43200)}; } chomp $version; $output .= '
'; diff --git a/t/Cache.t b/t/Cache.t index f5684b189..976e7727a 100644 --- a/t/Cache.t +++ b/t/Cache.t @@ -48,8 +48,8 @@ $cache->delete("Shawshank"); is(eval{$cache->get("Shawshank")}, undef, 'delete'); $cache->flush; is(eval{$cache->get(["andy", "dufresne"])}, undef, 'flush'); -$cache->setByHttp("google", "http://www.google.com/"); -cmp_ok($cache->get("google"), 'ne', '', 'setByHttp'); +$cache->setByHttp("http://www.google.com/"); +cmp_ok($cache->get("http://www.google.com/"), 'ne', '', 'setByHttp'); #---------------------------------------------------------------------------- From ee8ebd44e45c9dfec1119a2061ed4a2a112e48c6 Mon Sep 17 00:00:00 2001 From: JT Smith Date: Sun, 27 Sep 2009 17:36:02 -0500 Subject: [PATCH 19/23] removed typo --- lib/WebGUI/Cache.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/WebGUI/Cache.pm b/lib/WebGUI/Cache.pm index 40f53ec2f..56cd033d6 100644 --- a/lib/WebGUI/Cache.pm +++ b/lib/WebGUI/Cache.pm @@ -295,7 +295,7 @@ sub new { Memcached::libmemcached::memcached_server_add($memcached, $server->{host}, $server->{port}); # no exception because always returns success } } - bless {_memcached => $memcached, _namespace => $namespace, _sesssion => $session}, $class; + bless {_memcached => $memcached, _namespace => $namespace, _session => $session}, $class; } #------------------------------------------------------------------- From 393789e72fd6549ce402a559418322fd2d3f3bd6 Mon Sep 17 00:00:00 2001 From: JT Smith Date: Sun, 27 Sep 2009 21:52:46 -0500 Subject: [PATCH 20/23] added off switch for debugging to speed things up --- lib/WebGUI/Cache.pm | 328 +++++++++++++++++++++++++------------------- 1 file changed, 187 insertions(+), 141 deletions(-) diff --git a/lib/WebGUI/Cache.pm b/lib/WebGUI/Cache.pm index 56cd033d6..c6b8c098a 100644 --- a/lib/WebGUI/Cache.pm +++ b/lib/WebGUI/Cache.pm @@ -74,34 +74,37 @@ The key to delete. =cut sub delete { - my ($self, $name) = validate_pos(@_, - 1, - { type => SCALAR | ARRAYREF }, - ); - my $log = $self->session->log; + my $self = shift; + my $debug = $self->withDebug; + my ($name) = ($debug) ? validate_pos(@_, { type => SCALAR | ARRAYREF }) : @_; my $key = $self->parseKey($name); - $log->debug("Called delete() on cache key $key."); + if ($debug) { + $self->session->log->debug("Called delete() on cache key $key."); + } my $memcached = $self->getMemcached; Memcached::libmemcached::memcached_delete($memcached, $key); - 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' # 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 - ); + 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' # 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 + ); + } } } @@ -117,27 +120,32 @@ Throws WebGUI::Error::Connection and WebGUI::Error. sub flush { my ($self) = @_; - my $log = $self->session->log; - $log->debug("Called flush() on cache."); + my $debug = $self->withDebug; + if ($debug) { + $self->session->log->debug("Called flush() on cache."); + } my $memcached = $self->getMemcached; Memcached::libmemcached::memcached_flush($memcached); - 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 - ); + 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 + ); + } } } @@ -156,48 +164,53 @@ The key to retrieve. =cut sub get { - my ($self, $name) = validate_pos(@_, - 1, - { type => SCALAR | ARRAYREF }, - ); - my $log = $self->session->log; + my $self = shift; + my $debug = $self->withDebug; + my ($name) = ($debug) ? validate_pos(@_, { type => SCALAR | ARRAYREF }) : @_; my $key = $self->parseKey($name); - $log->debug("Called get() on cache key $key."); + if ($debug) { + $self->session->log->debug("Called get() on cache key $key."); + } my $memcached = $self->getMemcached; my $content = Memcached::libmemcached::memcached_get($memcached, $key); - if ($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." - ); - } - elsif ($memcached->errstr ne 'SUCCESS') { + $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; } - $content = Storable::thaw($content); - unless (ref $content) { - $log->debug("Couldn't thaw value for $key."); - WebGUI::Error::InvalidObject->throw( - error => "Couldn't thaw value for $key." - ); - } - return ${$content}; + return (ref $content) ? ${$content} : undef; } #------------------------------------------------------------------- @@ -229,34 +242,37 @@ An array reference of keys to retrieve. =cut sub mget { - my ($self, $names) = validate_pos(@_, - 1, - { type => ARRAYREF }, - ); - my $log = $self->session->log; + my $self = shift; + my $debug = $self->withDebug; + my ($names) = ($debug) ? validate_pos(@_, { type => ARRAYREF }) : @_; my @keys = map { $self->parseKey($_) } @{ $names }; - $log->debug("Called mget() for keys (".join(", ",@keys).") on cache."); + 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 ($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." - ); + 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."); + $log->debug("Cannot thaw key $key.") if ($debug); next; } push @values, ${$content}; @@ -266,9 +282,9 @@ sub mget { #------------------------------------------------------------------- -=head2 new ( session ) +=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. @@ -276,14 +292,23 @@ Throws WebGUI::Error::InvalidParam. A reference to the current session. +=head3 withDebug + +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, $session) = validate_pos(@_, + my ($class, $session, $withDebug) = validate_pos(@_, 1, { isa => 'WebGUI::Session' }, + { type => SCALAR | UNDEF, optional=>1, default=>0 }, ); - $session->log->debug("Instanciated cache object."); + 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 @@ -295,7 +320,7 @@ sub new { Memcached::libmemcached::memcached_server_add($memcached, $server->{host}, $server->{port}); # no exception because always returns success } } - bless {_memcached => $memcached, _namespace => $namespace, _session => $session}, $class; + bless {_memcached => $memcached, _namespace => $namespace, _session => $session, _withDebug=>$withDebug}, $class; } #------------------------------------------------------------------- @@ -313,10 +338,8 @@ Can either be a text key, or a composite key. If it's a composite key, it will b =cut sub parseKey { - my ($self, $name) = validate_pos(@_, - 1, - { type => SCALAR | ARRAYREF }, - ); + my $self = shift; + my ($name) = ($self->withDebug) ? validate_pos(@_, { type => SCALAR | ARRAYREF }) : @_; # prepend namespace to the key my @key = ($self->{_namespace}); @@ -369,31 +392,34 @@ A time in seconds for the cache to exist. When you override default it to 60 sec =cut sub set { - my ($self, $name, $value, $ttl) = validate_pos(@_, - 1, - { type => SCALAR | ARRAYREF }, - { type => SCALAR }, - { type => SCALAR | UNDEF, optional => 1, default=> 60 }, - ); - my $log = $self->session->log; + my $self = shift; + my $debug = $self->withDebug; + my ($name, $value, $ttl) = ($debug) ? validate_pos(@_, { type => SCALAR | ARRAYREF }, { type => SCALAR }, { type => SCALAR | UNDEF, optional => 1 }) : @_; + $ttl ||= 60; my $key = $self->parseKey($name); - $log->debug("Called set() on cache key $key with $value as the value."); + 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 ($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') { + 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 @@ -422,32 +448,46 @@ The time to live for this content. This is the amount of time (in seconds) that =cut sub setByHttp { - my ($self, $url, $ttl) = validate_pos(@_, - 1, - { type => SCALAR }, - { type => SCALAR, optional => 1 }, - ); - my $log = $self->session->log; - $log->debug("Called setByHttp() with URL $url."); + 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); my $request = HTTP::Request->new(GET => $url); - - my $response = $userAgent->request($request); if ($response->is_error) { - $log->error("$url could not be retrieved."); - WebGUI::Error::Connection->throw( - error => "Couldn't fetch $url because ".$response->message, - resource => $url, - ); + $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, + ); + } } return $self->set($url, $response->decoded_content, $ttl); } +#------------------------------------------------------------------- + +=head2 withDebug () + +Returns a boolean indicating whether the cache system should log debug, validate parameters, and throw exceptions. + +=cut + +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: @@ -459,6 +499,8 @@ This class throws a lot of inconvenient exceptions. However, because cache shoul 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 @@ -477,6 +519,10 @@ When you pass in the wrong arguments. 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 From 1fe612ef8ff0c7c3cbe44fadcc21eaa216cc1d44 Mon Sep 17 00:00:00 2001 From: JT Smith Date: Mon, 28 Sep 2009 12:04:09 -0500 Subject: [PATCH 21/23] converted scratch to hot session --- lib/WebGUI/Session/Scratch.pm | 40 +++++++++++++++++++++++------------ 1 file changed, 26 insertions(+), 14 deletions(-) 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]); } From 26c3bdac703d0df6bad80d95ee86d2cd347f5477 Mon Sep 17 00:00:00 2001 From: JT Smith Date: Mon, 28 Sep 2009 15:06:12 -0500 Subject: [PATCH 22/23] added hot sessions --- docs/changelog/8.x.x.txt | 3 ++ docs/upgrades/upgrade_7.8.1-8.0.0.pl | 3 +- etc/WebGUI.conf.original | 13 ++++- lib/WebGUI/Session.pm | 2 +- lib/WebGUI/Session/Var.pm | 76 ++++++++++++++++++---------- t/Session/Stow.t | 22 +------- t/Session/Var.t | 6 +++ 7 files changed, 74 insertions(+), 51 deletions(-) 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/upgrades/upgrade_7.8.1-8.0.0.pl b/docs/upgrades/upgrade_7.8.1-8.0.0.pl index 00dff6aca..67877b6ce 100644 --- a/docs/upgrades/upgrade_7.8.1-8.0.0.pl +++ b/docs/upgrades/upgrade_7.8.1-8.0.0.pl @@ -45,7 +45,8 @@ sub migrateToNewCache { unlink "../../lib/WebGUI/Workflow/Activity/CleanDatabaseCache.pm"; unlink "../../lib/WebGUI/Workflow/Activity/CleanFileCache.pm"; my $config = $session->config; - $config->set("cacheServers" => [ { "socket" => "/data/wre/var/memcached.sock", "host" => "127.0.0.1", "port" => "11211" } ]); + $config->set("cacheServers", [ { "socket" => "/data/wre/var/memcached.sock", "host" => "127.0.0.1", "port" => "11211" } ]); + $config->set("hotSessionFlushToDb", 600); $config->delete("disableCache"); $config->delete("cacheType"); $config->delete("fileCacheRoot"); diff --git a/etc/WebGUI.conf.original b/etc/WebGUI.conf.original index a3ba08a9f..c1be63e1a 100644 --- a/etc/WebGUI.conf.original +++ b/etc/WebGUI.conf.original @@ -96,10 +96,21 @@ # memcached over TCP. And since this is an array you can specify # as many server connections as you have memcached servers - "cacheServers" : [ +"cacheServers" : [ { "socket" : "/tmp/memcached.sock", "host" : "127.0.0.1", "port" : "11211" } ], +# Sessions that are "hot", those that are not only not expired, +# but that are currently active on the site are kept in memory +# to make them exceptionally fast. The hotSessionFlushToDb +# directive allows you to say how often (in seconds) those +# sessions should be pushed down to the database. On most sites +# 10 minutes is a good duration. If you have an exceptionally +# short session timeout (in the settings) then you may wish to +# set it lower. + +"hotSessionFlushToDb" : 600, + # The database connection string. It usually takes the form of # DBI::;host: diff --git a/lib/WebGUI/Session.pm b/lib/WebGUI/Session.pm index 12b75faf6..3b5063a3f 100644 --- a/lib/WebGUI/Session.pm +++ b/lib/WebGUI/Session.pm @@ -144,7 +144,7 @@ sub close { # Kill circular references. The literal list is so that the order # can be explicitly shuffled as necessary. - foreach my $key (qw/_asset _datetime _icon _slave _db _env _form _http _id _output _os _privilege _scratch _setting _stow _style _url _user _var _errorHandler/) { + foreach my $key (qw/_asset _datetime _icon _slave _db _env _form _http _id _output _os _privilege _scratch _setting _stow _style _url _user _var _cache _errorHandler/) { delete $self->{$key}; } } diff --git a/lib/WebGUI/Session/Var.pm b/lib/WebGUI/Session/Var.pm index d472c0cab..a2f43306c 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"); + $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/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'); From d16a220628788ad87beeaa8a1165247ac147b817 Mon Sep 17 00:00:00 2001 From: JT Smith Date: Mon, 28 Sep 2009 17:36:10 -0500 Subject: [PATCH 23/23] bug fixes --- lib/WebGUI/Asset.pm | 8 ++-- lib/WebGUI/Cache.pm | 15 ++++++- lib/WebGUI/Session/Var.pm | 2 +- t/Cache.t | 89 ++++++++++++++++++++++++++++++++++++++- 4 files changed, 104 insertions(+), 10 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index c61a95efc..195322ac3 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -1778,17 +1778,15 @@ sub new { } my $properties = eval{$session->cache->get(["asset",$assetId,$revisionDate])}; - if (exists $properties->{assetId}) { - # got properties from cache - } - else { + 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; } - eval{$session->cache->set(["asset",$assetId,$revisionDate], $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; diff --git a/lib/WebGUI/Cache.pm b/lib/WebGUI/Cache.pm index c6b8c098a..6d5d9ed43 100644 --- a/lib/WebGUI/Cache.pm +++ b/lib/WebGUI/Cache.pm @@ -23,7 +23,11 @@ use Memcached::libmemcached; use Storable (); use WebGUI::Exception; use Params::Validate qw(:all); -Params::Validate::validation_options( on_fail => sub { WebGUI::Error::InvalidParam->throw( error => shift ) } ); +Params::Validate::validation_options( on_fail => sub { + my $error = shift; + warn "Error in Cache params: ".$error; + WebGUI::Error::InvalidParam->throw( error => $error ); + } ); @@ -91,6 +95,13 @@ sub delete { 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( @@ -394,7 +405,7 @@ A time in seconds for the cache to exist. When you override default it to 60 sec sub set { my $self = shift; my $debug = $self->withDebug; - my ($name, $value, $ttl) = ($debug) ? validate_pos(@_, { type => SCALAR | ARRAYREF }, { type => SCALAR }, { type => SCALAR | UNDEF, optional => 1 }) : @_; + 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) { diff --git a/lib/WebGUI/Session/Var.pm b/lib/WebGUI/Session/Var.pm index a2f43306c..7cae0609d 100644 --- a/lib/WebGUI/Session/Var.pm +++ b/lib/WebGUI/Session/Var.pm @@ -202,7 +202,7 @@ sub new { } else { $self->{_var}{nextCacheFlush} = $time + $session->config->get("hotSessionFlushToDb"); - $session->cache->set(['session',$sessionId], $self->{_var}, $timeout); + eval{$session->cache->set(['session',$sessionId], $self->{_var}, $timeout)}; } $self->session->{_sessionId} = $self->{_var}{sessionId}; return $self; diff --git a/t/Cache.t b/t/Cache.t index 976e7727a..45289b163 100644 --- a/t/Cache.t +++ b/t/Cache.t @@ -29,11 +29,11 @@ my $session = WebGUI::Test->session; #---------------------------------------------------------------------------- # Tests -plan tests => 10; # Increment this number for each test you create +plan tests => 11; # Increment this number for each test you create #---------------------------------------------------------------------------- -my $cache = WebGUI::Cache->new($session); +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"); @@ -50,6 +50,91 @@ $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"); #----------------------------------------------------------------------------