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

added off switch for debugging to speed things up

Browse source
This commit is contained in:
JT Smith 2009-09-27 21:52:46 -05:00
parent ee8ebd44e4
commit 393789e72f
1 changed files with 187 additions and 141 deletions
Download patch file Download diff file Expand all files Collapse all files

328
lib/WebGUI/Cache.pm
View file

@ -74,34 +74,37 @@ The key to delete.
=cut =cut
sub delete { sub delete {
my ($self, $name) = validate_pos(@_, my $self = shift;
1, my $debug = $self->withDebug;
{ type => SCALAR | ARRAYREF }, my ($name) = ($debug) ? validate_pos(@_, { type => SCALAR | ARRAYREF }) : @_;
);
my $log = $self->session->log;
my $key = $self->parseKey($name); my $key = $self->parseKey($name);
$log->debug("Called delete() on cache key $key."); if ($debug) {
$self->session->log->debug("Called delete() on cache key $key.");
}
my $memcached = $self->getMemcached; my $memcached = $self->getMemcached;
Memcached::libmemcached::memcached_delete($memcached, $key); Memcached::libmemcached::memcached_delete($memcached, $key);
if ($memcached->errstr eq 'SYSTEM ERROR Unknown error: 0') { if ($debug) {
$log->debug("Cannot connect to memcached server."); my $log = $self->session->log;
WebGUI::Error::Connection->throw( if ($memcached->errstr eq 'SYSTEM ERROR Unknown error: 0') {
error => "Cannot connect to memcached server." $log->debug("Cannot connect to memcached server.");
); WebGUI::Error::Connection->throw(
} error => "Cannot connect to memcached server."
elsif ($memcached->errstr eq 'NO SERVERS DEFINED') { );
$log->warn("No memcached servers specified in config file."); }
WebGUI::Error->throw( elsif ($memcached->errstr eq 'NO SERVERS DEFINED') {
error => "No memcached servers specified in config file." $log->warn("No memcached servers specified in config file.");
); WebGUI::Error->throw(
} error => "No memcached servers specified in config file."
elsif ($memcached->errstr ne 'SUCCESS' # deleted );
&& $memcached->errstr ne 'PROTOCOL ERROR' # doesn't exist to delete }
) { elsif ($memcached->errstr ne 'SUCCESS' # deleted
$log->debug("Couldn't delete $key from cache because ".$memcached->errstr); && $memcached->errstr ne 'PROTOCOL ERROR' # doesn't exist to delete
WebGUI::Error->throw( ) {
error => "Couldn't delete $key from cache because ".$memcached->errstr $log->debug("Couldn't delete $key from cache because ".$memcached->errstr);
); WebGUI::Error->throw(
error => "Couldn't delete $key from cache because ".$memcached->errstr
);
}
} }
} }
@ -117,27 +120,32 @@ Throws WebGUI::Error::Connection and WebGUI::Error.
sub flush { sub flush {
my ($self) = @_; my ($self) = @_;
my $log = $self->session->log; my $debug = $self->withDebug;
$log->debug("Called flush() on cache."); if ($debug) {
$self->session->log->debug("Called flush() on cache.");
}
my $memcached = $self->getMemcached; my $memcached = $self->getMemcached;
Memcached::libmemcached::memcached_flush($memcached); Memcached::libmemcached::memcached_flush($memcached);
if ($memcached->errstr eq 'SYSTEM ERROR Unknown error: 0') { if ($debug) {
$log->debug("Cannot connect to memcached server."); my $log = $self->session->log;
WebGUI::Error::Connection->throw( if ($memcached->errstr eq 'SYSTEM ERROR Unknown error: 0') {
error => "Cannot connect to memcached server." $log->debug("Cannot connect to memcached server.");
); WebGUI::Error::Connection->throw(
} error => "Cannot connect to memcached server."
elsif ($memcached->errstr eq 'NO SERVERS DEFINED') { );
$log->warn("No memcached servers specified in config file."); }
WebGUI::Error->throw( elsif ($memcached->errstr eq 'NO SERVERS DEFINED') {
error => "No memcached servers specified in config file." $log->warn("No memcached servers specified in config file.");
); WebGUI::Error->throw(
} error => "No memcached servers specified in config file."
elsif ($memcached->errstr ne 'SUCCESS') { );
$log->debug("Couldn't flush cache because ".$memcached->errstr); }
WebGUI::Error->throw( elsif ($memcached->errstr ne 'SUCCESS') {
error => "Couldn't flush cache because ".$memcached->errstr $log->debug("Couldn't flush cache because ".$memcached->errstr);
); WebGUI::Error->throw(
error => "Couldn't flush cache because ".$memcached->errstr
);
}
} }
} }
@ -156,48 +164,53 @@ The key to retrieve.
=cut =cut
sub get { sub get {
my ($self, $name) = validate_pos(@_, my $self = shift;
1, my $debug = $self->withDebug;
{ type => SCALAR | ARRAYREF }, my ($name) = ($debug) ? validate_pos(@_, { type => SCALAR | ARRAYREF }) : @_;
);
my $log = $self->session->log;
my $key = $self->parseKey($name); my $key = $self->parseKey($name);
$log->debug("Called get() on cache key $key."); if ($debug) {
$self->session->log->debug("Called get() on cache key $key.");
}
my $memcached = $self->getMemcached; my $memcached = $self->getMemcached;
my $content = Memcached::libmemcached::memcached_get($memcached, $key); my $content = Memcached::libmemcached::memcached_get($memcached, $key);
if ($memcached->errstr eq 'NOT FOUND' ) { $content = Storable::thaw($content);
$log->debug("The cache key $key has no value."); if ($debug) {
WebGUI::Error::ObjectNotFound->throw( my $log = $self->session->log;
error => "The cache key $key has no value.", if ($memcached->errstr eq 'SUCCESS') {
id => $key, unless (ref $content) {
); $log->debug("Couldn't thaw value for $key.");
} WebGUI::Error::InvalidObject->throw(
elsif ($memcached->errstr eq 'NO SERVERS DEFINED') { error => "Couldn't thaw value for $key."
$log->warn("No memcached servers specified in config file."); );
WebGUI::Error->throw( }
error => "No memcached servers specified in config file." return ${$content};
); }
} elsif ($memcached->errstr eq 'NOT FOUND' ) {
elsif ($memcached->errstr eq 'SYSTEM ERROR Unknown error: 0') { $log->debug("The cache key $key has no value.");
$log->debug("Cannot connect to memcached server."); WebGUI::Error::ObjectNotFound->throw(
WebGUI::Error::Connection->throw( error => "The cache key $key has no value.",
error => "Cannot connect to memcached server." id => $key,
); );
} }
elsif ($memcached->errstr ne 'SUCCESS') { elsif ($memcached->errstr eq 'NO SERVERS DEFINED') {
$log->warn("No memcached servers specified in config file.");
WebGUI::Error->throw(
error => "No memcached servers specified in config file."
);
}
elsif ($memcached->errstr eq 'SYSTEM ERROR Unknown error: 0') {
$log->debug("Cannot connect to memcached server.");
WebGUI::Error::Connection->throw(
error => "Cannot connect to memcached server."
);
}
$log->debug("Couldn't get $key from cache because ".$memcached->errstr); $log->debug("Couldn't get $key from cache because ".$memcached->errstr);
WebGUI::Error->throw( WebGUI::Error->throw(
error => "Couldn't get $key from cache because ".$memcached->errstr error => "Couldn't get $key from cache because ".$memcached->errstr
); );
return undef;
} }
$content = Storable::thaw($content); return (ref $content) ? ${$content} : undef;
unless (ref $content) {
$log->debug("Couldn't thaw value for $key.");
WebGUI::Error::InvalidObject->throw(
error => "Couldn't thaw value for $key."
);
}
return ${$content};
} }
#------------------------------------------------------------------- #-------------------------------------------------------------------
@ -229,34 +242,37 @@ An array reference of keys to retrieve.
=cut =cut
sub mget { sub mget {
my ($self, $names) = validate_pos(@_, my $self = shift;
1, my $debug = $self->withDebug;
{ type => ARRAYREF }, my ($names) = ($debug) ? validate_pos(@_, { type => ARRAYREF }) : @_;
);
my $log = $self->session->log;
my @keys = map { $self->parseKey($_) } @{ $names }; my @keys = map { $self->parseKey($_) } @{ $names };
$log->debug("Called mget() for keys (".join(", ",@keys).") on cache."); my $log = $self->session->log;
if ($debug) {
$log->debug("Called mget() for keys (".join(", ",@keys).") on cache.");
}
my %result; my %result;
my $memcached = $self->getMemcached; my $memcached = $self->getMemcached;
$memcached->mget_into_hashref(\@keys, \%result); $memcached->mget_into_hashref(\@keys, \%result);
if ($memcached->errstr eq 'SYSTEM ERROR Unknown error: 0') { if ($debug) {
$log->debug("Cannot connect to memcached server."); if ($memcached->errstr eq 'SYSTEM ERROR Unknown error: 0') {
WebGUI::Error::Connection->throw( $log->debug("Cannot connect to memcached server.");
error => "Cannot connect to memcached server." WebGUI::Error::Connection->throw(
); error => "Cannot connect to memcached server."
} );
elsif ($memcached->errstr eq 'NO SERVERS DEFINED') { }
$log->warn("No memcached servers specified in config file."); elsif ($memcached->errstr eq 'NO SERVERS DEFINED') {
WebGUI::Error->throw( $log->warn("No memcached servers specified in config file.");
error => "No memcached servers specified in config file." WebGUI::Error->throw(
); error => "No memcached servers specified in config file."
);
}
} }
# no other useful status messages are returned # no other useful status messages are returned
my @values; my @values;
foreach my $key (@keys) { foreach my $key (@keys) {
my $content = Storable::thaw($result{$key}); my $content = Storable::thaw($result{$key});
unless (ref $content) { unless (ref $content) {
$log->debug("Cannot thaw key $key."); $log->debug("Cannot thaw key $key.") if ($debug);
next; next;
} }
push @values, ${$content}; push @values, ${$content};
@ -266,9 +282,9 @@ sub mget {
#------------------------------------------------------------------- #-------------------------------------------------------------------
=head2 new ( session ) =head2 new ( session, withDebug )
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. Constructor. 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.
Throws WebGUI::Error::InvalidParam. Throws WebGUI::Error::InvalidParam.
@ -276,14 +292,23 @@ Throws WebGUI::Error::InvalidParam.
A reference to the current session. A reference to the current session.
=head3 withDebug
A boolean indicating you want to enable parameter validation, exception handling, and debug logging. Note that this will make the cahe system up to 3 times slower. It will still be very fast, but not production fast.
=cut =cut
sub new { sub new {
my ($class, $session) = validate_pos(@_, my ($class, $session, $withDebug) = validate_pos(@_,
1, 1,
{ isa => 'WebGUI::Session' }, { isa => 'WebGUI::Session' },
{ type => SCALAR | UNDEF, optional=>1, default=>0 },
); );
$session->log->debug("Instanciated cache object."); if ($withDebug) {
my $log = $session->log;
$log->debug("Instanciated cache object.");
$log->debug("Cache debugging ".($withDebug ? "enabled" : "disabled").".");
}
my $config = $session->config; my $config = $session->config;
my $namespace = $config->getFilename; my $namespace = $config->getFilename;
my $memcached = Memcached::libmemcached::memcached_create(); # no exception because always returns success my $memcached = Memcached::libmemcached::memcached_create(); # no exception because always returns success
@ -295,7 +320,7 @@ sub new {
Memcached::libmemcached::memcached_server_add($memcached, $server->{host}, $server->{port}); # no exception because always returns success Memcached::libmemcached::memcached_server_add($memcached, $server->{host}, $server->{port}); # no exception because always returns success
} }
} }
bless {_memcached => $memcached, _namespace => $namespace, _session => $session}, $class; bless {_memcached => $memcached, _namespace => $namespace, _session => $session, _withDebug=>$withDebug}, $class;
} }
#------------------------------------------------------------------- #-------------------------------------------------------------------
@ -313,10 +338,8 @@ Can either be a text key, or a composite key. If it's a composite key, it will b
=cut =cut
sub parseKey { sub parseKey {
my ($self, $name) = validate_pos(@_, my $self = shift;
1, my ($name) = ($self->withDebug) ? validate_pos(@_, { type => SCALAR | ARRAYREF }) : @_;
{ type => SCALAR | ARRAYREF },
);
# prepend namespace to the key # prepend namespace to the key
my @key = ($self->{_namespace}); my @key = ($self->{_namespace});
@ -369,31 +392,34 @@ A time in seconds for the cache to exist. When you override default it to 60 sec
=cut =cut
sub set { sub set {
my ($self, $name, $value, $ttl) = validate_pos(@_, my $self = shift;
1, my $debug = $self->withDebug;
{ type => SCALAR | ARRAYREF }, my ($name, $value, $ttl) = ($debug) ? validate_pos(@_, { type => SCALAR | ARRAYREF }, { type => SCALAR }, { type => SCALAR | UNDEF, optional => 1 }) : @_;
{ type => SCALAR }, $ttl ||= 60;
{ type => SCALAR | UNDEF, optional => 1, default=> 60 },
);
my $log = $self->session->log;
my $key = $self->parseKey($name); my $key = $self->parseKey($name);
$log->debug("Called set() on cache key $key with $value as the value."); if ($debug) {
$self->session->log->debug("Called set() on cache key $key with $value as the value.");
}
my $frozenValue = Storable::nfreeze(\(scalar $value)); # Storable doesn't like non-reference arguments, so we wrap it in a scalar ref. my $frozenValue = Storable::nfreeze(\(scalar $value)); # Storable doesn't like non-reference arguments, so we wrap it in a scalar ref.
my $memcached = $self->getMemcached; my $memcached = $self->getMemcached;
Memcached::libmemcached::memcached_set($memcached, $key, $frozenValue, $ttl); Memcached::libmemcached::memcached_set($memcached, $key, $frozenValue, $ttl);
if ($memcached->errstr eq 'SYSTEM ERROR Unknown error: 0') { if ($debug) {
$log->debug("Cannot connect to memcached server."); my $log = $self->session->log;
WebGUI::Error::Connection->throw( if ($memcached->errstr eq 'SUCCESS') {
error => "Cannot connect to memcached server." return $value;
); }
} elsif ($memcached->errstr eq 'SYSTEM ERROR Unknown error: 0') {
elsif ($memcached->errstr eq 'NO SERVERS DEFINED') { $log->debug("Cannot connect to memcached server.");
$log->warn("No memcached servers specified in config file."); WebGUI::Error::Connection->throw(
WebGUI::Error->throw( error => "Cannot connect to memcached server."
error => "No memcached servers specified in config file." );
); }
} elsif ($memcached->errstr eq 'NO SERVERS DEFINED') {
elsif ($memcached->errstr ne 'SUCCESS') { $log->warn("No memcached servers specified in config file.");
WebGUI::Error->throw(
error => "No memcached servers specified in config file."
);
}
$log->debug("Couldn't set $key to cache because ".$memcached->errstr); $log->debug("Couldn't set $key to cache because ".$memcached->errstr);
WebGUI::Error->throw( WebGUI::Error->throw(
error => "Couldn't set $key to cache because ".$memcached->errstr error => "Couldn't set $key to cache because ".$memcached->errstr
@ -422,32 +448,46 @@ The time to live for this content. This is the amount of time (in seconds) that
=cut =cut
sub setByHttp { sub setByHttp {
my ($self, $url, $ttl) = validate_pos(@_, my $self = shift;
1, my $debug = $self->withDebug;
{ type => SCALAR }, my ($url, $ttl) = ($debug) ? validate_pos(@_, { type => SCALAR }, { type => SCALAR, optional => 1 }) : @_;
{ type => SCALAR, optional => 1 }, if ($debug) {
); $self->session->log->debug("Called setByHttp() with URL $url.");
my $log = $self->session->log; }
$log->debug("Called setByHttp() with URL $url.");
my $userAgent = new LWP::UserAgent; my $userAgent = new LWP::UserAgent;
$userAgent->env_proxy; $userAgent->env_proxy;
$userAgent->agent("WebGUI/".$WebGUI::VERSION); $userAgent->agent("WebGUI/".$WebGUI::VERSION);
$userAgent->timeout(30); $userAgent->timeout(30);
my $request = HTTP::Request->new(GET => $url); my $request = HTTP::Request->new(GET => $url);
my $response = $userAgent->request($request); my $response = $userAgent->request($request);
if ($response->is_error) { if ($response->is_error) {
$log->error("$url could not be retrieved."); $self->session->log->error("$url could not be retrieved.");
WebGUI::Error::Connection->throw( if ($debug) {
error => "Couldn't fetch $url because ".$response->message, WebGUI::Error::Connection->throw(
resource => $url, error => "Couldn't fetch $url because ".$response->message,
); resource => $url,
);
}
} }
return $self->set($url, $response->decoded_content, $ttl); return $self->set($url, $response->decoded_content, $ttl);
} }
#-------------------------------------------------------------------
=head2 withDebug ()
Returns a boolean indicating whether the cache system should log debug, validate parameters, and throw exceptions.
=cut
sub withDebug {
my $self = shift;
return $self->{_withDebug};
}
=head1 EXCEPTIONS =head1 EXCEPTIONS
This class throws a lot of inconvenient exceptions. However, because cache should be treated as optional, none of them matter except for testing, debugging, or in very specific use cases. Therefore the best practice is to simply call each method with an eval wrapper, and then not even bother testing for specific exceptions like this: This class throws a lot of inconvenient exceptions. However, because cache should be treated as optional, none of them matter except for testing, debugging, or in very specific use cases. Therefore the best practice is to simply call each method with an eval wrapper, and then not even bother testing for specific exceptions like this:
@ -459,6 +499,8 @@ This class throws a lot of inconvenient exceptions. However, because cache shoul
If you want to see what exceptions are being thrown, or anything else about the internal operations of the cache system, simply turn on DEBUG mode in your log. Everything you want will be there. If you want to see what exceptions are being thrown, or anything else about the internal operations of the cache system, simply turn on DEBUG mode in your log. Everything you want will be there.
NOTE: In order for exceptions to be thrown and logged with debug must be passed into the constructor.
The exceptions that can be thrown are: The exceptions that can be thrown are:
=head2 WebGUI::Error =head2 WebGUI::Error
@ -477,6 +519,10 @@ When you pass in the wrong arguments.
When you request a cache key that doesn't exist on any configured memcached server. When you request a cache key that doesn't exist on any configured memcached server.
=head2 WebGUI::Error::InvalidObject
When an object can't be thawed from cache due to corruption of some sort.
=cut =cut