Skip to content

Commit

Permalink
Item8706: more bottom wiping for cache; cleaned up doc, framework for…
Browse files Browse the repository at this point in the history
… unit testing (currently little more than a compile check). Removed the debug option from configure (it was a no-op) and added a TRACE mode

git-svn-id: http://svn.foswiki.org/trunk@7456 0b4bb1d4-4e5a-0410-9cc4-b2b747904278
  • Loading branch information
CrawfordCurrie authored and CrawfordCurrie committed May 18, 2010
1 parent f07d2c1 commit f3eb3c0
Show file tree
Hide file tree
Showing 12 changed files with 345 additions and 449 deletions.
Expand Up @@ -17,6 +17,7 @@ test/bin/TestRunner.pl 0755
test/unit/AccessControlTests.pm 0644
test/unit/AttrsTests.pm 0644
test/unit/AutoAttachTests.pm 0644
test/unit/CacheTests.pm 0755
test/unit/ClientTests.pm 0755
test/unit/ConfigureTests.pm 0644
test/unit/EmptyTests.pm 0644
Expand Down
143 changes: 143 additions & 0 deletions UnitTestContrib/test/unit/CacheTests.pm
@@ -0,0 +1,143 @@
package CacheTests;

use FoswikiFnTestCase;
our @ISA = qw( FoswikiFnTestCase );

use strict;
use Foswiki;
use Foswiki::Meta;
use Error qw( :try );
use Foswiki::OopsException;
use Foswiki::PageCache;
use Benchmark qw(:hireswallclock);

my $UI_FN;

sub fixture_groups {
my $this = shift;
my @page;
foreach my $dir (@INC) {
if ( opendir( D, "$dir/Foswiki/Cache" ) ) {
foreach my $alg ( readdir D ) {
next unless $alg =~ s/^(.*)\.pm$/$1/;
next if defined &$alg;
$ENV{PATH} =~ /^(.*)$/ms;
$ENV{PATH} = $1;
($alg) = $alg =~ /^(.*)$/ms;
eval "require Foswiki::Cache::$alg";
if ($@ ) {
print STDERR "Cannot test Foswiki::Cache::$alg\nCompilation error when trying to 'require' it\n";
} else {
no strict 'refs';
*$alg = sub {
my $this = shift;
$Foswiki::cfg{CacheManager} = 'Foswiki::Cache::'.$alg;
};
use strict 'refs';
push(@page, $alg);
}
}
closedir(D);
}
}

return ( \@page, [ 'DBFileMeta', 'BDBMeta' ], [ 'NoCompress', 'Compress' ] );
}

sub DBFileMeta {
$Foswiki::cfg{MetaCacheManager} = 'Foswiki::Cache::DB_File';
}

sub BDBMeta {
$Foswiki::cfg{MetaCacheManager} = 'Foswiki::Cache::BDB';
}

sub Compress {
$Foswiki::cfg{HttpCompress} = 1;
$Foswiki::cfg{Cache}{Compress} = 1;
}

sub NoCompress {
$Foswiki::cfg{HttpCompress} = 0;
$Foswiki::cfg{Cache}{Compress} = 0;
}

sub set_up {
my $this = shift;
$this->SUPER::set_up();

$Foswiki::cfg{Cache}{Enabled} = 0;
$Foswiki::cfg{HttpCompress} = 0;
$Foswiki::cfg{Cache}{Compress} = 0;
$UI_FN ||= $this->getUIFn('view');
}

sub tear_down {
my $this = shift;
$this->SUPER::tear_down();
}

