oqapi/webgui
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

fixed a few things in the new caching system

Browse source
This commit is contained in:
JT Smith 2005-07-12 02:58:32 +00:00
parent 13b52b07f2
commit a8b8660183
4 changed files with 101 additions and 71 deletions
Download patch file Download diff file Expand all files Collapse all files

2
docs/changelog/6.x.x.txt
View file

@ -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

54
lib/WebGUI/Asset.pm
View file

@ -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;
}
#-------------------------------------------------------------------

88
lib/WebGUI/Cache/FileCache.pm
View file

@ -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 = <FILE>;
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 = <FILE>;
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;

28
sbin/Hourly/CleanFileCache.pm
View file

@ -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 = <FILE>;
close(FILE);
rmtree($path) if ($expires < time());
} else {
traverse($path."/".$file);
}
}
}
closedir(DIR);
}
}
1;