diff --git a/docs/changelog/6.x.x.txt b/docs/changelog/6.x.x.txt index 93d6edf10..cbd87b1b8 100644 --- a/docs/changelog/6.x.x.txt +++ b/docs/changelog/6.x.x.txt @@ -21,6 +21,8 @@ - Enhanced aggregation features of the SyndicatedContent wobject, including keyword filtering, content republishing, XSLT stylesheet support and different "display modes". + - Wrote a whole new caching system for WebGUI that is up to 10 times more + efficient than the old caching system. 6.6.3 diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index f1b671c1d..1fd3f1946 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -318,14 +318,12 @@ sub cascadeLineage { my $now = time(); my $prepared = WebGUI::SQL->prepare("update asset set lineage=? where assetId=?"); my $descendants = WebGUI::SQL->read("select assetId,lineage from asset where lineage like ".quote($oldLineage.'%')); + my $cache = WebGUI::Cache->new; while (my ($assetId, $lineage) = $descendants->array) { my $fixedLineage = $newLineage.substr($lineage,length($oldLineage)); $prepared->execute([$fixedLineage,$assetId]); - my $sth = WebGUI::SQL->read("select assetId,revisionDate from assetData where asset=".quote($assetId)); - while (my ($id,$version) = $sth->array) { - WebGUI::Cache->new("asset_".$id."/".$version)->delete; - } - $sth->finish; + # we do the purge directly cuz it's a lot faster than instanciating all these assets + $cache->deleteChunk(["asset",$assetId]); } $descendants->finish; } @@ -1153,11 +1151,7 @@ Returns the highest rank, top of the highest rank Asset under current Asset. sub getFirstChild { my $self = shift; unless (exists $self->{_firstChild}) { - my $lineage = WebGUI::Cache->new("firstchild_".$self->getId)->get; - unless ($lineage) { - ($lineage) = WebGUI::SQL->quickArray("select min(lineage) from asset where parentId=".quote($self->getId)); - WebGUI::Cache->new("firstchild_".$self->getId)->set($lineage); - } + my ($lineage) = WebGUI::SQL->quickArray("select min(lineage) from asset where parentId=".quote($self->getId)); $self->{_firstChild} = WebGUI::Asset->newByLineage($lineage); } return $self->{_firstChild}; @@ -1232,11 +1226,7 @@ Returns the lowest rank, bottom of the lowest rank Asset under current Asset. sub getLastChild { my $self = shift; unless (exists $self->{_lastChild}) { - my $lineage = WebGUI::Cache->new("lastchild_".$self->getId)->get; - unless ($lineage) { - ($lineage) = WebGUI::SQL->quickArray("select max(lineage) from asset where parentId=".quote($self->getId)); - WebGUI::Cache->new("lastchild_".$self->getId)->set($lineage); - } + my ($lineage) = WebGUI::SQL->quickArray("select max(lineage) from asset where parentId=".quote($self->getId)); $self->{_lastChild} = WebGUI::Asset->newByLineage($lineage); } return $self->{_lastChild}; @@ -1871,11 +1861,8 @@ sub new { } $class = $className; } - my $properties = $session{assetprops}{$assetId}{$revisionDate}; - # $properties = WebGUI::Cache->new("asset_".$assetId."/".$revisionDate)->get; -# if ( $session{assetcache}{$assetId}{$revisionDate}) { -# return $session{assetcache}{$assetId}{$revisionDate}; -# } + my $cache = WebGUI::Cache->new(["asset",$assetId,$revisionDate]); + my $properties = $cache->get; if (exists $properties->{assetId}) { # got properties from cache } else { @@ -1887,13 +1874,11 @@ sub new { $sql .= " where asset.assetId=".quote($assetId); $properties = WebGUI::SQL->quickHashRef($sql); return undef unless (exists $properties->{assetId}); - # WebGUI::Cache->new("asset_".$assetId."/".$revisionDate)->set($properties,60*60*24); - $session{assetprops}{$assetId}{$revisionDate} = $properties; + $cache->set($properties,60*60*24); } if (defined $properties) { my $object = { _properties => $properties }; bless $object, $class; - # $session{assetcache}{$assetId}{$revisionDate} = $object; return $object; } return undef; @@ -2038,12 +2023,11 @@ sub paste { my $assetIds = WebGUI::SQL->buildArrayRef("select assetId from asset where lineage like ".quote($self->get("lineage").'%')." and (state='clipboard' or state='clipboard-limbo')"); my $idList = quoteAndJoin($assetIds); WebGUI::SQL->write("update asset set state='published', stateChangedBy=".quote($session{user}{userId}).", stateChanged=".time()." where assetId in (".$idList.")"); - my $sth = WebGUI::SQL->read("select assetId,revisionDate from assetData where assetId in (".$idList.")"); - while ( my ($id,$version) = $sth->array) { + my $cache = WebGUI::Cache->new; + foreach my $id (@{$assetIds}) { # we do the purge directly cuz it's a lot faster than instanciating all these assets - WebGUI::Cache->new("asset_".$id."/".$version)->delete; + $cache->deleteChunk(["asset",$id]); } - $sth->finish; $pastedAsset->updateHistory("pasted to parent ".$self->getId); return 1; } @@ -2177,12 +2161,11 @@ sub publish { my $assetIds = WebGUI::SQL->buildArrayRef("select assetId from asset where lineage like ".quote($self->get("lineage").'%')); my $idList = quoteAndJoin($assetIds); WebGUI::SQL->write("update asset set state='published', stateChangedBy=".quote($session{user}{userId}).", stateChanged=".time()." where assetId in (".$idList.")"); - my $sth = WebGUI::SQL->read("select assetId,revisionDate from assetData where assetId in (".$idList.")"); - while ( my ($id,$version) = $sth->array) { + my $cache = WebGUI::Cache->new; + foreach my $id (@{$assetIds}) { # we do the purge directly cuz it's a lot faster than instanciating all these assets - WebGUI::Cache->new("asset_".$id."/".$version)->delete; + $cache->deleteChunk(["asset",$id]); } - $sth->finish; $self->{_properties}{state} = "published"; } @@ -2204,6 +2187,7 @@ sub purge { WebGUI::SQL->write("delete from asset where assetId=".quote($self->getId)); WebGUI::SQL->commit; $self->purgeCache; + WebGUI::Cache->new->deleteChunk(["asset",$self->getId]); $self->updateHistory("purged"); $self = undef; } @@ -2234,17 +2218,15 @@ sub purgeRevision { #------------------------------------------------------------------- -=head2 purgeTree ( ) +=head2 purgeCache ( ) -Purges all cache entries associated with this asset. +Purges all cache entries associated with this revision. =cut sub purgeCache { my $self = shift; - WebGUI::Cache->new("asset_".$self->getId."/".$self->get("revisionDate"))->delete; - delete $session{assetcache}{$self->getId}; - delete $session{assetprops}{$self->getId}; + WebGUI::Cache->new(["asset",$self->getId,$self->get("revisionDate")])->delete; } #------------------------------------------------------------------- diff --git a/lib/WebGUI/Cache/FileCache.pm b/lib/WebGUI/Cache/FileCache.pm index 652c44c61..37820c8ab 100644 --- a/lib/WebGUI/Cache/FileCache.pm +++ b/lib/WebGUI/Cache/FileCache.pm @@ -52,7 +52,7 @@ Remove content from the filesystem cache. sub delete { my $self = shift; - rmtree($self->{_cachefolder}); + rmtree($self->getFolder()); } #------------------------------------------------------------------- @@ -70,7 +70,7 @@ A partial composite key to remove. sub deleteChunk { my $self = shift; my $key = $self->parseKey(shift); - rmtree($self->getCacheRoot()."/".$self->{_namespace}."/".$key); + rmtree($self->getNamespaceRoot()."/".$key); } #------------------------------------------------------------------- @@ -84,7 +84,7 @@ Remove all objects from the filecache system. sub flush { my $self = shift; $self->SUPER::flush(); - rmtree($self->getCacheRoot."/".$self->{_namespace}); + rmtree($self->getNamespaceRoot); } #------------------------------------------------------------------- @@ -98,25 +98,44 @@ Retrieve content from the filesystem cache. sub get { my $self = shift; return undef if ($session{config}{disableCache}); - if (open(FILE,"<".$self->{_cachefolder}."/expires")) { + if (open(FILE,"<".$self->getFolder()."/expires")) { my $expires = ; close(FILE); return undef if ($expires < time()); - return retrieve($self->{_cachefolder}."/cache"); + my $value; + eval {$value = retrieve($self->getFolder()."/cache")}; + if (ref $value eq "SCALAR") { + return $$value; + } else { + return $value; + } } return undef; } #------------------------------------------------------------------- -=head2 getCacheRoot ( ) +=head getFolder ( ) -Figures out what the cache root should be. A class method. +Returns the path to the cache folder for this key. =cut -sub getCacheRoot { - my $class = shift; +sub getFolder { + my $self = shift; + return $self->getNamespaceRoot()."/".$self->{_key}; +} + +#------------------------------------------------------------------- + +=head2 getNamepsaceRoot ( ) + +Figures out what the cache root for this namespace should be. A class method. + +=cut + +sub getNamespaceRoot { + my $self = shift; my $root = $session{config}{fileCacheRoot}; unless ($root) { if ($session{os}{windowsish}) { @@ -126,9 +145,45 @@ sub getCacheRoot { } $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 $path = shift || $self->getNamespaceRoot; + my $filesRmaining; + if (opendir(DIR,$path)) { + my @files = readdir(DIR); + foreach my $file (@files) { + unless ($file eq "." || $file eq "..") { + if (open(FILE,"<".$path."/expires")) { + my $expires = ; + close(FILE); + if ($expires < time()+$expiresModifier) { + rmtree($path); + } else { + my (@attributes) = stat($self->getPath($filename)); + $filesRemaining += $attributes[7]; + } + } else { + $filesRemaining += $self->getNamespaceSize($expiresModifier,$path."/".$file); + } + } + } + closedir(DIR); + } + return $filesRemaining; +} #------------------------------------------------------------------- @@ -151,8 +206,7 @@ sub new { my $class = shift; my $key = $class->parseKey(shift); my $namespace = shift || $session{config}{configFile}; - my $path = $class->getCacheRoot()."/".$namespace."/".$key; - bless {_cachefolder => $path, _key=>$key, _namespace=>$namespace}, $class; + bless {_key=>$key, _namespace=>$namespace}, $class; } @@ -176,7 +230,7 @@ sub set { my $self = shift; my $content = shift; my $ttl = shift || 60; - my $path = $self->{_cachefolder}; + my $path = $self->getFolder(); unless (-e $path) { eval {mkpath($path)}; if ($@) { @@ -184,7 +238,13 @@ sub set { return; } } - nstore($content, $path."/cache"); + my $value; + unless (ref $content) { + $value = \$content; + } else { + $value = $content; + } + nstore($value, $path."/cache"); open(FILE,">".$path."/expires"); print FILE time()+$ttl; close(FILE); @@ -201,7 +261,7 @@ Returns statistic information about the caching system. sub stats { my $self = shift; - return undef; + return $self->getNamespaceSize." bytes"; } 1; diff --git a/sbin/Hourly/CleanFileCache.pm b/sbin/Hourly/CleanFileCache.pm index 941d51c54..c3e0307fa 100644 --- a/sbin/Hourly/CleanFileCache.pm +++ b/sbin/Hourly/CleanFileCache.pm @@ -13,32 +13,18 @@ package Hourly::CleanFileCache; use strict; use WebGUI::Session; use WebGUI::Cache::FileCache; -use File::Path; #------------------------------------------------------------------- sub process { - traverse(WebGUI::Cache::FileCache->getCacheRoot); + my $size = $session{config}{fileCacheSizeLimit} + 10; + my $expiresModifier = 0; + my $cache = WebGUI::Cache::FileCache->new; + while ($size > $session{config}{fileCacheSizeLimit}) { + $size = $cache->getNamespaceSize($expiresModifier); + $expiresModifier += 600; # add 10 minutes each pass + } } -#------------------------------------------------------------------- -sub traverse { - my $path = shift; - if (opendir(DIR,$path)) { - my @files = readdir(DIR); - foreach my $file (@files) { - unless ($file eq "." || $file eq "..") { - if (open(FILE,"<".$path."/expires")) { - my $expires = ; - close(FILE); - rmtree($path) if ($expires < time()); - } else { - traverse($path."/".$file); - } - } - } - closedir(DIR); - } -} 1;