sub verify_view {
my $this = shift;

$UI_FN ||= $this->getUIFn('view');

my $query = new Unit::Request(
{
skin => ['none'],
}
);
$query->path_info("/");
$query->method('POST');

my $fatwilly = new Foswiki( $this->{test_user_login}, $query );

# This first request should *not* be satisfied from the cache, but
# the cache should be populated with the result.
my $p1start = new Benchmark();
my ($one) = $this->capture(
sub {
no strict 'refs';
&$UI_FN($fatwilly);
use strict 'refs';
$Foswiki::engine->finalize( $fatwilly->{response},
$fatwilly->{request} );
}
);

my $p1end = new Benchmark();
print STDERR "R1 ".timestr(timediff($p1end, $p1start))."\n";
$fatwilly->finish();

$fatwilly = new Foswiki( $this->{test_user_login}, $query );

# This second request should be satisfied from the cache
my $p2start = new Benchmark();
my ($two) = $this->capture(
sub {
no strict 'refs';
&$UI_FN($fatwilly);
use strict 'refs';
$Foswiki::engine->finalize( $fatwilly->{response},
$fatwilly->{request} );
}
);
my $p2end = new Benchmark();
print STDERR "R2 ".timestr(timediff($p2end, $p2start))."\n";
$fatwilly->finish();


# Massage the HTML for comparison
$one =~ s/\r//g;
$one =~ s/^.*?\n\n+//s;
$one =~ s/value=['"]\??[a-fA-F0-9]{32}['"]/value=vkey/gs;
$one =~ s/([?;&]t=)\d+/${1}0/g;
$two =~ s/\r//g;
$two =~ s/^.*?\n\n+//s;
$two =~ s/value=['"]\??[a-fA-F0-9]{32}['"]/value=vkey/gs;
$two =~ s/([?;&]t=)\d+/${1}0/g;

$this->assert_html_equals($one, $two);
}

1;
4 changes: 0 additions & 4 deletions core/lib/Foswiki.spec
Expand Up @@ -1105,10 +1105,6 @@ $Foswiki::cfg{Cache}{Servers} = '127.0.0.1:11211';
# about disk space.
$Foswiki::cfg{Cache}{Compress} = $TRUE;
# **BOOLEAN EXPERT**
# This setting will switch on/off debugging for caching.
$Foswiki::cfg{Cache}{Debug} = $FALSE;
#---+ Mail and Proxies
# <p>Settings controlling if and how Foswiki sends email, and the proxies used
# to access external web pages.</p>
Expand Down
46 changes: 26 additions & 20 deletions core/lib/Foswiki/Cache.pm
@@ -1,9 +1,12 @@
# See bottom of file for license and copyright information

=pod
---+ package Foswiki::Cache
Base class for Foswiki::Cache implementations
Virtual base class for cache implementations. A cache implementation is
used by Foswiki::PageCache to store cached data (both page data and meta-data
about the cached pages).
=cut

Expand All @@ -12,11 +15,6 @@ package Foswiki::Cache;
use strict;
use warnings;

# static poor man's debugging tools
sub writeDebug {
print STDERR "Foswiki::Cache - $_[0]\n" if $Foswiki::cfg{Cache}{Debug};
}

=pod
---++ ClassMethod new( $session ) -> $object
Expand All @@ -39,11 +37,14 @@ sub new {
---++ ObjectMethod init($session)
initializes a cache object to be used for the current request. this
Initializes a cache object to be used for the current request. this
object might be _shared_ on multiple requests when Foswiki is accelerated
using mod_perl or speedy-cgi and using the Foswiki::Cache::MemoryCache
handler.
Subclasses should call up to this method at the start of overriding
implementations.
=cut

sub init {
Expand All @@ -59,7 +60,9 @@ sub init {

=pod
explicite destructor to break cyclic links
---++ ObjectMethod DESTROY()
Explicit destructor to break cyclic links.
=cut

Expand All @@ -70,7 +73,9 @@ sub DESTROY {

=pod
finish up internal structures
---++ ObjectMethod finish()
Clean up internal structures
=cut

Expand Down Expand Up @@ -113,10 +118,11 @@ sub finish {
---++ ObjectMethod genkey($string, $key) -> $key
Static function to generate a key for the current cache.
Generate a key for the current cache.
Some cache implementations don't have a namespace feature. Those which do, are
only able to serve objects from within one namespace per cache object.
Some cache implementations don't have a namespace feature. Those
which do are only able to serve objects from within one namespace
per cache object.
So by default we encode the namespace into the key here, even when this is
redundant, given that you specify the namespace for Cache::Cache
Expand All @@ -134,12 +140,12 @@ sub genKey {

=pod
---++ ObjectMetohd set($key, $object ... ) -> $boolean
---++ ObjectMethod set($key, $object ... ) -> $boolean
cache an $object under the given $key. note, that the
Cache an $object under the given $key. Note that the
object won't be flushed to disk until we called finish().
returns true if it was stored sucessfully
Returns true if it was stored sucessfully
=cut

Expand All @@ -165,7 +171,7 @@ sub set {
---++ ObjectMethod get($key) -> $object
retrieve a cached object, returns undef if it does not exist
Retrieve a cached object, returns undef if it does not exist
=cut

Expand All @@ -190,11 +196,11 @@ sub get {

=pod
---++ ObjectMethod delete($key)
---++ ObjectMethod delete($key) -> $boolean
delete an entry for a given $key
Delete an entry for a given $key
returns true if the key was found and deleted, and false otherwise
Returns true if the key was found and deleted, and false otherwise
=cut

Expand All @@ -218,7 +224,7 @@ sub delete {
---++ ObjectMethod clear()
removes all objects from the cache.
Removes all objects from the cache.
=cut

Expand Down

0 comments on commit f3eb3c0

Please sign in to comment.