Remove Database and FileCache modules.
This commit is contained in:
Colin Kuskie
parent
e6696ee534
commit
da567e1fcc
2 changed files with 0 additions and 489 deletions
|
|
@ -1,205 +0,0 @@
|
|||
package WebGUI::Cache::Database;
|
||||
|
||||
=head1 LEGAL
|
||||
|
||||
-------------------------------------------------------------------
|
||||
WebGUI is Copyright 2001-2009 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 strict;
|
||||
use base "WebGUI::Cache";
|
||||
use Storable ();
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Package WebGUI::Cache::Database
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This package provides a means for WebGUI to cache data to the database.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use WebGUI::Cache::Database;
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
These methods are available from this class:
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 delete ( )
|
||||
|
||||
Remove content from the filesystem cache.
|
||||
|
||||
=cut
|
||||
|
||||
sub delete {
|
||||
my $self = shift;
|
||||
$self->session->db->write("delete from cache where namespace=? and cachekey=?",[$self->{_namespace}, $self->{_key}]);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 deleteChunk ( key )
|
||||
|
||||
Remove a partial composite key from the cache.
|
||||
|
||||
=head3 key
|
||||
|
||||
A partial composite key to remove.
|
||||
|
||||
=cut
|
||||
|
||||
sub deleteChunk {
|
||||
my $self = shift;
|
||||
my $key = $self->parseKey(shift);
|
||||
$self->session->db->write("delete from cache where namespace=? and cachekey like ?",[$self->{_namespace}, $key.'%']);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 flush ( )
|
||||
|
||||
Remove all objects from the filecache system.
|
||||
|
||||
=cut
|
||||
|
||||
sub flush {
|
||||
my $self = shift;
|
||||
$self->SUPER::flush();
|
||||
$self->session->db->write("delete from cache where namespace=?",[$self->{_namespace}]);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 get ( )
|
||||
|
||||
Retrieve content from the database cache.
|
||||
|
||||
=cut
|
||||
|
||||
sub get {
|
||||
my $self = shift;
|
||||
my $session = $self->session;
|
||||
return undef if ($session->config->get("disableCache"));
|
||||
my $sth = $session->db->dbh->prepare("select content from cache where namespace=? and cachekey=? and expires>?");
|
||||
$sth->execute($self->{_namespace},$self->{_key},time());
|
||||
my $data = $sth->fetchrow_arrayref;
|
||||
$sth->finish;
|
||||
my $content = $data->[0];
|
||||
return undef unless ($content);
|
||||
# Storable doesn't like non-reference arguments, so we wrap it in a scalar ref.
|
||||
eval {
|
||||
$content = Storable::thaw($content);
|
||||
};
|
||||
return undef unless $content && ref $content;
|
||||
return $$content;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=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;
|
||||
$self->session->db->write("delete from cache where expires < ?",[time()+$expiresModifier]);
|
||||
my ($size) = $self->session->db->quickArray("select sum(size) from cache where namespace=?",[$self->{_namespace}]);
|
||||
return $size;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=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.
|
||||
|
||||
=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 $session = shift;
|
||||
my $key = $class->parseKey(shift);
|
||||
my $namespace = shift || $session->config->getFilename;
|
||||
bless {_session=>$session, _key=>$key, _namespace=>$namespace}, $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 $self = shift;
|
||||
# Storable doesn't like non-reference arguments, so we wrap it in a scalar ref.
|
||||
my $content = Storable::nfreeze(\(scalar shift));
|
||||
my $ttl = shift || 60;
|
||||
my $size = length($content);
|
||||
# getting better performance using native dbi than webgui sql
|
||||
my $dbh = $self->session->db->dbh;
|
||||
my $sth = $dbh->prepare("replace into cache (namespace,cachekey,expires,size,content) values (?,?,?,?,?)");
|
||||
$sth->execute($self->{_namespace}, $self->{_key}, time()+$ttl, $size, $content);
|
||||
$sth->finish;
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 stats ( )
|
||||
|
||||
Returns statistic information about the caching system.
|
||||
|
||||
=cut
|
||||
|
||||
sub stats {
|
||||
my $self = shift;
|
||||
my ($size) = $self->session->db->quickArray("select sum(size) from cache where namespace=?",[$self->{_namespace}]);
|
||||
return $size." bytes";
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
|
||||
|
|
@ -1,284 +0,0 @@
|
|||
package WebGUI::Cache::FileCache;
|
||||
|
||||
=head1 LEGAL
|
||||
|
||||
-------------------------------------------------------------------
|
||||
WebGUI is Copyright 2001-2009 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 strict;
|
||||
use Storable ();
|
||||
use File::Path ();
|
||||
use File::Find ();
|
||||
|
||||
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 {
|
||||
my $self = shift;
|
||||
my $folder = $self->getFolder;
|
||||
if (-e $folder) {
|
||||
File::Path::rmtree($folder);
|
||||
}
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 deleteChunk ( key )
|
||||
|
||||
Remove a partial composite key from the cache.
|
||||
|
||||
=head3 key
|
||||
|
||||
A partial composite key to remove.
|
||||
|
||||
=cut
|
||||
|
||||
sub deleteChunk {
|
||||
my $self = shift;
|
||||
my $folder = $self->getNamespaceRoot."/".$self->parseKey(shift);
|
||||
if (-e $folder) {
|
||||
File::Path::rmtree($folder);
|
||||
}
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 flush ( )
|
||||
|
||||
Remove all objects from the filecache system.
|
||||
|
||||
=cut
|
||||
|
||||
sub flush {
|
||||
my $self = shift;
|
||||
$self->SUPER::flush();
|
||||
my $folder = $self->getNamespaceRoot;
|
||||
if (-e $folder) {
|
||||
File::Path::rmtree($folder);
|
||||
}
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 get ( )
|
||||
|
||||
Retrieve content from the filesystem cache.
|
||||
|
||||
=cut
|
||||
|
||||
sub get {
|
||||
my $self = shift;
|
||||
return undef if ($self->session->config->get("disableCache"));
|
||||
my $folder = $self->getFolder;
|
||||
if (-e $folder."/expires" && -e $folder."/cache" && open(my $FILE,"<",$folder."/expires")) {
|
||||
my $expires = <$FILE>;
|
||||
close($FILE);
|
||||
return undef if ($expires < time);
|
||||
my $value;
|
||||
eval {$value = Storable::retrieve($folder."/cache")};
|
||||
if (ref $value eq "SCALAR") {
|
||||
return $$value;
|
||||
} else {
|
||||
return $value;
|
||||
}
|
||||
}
|
||||
return undef;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 getFolder ( )
|
||||
|
||||
Returns the path to the cache folder for this key.
|
||||
|
||||
=cut
|
||||
|
||||
sub getFolder {
|
||||
my $self = shift;
|
||||
return $self->getNamespaceRoot()."/".$self->{_key};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 getNamespaceRoot ( )
|
||||
|
||||
Figures out what the cache root for this namespace should be. A class method.
|
||||
|
||||
=cut
|
||||
|
||||
sub getNamespaceRoot {
|
||||
my $self = shift;
|
||||
my $root = $self->session->config->get("fileCacheRoot");
|
||||
unless ($root) {
|
||||
if ($self->session->os->get("windowsish")) {
|
||||
$root = $self->session->env->get("TEMP") || $self->session->env->get("TMP") || "/temp";
|
||||
} else {
|
||||
$root = "/tmp";
|
||||
}
|
||||
$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 $cacheSize = 0;
|
||||
File::Find::find({
|
||||
no_chdir => 1,
|
||||
wanted => sub {
|
||||
return
|
||||
unless $File::Find::name =~ m/expires$/;
|
||||
if ( open my $FILE, "<", $File::Find::name ) {
|
||||
my $expires = <$FILE>;
|
||||
close $FILE;
|
||||
if ($expires < time + $expiresModifier) {
|
||||
File::Path::rmtree($File::Find::dir);
|
||||
$File::Find::prune = 1;
|
||||
return
|
||||
}
|
||||
else {
|
||||
$cacheSize += -s $File::Find::dir.'/cache';
|
||||
}
|
||||
}
|
||||
},
|
||||
}, $self->getNamespaceRoot);
|
||||
return $cacheSize;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=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.
|
||||
|
||||
=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 $session = shift;
|
||||
my $key = $class->parseKey(shift);
|
||||
my $namespace = shift || $session->config->getFilename;
|
||||
bless {_session=>$session, _key=>$key, _namespace=>$namespace}, $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 $self = shift;
|
||||
my $content = shift;
|
||||
my $ttl = shift || 60;
|
||||
my $oldumask = umask();
|
||||
umask(0000);
|
||||
my $path = $self->getFolder();
|
||||
unless (-e $path) {
|
||||
eval {File::Path::mkpath($path,0)};
|
||||
if ($@) {
|
||||
$self->session->errorHandler->error("Couldn't create cache folder: ".$path." : ".$@);
|
||||
return undef;
|
||||
}
|
||||
}
|
||||
my $value;
|
||||
unless (ref $content) {
|
||||
$value = \$content;
|
||||
} else {
|
||||
$value = $content;
|
||||
}
|
||||
Storable::nstore($value, $path."/cache");
|
||||
open my $FILE, ">", $path."/expires";
|
||||
print $FILE time + $ttl;
|
||||
close $FILE;
|
||||
umask($oldumask);
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 stats ( )
|
||||
|
||||
Returns statistic information about the caching system.
|
||||
|
||||
=cut
|
||||
|
||||
sub stats {
|
||||
my $self = shift;
|
||||
return $self->getNamespaceSize." bytes";
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
|
||||
Loading…
Add table
Add a link
Reference in a new issue