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

new caching system

Browse source
This commit is contained in:
JT Smith 2005-07-12 00:28:25 +00:00
parent a15b5cb22d
commit 13b52b07f2
9 changed files with 281 additions and 187 deletions
Download patch file Download diff file Expand all files Collapse all files

42
lib/WebGUI/Asset.pm
View file

@ -16,7 +16,6 @@ package WebGUI::Asset;
use strict;
use Tie::IxHash;
use WebGUI::Asset::Template;
use WebGUI::AdminConsole;
use WebGUI::Cache;
use WebGUI::DateTime;
@ -193,7 +192,7 @@ Adds a revision of an existing asset. Note that programmers should almost never
=head3 properties
A hash reference containing a list of properties to associate with the child. The only required property value is "className"
A hash reference containing a list of properties to associate with the child.
=head3 revisionDate
@ -214,7 +213,7 @@ sub addRevision {
WebGUI::SQL->write("insert into ".$definition->{tableName}." (assetId,revisionDate) values (".quote($self->getId).",".$now.")");
}
}
my $newVersion = WebGUI::Asset->new($self->getId, $properties->{className}, $now);
my $newVersion = WebGUI::Asset->new($self->getId, $self->get("className"), $now);
$newVersion->updateHistory("created revision");
$newVersion->update($properties);
return $newVersion;
@ -394,8 +393,7 @@ An array reference containing additional information to include with the default
sub definition {
my $class = shift;
my $definition = shift || [];
my @newDef = @{$definition};
push(@newDef, {
push(@{$definition}, {
tableName=>'assetData',
className=>'WebGUI::Asset',
properties=>{
@ -418,7 +416,7 @@ sub definition {
url=>{
fieldType=>'text',
defaultValue=>undef,
filter=>'fixUrl',
filter=>'fixUrl'
},
groupIdEdit=>{
fieldType=>'group',
@ -467,7 +465,7 @@ sub definition {
}
}
});
return \@newDef;
return $definition;
}
#-------------------------------------------------------------------
@ -1532,7 +1530,7 @@ sub getNextChildRank {
my $rank;
if (defined $lineage) {
$rank = $self->getRank($lineage);
if ($rank >= 999998) { WebGUI::ErrorHandler->fatal; }
WebGUI::ErrorHandler::fatal("Asset ".$self->getId." has too many children.") if ($rank >= 999998);
$rank++;
} else {
$rank = 1;
@ -1860,7 +1858,8 @@ sub new {
my $className = shift;
my $revisionDate = shift;
unless ($revisionDate) {
($revisionDate) = WebGUI::SQL->quickArray("select max(revisionDate) from assetData where assetId=".quote($assetId)." group by assetData.assetId order by assetData.revisionDate");
($revisionDate) = WebGUI::SQL->quickArray("select max(revisionDate) from assetData where assetId="
.quote($assetId)." group by assetData.assetId order by assetData.revisionDate");
}
return undef unless ($revisionDate);
if ($className) {
@ -1872,22 +1871,29 @@ sub new {
}
$class = $className;
}
my $properties = WebGUI::Cache->new("asset_".$assetId."/".$revisionDate)->get;
my $properties = $session{assetprops}{$assetId}{$revisionDate};
# $properties = WebGUI::Cache->new("asset_".$assetId."/".$revisionDate)->get;
# if ( $session{assetcache}{$assetId}{$revisionDate}) {
# return $session{assetcache}{$assetId}{$revisionDate};
# }
if (exists $properties->{assetId}) {
# got properties from cache
} else {
my $sql = "select * from asset";
foreach my $definition (@{$class->definition}) {
$sql .= " left join ".$definition->{tableName}." on asset.assetId=".$definition->{tableName}.".assetId and ".$definition->{tableName}.".revisionDate=".$revisionDate;
$sql .= " left join ".$definition->{tableName}." on asset.assetId="
.$definition->{tableName}.".assetId and ".$definition->{tableName}.".revisionDate=".$revisionDate;
}
$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);
# WebGUI::Cache->new("asset_".$assetId."/".$revisionDate)->set($properties,60*60*24);
$session{assetprops}{$assetId}{$revisionDate} = $properties;
}
if (defined $properties) {
my $object = { _properties => $properties };
bless $object, $class;
# $session{assetcache}{$assetId}{$revisionDate} = $object;
return $object;
}
return undef;
@ -1935,8 +1941,8 @@ Lineage string.
sub newByLineage {
my $class = shift;
my $lineage = shift;
my $asset = WebGUI::SQL->quickHashRef("select assetId, className from asset where lineage=".quote($lineage));
return WebGUI::Asset->new($asset->{assetId}, $asset->{className});
my ($id,$class) = WebGUI::SQL->quickArray("select assetId, className from asset where lineage=".quote($lineage));
return WebGUI::Asset->new($id, $class);
}
#-------------------------------------------------------------------
@ -2009,7 +2015,7 @@ sub newByUrl {
return WebGUI::Asset->getNotFound;
}
}
return $class->getDefault;
return WebGUI::Asset->getDefault;
}
#-------------------------------------------------------------------
@ -2128,7 +2134,7 @@ sub processTemplate {
%{$self->{_properties}},
%{$var}
);
my $template = WebGUI::Asset::Template->new($templateId);
my $template = WebGUI::Asset->new($templateId,"WebGUI::Asset::Template");
if (defined $template) {
return $template->process(\%vars);
} else {
@ -2237,6 +2243,8 @@ Purges all cache entries associated with this asset.
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};
}
#-------------------------------------------------------------------
@ -3787,7 +3795,7 @@ Returns a www_manageAssets() method. Sets a new parent via the results of a form
sub www_setParent {
my $self = shift;
return WebGUI::Privilege::insufficient() unless $self->canEdit;
my $newParent = WebGUI::Asset->new($session{form}{assetId});
my $newParent = WebGUI::Asset->newByDynamicClass($session{form}{assetId});
$self->setParent($newParent) if (defined $newParent);
return $self->www_manageAssets();

11
lib/WebGUI/Asset/Wobject/Navigation.pm
View file

@ -305,6 +305,8 @@ sub getToolbar {
sub view {
my $self = shift;
# we've got to determine what our start point is based upon user conditions
use Time::HiRes;
my $t = [Time::HiRes::gettimeofday()];
my $start;
$session{asset} = WebGUI::Asset->newByUrl unless (exists $session{asset});
my $current = $session{asset};
@ -335,6 +337,8 @@ sub view {
$rules{assetToPedigree} = $current if (isIn("pedigree",@includedRelationships));
$rules{ancestorLimit} = $self->get("ancestorEndPoint");
my $assets = $start->getLineage(\@includedRelationships,\%rules);
my $timeoutput = "get records: ".Time::HiRes::tv_interval($t)."<br />";
my $t = [Time::HiRes::gettimeofday()];
my $var = {'page_loop' => []};
my @interestingProperties = ('assetId', 'parentId', 'ownerUserId', 'synopsis', 'newWindow');
foreach my $property (@interestingProperties) {
@ -439,7 +443,12 @@ sub view {
}
push(@{$var->{page_loop}}, $pageData);
}
return $self->processTemplate($var,$self->get("templateId"));
$timeoutput .= "build vars: ".Time::HiRes::tv_interval($t)."<br />";
my $t = [Time::HiRes::gettimeofday()];
my $output = $self->processTemplate($var,$self->get("templateId"));
$timeoutput .= "process template: ".Time::HiRes::tv_interval($t)."<br />";
return $output."<br />".$timeoutput;
}

164
lib/WebGUI/Cache.pm
View file

@ -14,9 +14,11 @@ package WebGUI::Cache;
=cut
use WebGUI::Cache::FileCache;
use WebGUI::Session;
use File::Path;
use HTTP::Headers;
use HTTP::Request;
use LWP::UserAgent;
=head1 NAME
@ -37,11 +39,40 @@ These methods are available from this class:
=cut
#-------------------------------------------------------------------
=head2 delete ( )
Delete a key from the cache. Must be overridden.
=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 {
$self = shift;
$self->flush;
}
#-------------------------------------------------------------------
=head2 flush ( )
Flushes the caching system.
Flushes the caching system. Must be overloaded.
=cut
@ -49,18 +80,32 @@ sub flush {
rmtree($session{config}{uploadsPath}.$session{os}{slash}."temp");
}
#-------------------------------------------------------------------
=head2 get ( )
Retrieves a key value from the cache. Must be overridden.
=cut
sub get {
}
#-------------------------------------------------------------------
=head2 new ( otions )
=head2 new ( key, [ namepsace ] )
The new method will return a handler for the configured caching mechanism.
Defaults to WebGUI::Cache::FileCache.
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.
=head3 options
=head3 key
Options to pass to the new constructor. See the caching methods in WebGUI/Cache/*
for documentation of the options.
A key to store the value under or retrieve it from.
=head3 namespace
A subdivider to store this cache under. When building your own cache plug-in default this to the WebGUI config file.
=cut
@ -71,10 +116,113 @@ sub new {
require WebGUI::Cache::Memcached;
return WebGUI::Cache::Memcached->new(@_);
} else {
require WebGUI::Cache::FileCache;
return WebGUI::Cache::FileCache->new(@_);
}
}
#-------------------------------------------------------------------
=head2 parseKey ( key )
Returns a formatted string version of the key. A class method.
=head3 key
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 $key = shift;
if (ref $key eq "ARRAY") {
my @parts = @{$key};
my @fixed;
foreach my $part (@parts) {
$part = Digest::MD5::md5_base64($part);
$part =~ s/\//-/g;
push(@fixed,$part);
}
return join('/',@fixed);
} else {
$key = Digest::MD5::md5_base64($key);
$key =~ s/\//-/g;
return $key;
}
}
#-------------------------------------------------------------------
=head2 set ( value [, ttl] )
Sets a key value to the cache. Must be overridden.
=head3 value
A scalar value to store.
=head3 ttl
A time in seconds for the cache to exist. When you override default it to 60 seconds.
=cut
sub set {
}
#-------------------------------------------------------------------
=head2 setByHTTP ( url [, ttl ] )
Retrieves a document via HTTP and stores it in the cache and returns the content as a string. No need to override.
=head3 url
The URL of the document to retrieve. It must begin with the standard "http://".
=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 setByHTTP {
my $self = shift;
my $url = shift;
my $ttl = shift;
my $userAgent = new LWP::UserAgent;
$userAgent->agent("WebGUI/".$WebGUI::VERSION);
$userAgent->timeout(30);
my $header = new HTTP::Headers;
my $referer = "http://webgui.http.request/".$session{env}{SERVER_NAME}.$session{env}{REQUEST_URI};
chomp $referer;
$header->referer($referer);
my $request = new HTTP::Request (GET => $url, $header);
my $response = $userAgent->request($request);
if ($response->is_error) {
WebGUI::ErrorHandler::error($url." could not be retrieved.");
} else {
$self->set($response->content,$ttl);
}
return $response->content;
}
#-------------------------------------------------------------------
=head2 stats ( )
Return a formatted text string describing cache usage. Must be overridden.
=cut
sub stats {
}
1;

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

@ -14,13 +14,10 @@ package WebGUI::Cache::FileCache;
=cut
use Cache::SizeAwareFileCache;
use HTTP::Headers;
use HTTP::Request;
use LWP::UserAgent;
use WebGUI::ErrorHandler;
use Storable qw(nstore retrieve);
use WebGUI::Session;
use File::Path;
our @ISA = qw(WebGUI::Cache);
@ -54,29 +51,26 @@ Remove content from the filesystem cache.
=cut
sub delete {
$_[0]->{_cache}->remove($_[0]->{_key});
my $self = shift;
rmtree($self->{_cachefolder});
}
#-------------------------------------------------------------------
=head2 deleteByRegex ( regex )
=head2 deleteChunk ( key )
Remove content from the filesystem cache where the key meets the condition of the regular expression.
Remove a partial composite key from the cache.
=head3 regex
=head3 key
A regular expression that will match keys in the current namespace. Example: m/^navigation_.*/
A partial composite key to remove.
=cut
sub deleteByRegex {
my @keys = $_[0]->{_cache}->get_keys();
foreach my $key (@keys) {
if ($key =~ $_[1]) {
$_[0]->{_cache}->remove($key);
}
}
sub deleteChunk {
my $self = shift;
my $key = $self->parseKey(shift);
rmtree($self->getCacheRoot()."/".$self->{_namespace}."/".$key);
}
#-------------------------------------------------------------------
@ -88,13 +82,9 @@ Remove all objects from the filecache system.
=cut
sub flush {
my $self = shift;
$self->SUPER::flush();
foreach my $namespace ($self->{_cache}->get_namespaces) {
next if ($namespace =~ /\.conf$/ && $namespace ne $session{config}{configFile});
$self->{_cache}->set_namespace($namespace);
$self->{_cache}->clear;
}
my $self = shift;
$self->SUPER::flush();
rmtree($self->getCacheRoot."/".$self->{_namespace});
}
#-------------------------------------------------------------------
@ -106,10 +96,40 @@ Retrieve content from the filesystem cache.
=cut
sub get {
return undef if ($session{config}{disableCache});
return $_[0]->{_cache}->get($_[0]->{_key});
my $self = shift;
return undef if ($session{config}{disableCache});
if (open(FILE,"<".$self->{_cachefolder}."/expires")) {
my $expires = <FILE>;
close(FILE);
return undef if ($expires < time());
return retrieve($self->{_cachefolder}."/cache");
}
return undef;
}
#-------------------------------------------------------------------
=head2 getCacheRoot ( )
Figures out what the cache root should be. A class method.
=cut
sub getCacheRoot {
my $class = shift;
my $root = $session{config}{fileCacheRoot};
unless ($root) {
if ($session{os}{windowsish}) {
$root = $session{env}{TEMP} || $session{env}{TMP} || "/temp";
} else {
$root = "/tmp";
}
$root .= "/WebGUICache";
}
return $root;
}
#-------------------------------------------------------------------
=head2 new ( key [, namespace ] )
@ -129,15 +149,10 @@ Defaults to the config filename for the current site. The only reason to overrid
sub new {
my $cache;
my $class = shift;
my $key = shift;
my $key = $class->parseKey(shift);
my $namespace = shift || $session{config}{configFile};
my %options = (
namespace=>$namespace,
auto_purge_on_set=>1
);
$options{cache_root} = $session{config}{fileCacheRoot} if ($session{config}{fileCacheRoot});
$cache = new Cache::SizeAwareFileCache(\%options);
bless {_cache => $cache, _key => $key}, $class;
my $path = $class->getCacheRoot()."/".$namespace."/".$key;
bless {_cachefolder => $path, _key=>$key, _namespace=>$namespace}, $class;
}
@ -158,61 +173,21 @@ The time to live for this content. This is the amount of time (in seconds) that
=cut
sub set {
my $ttl = $_[2] || 60;
$_[0]->{_cache}->set($_[0]->{_key},$_[1],$ttl);
}
#-------------------------------------------------------------------
=head2 setByHTTP ( url [, ttl ] )
Retrieves a document via HTTP and stores it in the cache and returns the content as a string.
=head3 url
The URL of the document to retrieve. It must begin with the standard "http://".
=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 setByHTTP {
my $userAgent = new LWP::UserAgent;
$userAgent->agent("WebGUI/".$WebGUI::VERSION);
$userAgent->timeout(30);
my $header = new HTTP::Headers;
my $referer = "http://webgui.http.request/".$session{env}{SERVER_NAME}.$session{env}{REQUEST_URI};
chomp $referer;
$header->referer($referer);
my $request = new HTTP::Request (GET => $_[1], $header);
my $response = $userAgent->request($request);
if ($response->is_error) {
WebGUI::ErrorHandler::warn($_[1]." could not be retrieved.");
} else {
$_[0]->set($response->content,$_[2]);
}
return $response->content;
}
#-------------------------------------------------------------------
=head2 shrink ( [ size ] )
Reduces the cache down to a specific size to conserve filesystem space.
=head3 size
A size to shrink the cache to in bytes. Defaults to the fileCacheSizeLimit variable in the config file.
=cut
sub shrink {
my $self = shift;
my $size = shift || $session{config}{fileCacheSizeLimit} || 10000000;
$self->{_cache}->limit_size($size);
my $content = shift;
my $ttl = shift || 60;
my $path = $self->{_cachefolder};
unless (-e $path) {
eval {mkpath($path)};
if ($@) {
WebGUI::ErrorHandler::error("Couldn't create cache folder: ".$path." : ".$@);
return;
}
}
nstore($content, $path."/cache");
open(FILE,">".$path."/expires");
print FILE time()+$ttl;
close(FILE);
}
@ -226,18 +201,9 @@ Returns statistic information about the caching system.
sub stats {
my $self = shift;
my $output;
$output = "Total size of file cache: ".$self->{_cache}->Size()." bytes\n";
foreach my $namespace ($self->{_cache}->get_namespaces) {
next if ($namespace =~ /\.conf$/ && $namespace ne $session{config}{configFile});
$self->{_cache}->set_namespace($namespace);
$output .= "\t$namespace : ".($self->{_cache}->get_keys).
" items / ".$self->{_cache}->size()." bytes\n";
}
return $output;
return undef;
}
1;

58
lib/WebGUI/Cache/Memcached.pm
View file

@ -16,11 +16,6 @@ package WebGUI::Cache::Memcached;
use Cache::Memcached;
use Digest::MD5;
use HTTP::Headers;
use HTTP::Request;
use LWP::UserAgent;
use WebGUI::ErrorHandler;
use WebGUI::Session;
our @ISA = qw(WebGUI::Cache);
@ -60,23 +55,6 @@ sub delete {
}
#-------------------------------------------------------------------
=head2 deleteByRegex ( )
This method is here to keep the API compatible.
Because of the nature of memcached it does not support a way to retrieve
the list of cache keys.
The whole cache will be flushed if deleteByRegex is called.
=cut
sub deleteByRegex {
my $self = shift;
return $self->flush;
}
#-------------------------------------------------------------------
=head2 flush ( )
@ -134,7 +112,7 @@ Defaults to the config filename for the current site. The only reason to overrid
sub new {
my $cache;
my $class = shift;
my $key = shift;
my $key = $class->parseKey(shift);
my $namespace = shift || $session{config}{configFile};
# Overcome maximum key length of 255 characters
@ -177,40 +155,6 @@ sub set {
}
#-------------------------------------------------------------------
=head2 setByHTTP ( url [, ttl ] )
Retrieves a document via HTTP and stores it in the cache and returns the content as a string.
=head3 url
The URL of the document to retrieve. It must begin with the standard "http://".
=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 setByHTTP {
my $userAgent = new LWP::UserAgent;
$userAgent->agent("WebGUI/".$WebGUI::VERSION);
$userAgent->timeout(30);
my $header = new HTTP::Headers;
my $referer = "http://webgui.http.request/".$session{env}{SERVER_NAME}.$session{env}{REQUEST_URI};
chomp $referer;
$header->referer($referer);
my $request = new HTTP::Request (GET => $_[1], $header);
my $response = $userAgent->request($request);
if ($response->is_error) {
WebGUI::ErrorHandler::warn($_[1]." could not be retrieved.");
} else {
$_[0]->set($response->content,$_[2]);
}
return $response->content;
}
#-------------------------------------------------------------------
=head2 stats ( )

2
lib/WebGUI/Operation/Settings.pm
View file

@ -111,7 +111,7 @@ sub www_editSettings {
-name=>"richEditor",
-label=>$i18n->get("default rich editor"),
-value=>[$session{setting}{richEditor}],
-options=>WebGUI::SQL->buildHashRef("select assetId,title from asset where className='WebGUI::Asset::RichEdit' order by title"),
-options=>WebGUI::SQL->buildHashRef("select assetData.assetId,assetData.title from asset left join assetData on asset.assetId=assetData.assetId where asset.className='WebGUI::Asset::RichEdit' order by assetData.title"),
-defaultValue=>["PBrichedit000000000001"]
);
$tabform->getTab("ui")->integer(

24
sbin/Hourly/CleanFileCache.pm
View file

@ -13,11 +13,31 @@ package Hourly::CleanFileCache;
use strict;
use WebGUI::Session;
use WebGUI::Cache::FileCache;
use File::Path;
#-------------------------------------------------------------------
sub process {
my $cache = WebGUI::Cache::FileCache->new;
$cache->shrink;
traverse(WebGUI::Cache::FileCache->getCacheRoot);
}
#-------------------------------------------------------------------
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;

2
sbin/preload.perl
View file

@ -44,12 +44,12 @@ use HTML::Template ();
use Parse::PlainConfig ();
use Net::SMTP ();
use Log::Log4perl ();
use Cache::Cache ();
use Tie::IxHash ();
use Tie::CPHash ();
use Time::HiRes ();
use Date::Manip ();
use Image::Magick ();
use Storable;
use XML::Simple ();
####

1
sbin/testEnvironment.pl
View file

@ -53,7 +53,6 @@ checkModule("Archive::Tar",1.05);
checkModule("IO::Zlib",1.01);
checkModule("Compress::Zlib",1.34);
checkModule("Net::SMTP",2.24);
checkModule("Cache::Cache",1.02);
checkModule("Tie::IxHash",1.21);
checkModule("Tie::CPHash",1.001);
checkModule("XML::Simple",2.09);