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

more session related changes

Browse source
This commit is contained in:
JT Smith 2006-01-09 19:56:26 +00:00
parent 16b9675b0c
commit 024514c549
106 changed files with 1498 additions and 1313 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -106,7 +106,7 @@ Retrieve content from the filesystem cache.
sub get {
my $self = shift;
return undef if ($WebGUI::Session::session{config}{disableCache});
return undef if ($self->session->config->get("disableCache"));
my $folder = $self->getFolder;
if (-e $folder."/expires" && -e $folder."/cache" && open(FILE,"<".$folder."/expires")) {
my $expires = <FILE>;
@ -146,10 +146,10 @@ Figures out what the cache root for this namespace should be. A class method.
sub getNamespaceRoot {
my $self = shift;
my $root = $WebGUI::Session::session{config}{fileCacheRoot};
my $root = $self->session->config->get("fileCacheRoot");
unless ($root) {
if ($WebGUI::Session::session{os}{windowsish}) {
$root = $WebGUI::Session::session{env}{TEMP} || $WebGUI::Session::session{env}{TMP} || "/temp";
if ($self->session->os->get("windowsish")) {
$root = $self->session->env->get("TEMP") || $self->session->env->get("TMP") || "/temp";
} else {
$root = "/tmp";
}
@ -167,18 +167,10 @@ Returns the size (in bytes) of the current cache under this namespace. Consequen
=cut
#-------------------------------------------------------------------
=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;
$session{cacheSize} = 0;
$self->session->stow->set("cacheSize", 0);
File::Find::find({no_chdir=>1, wanted=> sub {
return unless $File::Find::name =~ m/^(.*)expires$/;
my $dir = $1;
@ -188,20 +180,24 @@ sub getNamespaceSize {
if ($expires < time()+$expiresModifier) {
rmtree($dir);
} else {
$session{cacheSize} += -s $dir.'cache';
$self->session->stow->set("cacheSize", $self->session->stow->get("cacheSize") + -s $dir.'cache');
}
}
}
}, $self->getNamespaceRoot);
return $session{cacheSize};
return $self->session->stow->get("cacheSize");
}
#-------------------------------------------------------------------
=head2 new ( key [, namespace ] )
=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.
@ -215,9 +211,10 @@ Defaults to the config filename for the current site. The only reason to overrid
sub new {
my $cache;
my $class = shift;
my $session = shift;
my $key = $class->parseKey(shift);
my $namespace = shift || $WebGUI::Session::session{config}{configFile};
bless {_key=>$key, _namespace=>$namespace}, $class;
my $namespace = shift || $session->config->getFilename;
bless {_session=>$session, _key=>$key, _namespace=>$namespace}, $class;
}
@ -247,7 +244,7 @@ sub set {
unless (-e $path) {
eval {mkpath($path,0)};
if ($@) {
WebGUI::ErrorHandler::error("Couldn't create cache folder: ".$path." : ".$@);
$self->session->errorHandler->error("Couldn't create cache folder: ".$path." : ".$@);
return;
}
}

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

@ -16,7 +16,6 @@ package WebGUI::Cache::Memcached;
use Cache::Memcached;
use Digest::MD5;
use WebGUI::Session;
our @ISA = qw(WebGUI::Cache);
@ -89,16 +88,20 @@ Retrieve content from the filesystem cache.
=cut
sub get {
return undef if ($WebGUI::Session::session{config}{disableCache});
return undef if ($_[0]->session->get("disableCache"));
return $_[0]->{_cache}->get($_[0]->{_key});
}
#-------------------------------------------------------------------
=head2 new ( key [, namespace ] )
=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.
@ -112,15 +115,16 @@ Defaults to the config filename for the current site. The only reason to overrid
sub new {
my $cache;
my $class = shift;
my $session = shift;
my $key = $class->parseKey(shift);
my $namespace = shift || $WebGUI::Session::session{config}{configFile};
my $namespace = shift || $session->config->getFilename;
# Overcome maximum key length of 255 characters
if(length($key.$namespace) > 255) {
$key = Digest::MD5::md5_base64($key);
}
my $servers = $WebGUI::Session::session{config}{memcached_servers};
my $servers = $session->config->get("memcached_servers");
$servers = [ $servers ] unless (ref $servers);
my %options = (
@ -129,7 +133,7 @@ sub new {
);
$cache = new Cache::Memcached(\%options);
bless {_cache => $cache, _key => $key}, $class;
bless {_session=>$session, _cache => $cache, _key => $key}, $class;
}