Added support for memcached distributed caching
This commit is contained in:
Len Kranendonk
parent
598ccd1766
commit
b417ef09b2
7 changed files with 566 additions and 121 deletions
|
|
@ -300,6 +300,15 @@ sub getAdminFunction {
|
|||
op=>"listSubscriptions",
|
||||
group=>"3"
|
||||
},
|
||||
"cache"=>{
|
||||
title=>{
|
||||
id=>"manage cache",
|
||||
namespace=>"WebGUI"
|
||||
},
|
||||
icon=>"settings.gif", # TODO Create cache icon
|
||||
op=>"manageCache",
|
||||
group=>"3"
|
||||
},
|
||||
};
|
||||
if ($id) {
|
||||
return $self->_formatFunction($functions->{$id});
|
||||
|
|
|
|||
|
|
@ -14,14 +14,9 @@ package WebGUI::Cache;
|
|||
|
||||
=cut
|
||||
|
||||
|
||||
use Cache::FileCache;
|
||||
|
||||
use HTTP::Headers;
|
||||
use HTTP::Request;
|
||||
use LWP::UserAgent;
|
||||
use WebGUI::ErrorHandler;
|
||||
use WebGUI::Cache::FileCache;
|
||||
use WebGUI::Session;
|
||||
use File::Path;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
|
|
@ -29,7 +24,7 @@ Package WebGUI::Cache
|
|||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This package provides a means for WebGUI to cache data to the filesystem.
|
||||
A base class for all Cache modules to extend.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
|
|
@ -42,143 +37,44 @@ These methods are available from this class:
|
|||
=cut
|
||||
|
||||
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 delete ( )
|
||||
=head2 flush ( )
|
||||
|
||||
Remove content from the filesystem cache.
|
||||
Flushes the caching system.
|
||||
|
||||
=cut
|
||||
|
||||
sub delete {
|
||||
$_[0]->{_cache}->remove($_[0]->{_key});
|
||||
sub flush {
|
||||
rmtree($session{config}{uploadsPath}.$session{os}{slash}."temp");
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 deleteByRegex ( regex )
|
||||
=head2 new ( otions )
|
||||
|
||||
Remove content from the filesystem cache where the key meets the condition of the regular expression.
|
||||
The new method will return a handler for the configured caching mechanism.
|
||||
Defaults to WebGUI::Cache::FileCache.
|
||||
|
||||
=head3 regex
|
||||
=head3 options
|
||||
|
||||
A regular expression that will match keys in the current namespace. Example: m/^navigation_.*/
|
||||
|
||||
=cut
|
||||
|
||||
sub deleteByRegex {
|
||||
my @keys = $_[0]->{_cache}->get_keys();
|
||||
foreach my $key (@keys) {
|
||||
if ($key =~ $_[1]) {
|
||||
$_[0]->{_cache}->remove($key);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 get ( )
|
||||
|
||||
Retrieve content from the filesystem cache.
|
||||
|
||||
=cut
|
||||
|
||||
sub get {
|
||||
return $_[0]->{_cache}->get($_[0]->{_key});
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 new ( key [, namespace ] )
|
||||
|
||||
Constructor.
|
||||
|
||||
=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.
|
||||
Options to pass to the new constructor. See the caching methods in WebGUI/Cache/*
|
||||
for documentation of the options.
|
||||
|
||||
=cut
|
||||
|
||||
sub new {
|
||||
my $cache;
|
||||
my $class = shift;
|
||||
my $key = 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::FileCache(\%options);
|
||||
bless {_cache => $cache, _key => $key}, $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 $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.");
|
||||
if($session{config}{memcached_servers}) {
|
||||
use WebGUI::Cache::Memcached;
|
||||
return WebGUI::Cache::Memcached->new(@_);
|
||||
} else {
|
||||
$_[0]->set($response->content,$_[2]);
|
||||
return WebGUI::Cache::FileCache->new(@_);
|
||||
}
|
||||
return $response->content;
|
||||
}
|
||||
|
||||
|
||||
|
||||
1;
|
||||
|
||||
|
||||
|
|
|
|||
218
lib/WebGUI/Cache/FileCache.pm
Normal file
218
lib/WebGUI/Cache/FileCache.pm
Normal file
|
|
@ -0,0 +1,218 @@
|
|||
package WebGUI::Cache::FileCache;
|
||||
|
||||
=head1 LEGAL
|
||||
|
||||
-------------------------------------------------------------------
|
||||
WebGUI is Copyright 2001-2005 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 Cache::FileCache;
|
||||
|
||||
use HTTP::Headers;
|
||||
use HTTP::Request;
|
||||
use LWP::UserAgent;
|
||||
use WebGUI::ErrorHandler;
|
||||
use WebGUI::Session;
|
||||
|
||||
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 {
|
||||
$_[0]->{_cache}->remove($_[0]->{_key});
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 deleteByRegex ( regex )
|
||||
|
||||
Remove content from the filesystem cache where the key meets the condition of the regular expression.
|
||||
|
||||
=head3 regex
|
||||
|
||||
A regular expression that will match keys in the current namespace. Example: m/^navigation_.*/
|
||||
|
||||
=cut
|
||||
|
||||
sub deleteByRegex {
|
||||
my @keys = $_[0]->{_cache}->get_keys();
|
||||
foreach my $key (@keys) {
|
||||
if ($key =~ $_[1]) {
|
||||
$_[0]->{_cache}->remove($key);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 flush ( )
|
||||
|
||||
Remove all objects from the filecache system.
|
||||
|
||||
=cut
|
||||
|
||||
sub flush {
|
||||
my $self = shift;
|
||||
$self->SUPER::flush();
|
||||
return $self->{_cache}->Clear;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 get ( )
|
||||
|
||||
Retrieve content from the filesystem cache.
|
||||
|
||||
=cut
|
||||
|
||||
sub get {
|
||||
return $_[0]->{_cache}->get($_[0]->{_key});
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 new ( key [, namespace ] )
|
||||
|
||||
Constructor.
|
||||
|
||||
=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 $key = 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::FileCache(\%options);
|
||||
bless {_cache => $cache, _key => $key}, $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 $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 stats ( )
|
||||
|
||||
Returns statistic information about the caching system.
|
||||
|
||||
=cut
|
||||
|
||||
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) {
|
||||
$self->{_cache}->set_namespace($namespace);
|
||||
$output .= "\t$namespace : ".($self->{_cache}->get_keys).
|
||||
" items / ".$self->{_cache}->size()." bytes\n";
|
||||
}
|
||||
return $output;
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
|
||||
239
lib/WebGUI/Cache/Memcached.pm
Normal file
239
lib/WebGUI/Cache/Memcached.pm
Normal file
|
|
@ -0,0 +1,239 @@
|
|||
package WebGUI::Cache::Memcached;
|
||||
|
||||
=head1 LEGAL
|
||||
|
||||
-------------------------------------------------------------------
|
||||
WebGUI is Copyright 2001-2005 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 Cache::Memcached;
|
||||
|
||||
use HTTP::Headers;
|
||||
use HTTP::Request;
|
||||
use LWP::UserAgent;
|
||||
use WebGUI::ErrorHandler;
|
||||
use WebGUI::Session;
|
||||
|
||||
our @ISA = qw(WebGUI::Cache);
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Package WebGUI::Cache::Memcached
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This package provides an interface to the memcached distributed caching system.
|
||||
See http://www.danga.com/memcached/ for more details on memcached.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use WebGUI::Cache::Memcached;
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
These methods are available from this class:
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 delete ( )
|
||||
|
||||
Deletes a key of the Memcached system.
|
||||
|
||||
=cut
|
||||
|
||||
sub delete {
|
||||
$_[0]->{_cache}->delete($_[0]->{_key});
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=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 ( )
|
||||
|
||||
Flushes the Memcached system.
|
||||
|
||||
=cut
|
||||
|
||||
sub flush {
|
||||
my $self = shift;
|
||||
$self->SUPER::flush();
|
||||
my $memd = $self->{_cache};
|
||||
my $succes = 1;
|
||||
$memd->init_buckets() unless $memd->{'buckets'};
|
||||
my @hosts = @{$memd->{'buckets'}};
|
||||
foreach my $host (@hosts) {
|
||||
my $sock = $memd->sock_to_host($host);
|
||||
my @res = $memd->run_command($sock, "flush_all\r\n");
|
||||
$success = 0 unless (@res);
|
||||
# Reset stats
|
||||
$memd->run_command($sock, "stats reset\r\n");
|
||||
}
|
||||
return $success;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 get ( )
|
||||
|
||||
Retrieve content from the filesystem cache.
|
||||
|
||||
=cut
|
||||
|
||||
sub get {
|
||||
return $_[0]->{_cache}->get($_[0]->{_key});
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 new ( key [, namespace ] )
|
||||
|
||||
Constructor.
|
||||
|
||||
=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 $key = shift;
|
||||
my $namespace = shift || $session{config}{configFile};
|
||||
|
||||
my $servers = $session{config}{memcached_servers};
|
||||
$servers = [ $servers ] unless (ref $servers);
|
||||
|
||||
my %options = (
|
||||
namespace=>$namespace,
|
||||
servers=>$servers
|
||||
);
|
||||
|
||||
$cache = new Cache::Memcached(\%options);
|
||||
bless {_cache => $cache, _key => $key}, $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 $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 stats ( )
|
||||
|
||||
Returns statistic information about the caching system.
|
||||
|
||||
=cut
|
||||
|
||||
sub stats {
|
||||
my $self = shift;
|
||||
my $output;
|
||||
my $memd = $self->{_cache};
|
||||
# There's a bug in the Cache::Memcached->stats function that
|
||||
# only returns the first row of statistic data.
|
||||
# That's why we issue the stats command ourselve.
|
||||
$memd->init_buckets() unless $memd->{'buckets'};
|
||||
my @hosts = @{$memd->{'buckets'}};
|
||||
foreach my $host (@hosts) {
|
||||
$output .= "HOST: $host\n";
|
||||
my $sock = $memd->sock_to_host($host);
|
||||
my @res = $memd->run_command($sock, "stats\r\n");
|
||||
$output .= join("",@res)."\n\n";
|
||||
$output =~ s/STAT/ /g;
|
||||
$output =~ s/END*//g;
|
||||
}
|
||||
return $output;
|
||||
}
|
||||
|
||||
|
||||
|
||||
1;
|
||||
|
||||
|
||||
|
|
@ -195,6 +195,8 @@ sub getOperations {
|
|||
'selectPaymentGateway' => 'WebGUI::Operation::Commerce',
|
||||
'viewPurchaseHistory' => 'WebGUI::Operation::TransactionLog',
|
||||
'cancelRecurringTransaction' => 'WebGUI::Operation::TransactionLog',
|
||||
'manageCache' => 'WebGUI::Operation::Cache',
|
||||
'flushCache' => 'WebGUI::Operation::Cache',
|
||||
};
|
||||
}
|
||||
|
||||
|
|
|
|||
63
lib/WebGUI/Operation/Cache.pm
Normal file
63
lib/WebGUI/Operation/Cache.pm
Normal file
|
|
@ -0,0 +1,63 @@
|
|||
package WebGUI::Operation::Cache;
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
# WebGUI is Copyright 2001-2005 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
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
use strict;
|
||||
use WebGUI::AdminConsole;
|
||||
use WebGUI::Cache;
|
||||
use WebGUI::International;
|
||||
use WebGUI::Privilege;
|
||||
use WebGUI::Session;
|
||||
use WebGUI::Form;
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub _submenu {
|
||||
my $workarea = shift;
|
||||
my $title = shift;
|
||||
$title = WebGUI::International::get($title) if ($title);
|
||||
my $ac = WebGUI::AdminConsole->new("cache");
|
||||
if ($session{setting}{trackPageStatistics}) {
|
||||
$ac->addSubmenuItem( WebGUI::URL::page('op=manageCache'), WebGUI::International::get('manage cache'));
|
||||
}
|
||||
return $ac->render($workarea, $title);
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub www_flushCache {
|
||||
my $cache = WebGUI::Cache->new();
|
||||
$cache->flush;
|
||||
return www_manageCache();
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub www_manageCache {
|
||||
return WebGUI::Privilege::adminOnly() unless (WebGUI::Grouping::isInGroup(3));
|
||||
my ($output, $data);
|
||||
my $cache = WebGUI::Cache->new();
|
||||
my $flushURL = WebGUI::URL::page('op=flushCache');
|
||||
$output .= '<table>';
|
||||
$output .= '<tr><td align="right" class="tableHeader">'.WebGUI::International::get('cache type').':</td><td class="tableData">'.ref($cache).'</td></tr>';
|
||||
$output .= '<tr><td align="right" valign="top" class="tableHeader">'.WebGUI::International::get('cache statistics').':</td><td class="tableData"><pre>'.$cache->stats.'</pre></td></tr>';
|
||||
$output .= '<tr><td align="right" valign="top" class="tableHeader"> </td><td class="tableData">'.
|
||||
WebGUI::Form::button({
|
||||
value=>WebGUI::International::get("clear cache"),
|
||||
extras=>qq{onclick="document.location.href='$flushURL';"},
|
||||
}).
|
||||
'</td></tr>';
|
||||
|
||||
$output .= "</table>";
|
||||
return _submenu($output);
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
|
|
@ -4092,6 +4092,24 @@ Message Boards hold forums for users. There are many different Wobjects in WebG
|
|||
|,
|
||||
lastUpdated => 1112141941,
|
||||
},
|
||||
'manage cache' => {
|
||||
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
|
||||
},
|
||||
|
||||
|
||||
|
||||
};
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue