[RFC PATCH v7 8/9] gitweb/lib - Cache captured output (using compute_fh)

From

Jakub Narebski <jnareb@gmail.com>

Date

Dec 22, 2010, 23:57 UTC

Message-ID

<20101222235757.7998.65738.stgit@localhost.localdomain>

In-Reply-To

<20101222234843.7998.87068.stgit@localhost.localdomain>

Signed-off-by: Jakub Narebski <jnareb@gmail.com>
---

 gitweb/lib/GitwebCache/CacheOutput.pm    |   84 ++++++++++++++++
 t/t9512-gitweb-cache-output-interface.sh |   34 ++++++
 t/t9512/test_cache_output.pl             |  162 ++++++++++++++++++++++++++++++
 3 files changed, 280 insertions(+), 0 deletions(-)
 create mode 100644 gitweb/lib/GitwebCache/CacheOutput.pm
 create mode 100755 t/t9512-gitweb-cache-output-interface.sh
 create mode 100755 t/t9512/test_cache_output.pl

diff --git a/gitweb/lib/GitwebCache/CacheOutput.pm b/gitweb/lib/GitwebCache/CacheOutput.pm
new file mode 100644
index 0000000..4a75a7f
--- /dev/null
+++ b/gitweb/lib/GitwebCache/CacheOutput.pm
@@ -0,0 +1,84 @@
+# gitweb - simple web interface to track changes in git repositories
+#
+# (C) 2010, Jakub Narebski <jnareb@gmail.com>
+# (C) 2006, John 'Warthog9' Hawley <warthog19@eaglescrag.net>
+#
+# This program is licensed under the GPLv2
+
+#
+# Capturing and caching (gitweb) output
+#
+
+# Capture output, save it in cache and print it, or retrieve it from
+# cache and print it.
+
+package GitwebCache::CacheOutput;
+
+use strict;
+use warnings;
+
+use File::Copy qw();
+use Symbol qw(qualify_to_ref);
+
+use Exporter qw(import);
+our @EXPORT      = qw(cache_output);
+our %EXPORT_TAGS = (all => [ @EXPORT ]);
+
+# cache_output($cache, $capture, $key, $action_code, [ option => value ]);
+#
+# Attempts to get $key from $cache; if successful, prints the value.
+# Otherwise, calls $action_code, capture its output using $capture,
+# and use the captured output as the new value for $key in $cache,
+# then print captured output.
+#
+# It is assumed that captured data is already converted and it is
+# in ':raw' format (and thus restored in ':raw' from cache)
+#
+# Supported options:
+# * -cache_errors => 0|1  - whether error output should be cached
+sub cache_output {
+	my ($cache, $capture, $key, $code, %opts) = @_;
+
+	my ($fh, $filename);
+	my ($capture_fh, $capture_filename);
+	eval { # this `eval` is to catch rethrown error, so we can print captured output
+		($fh, $filename) = $cache->compute_fh($key, sub {
+			($capture_fh, $capture_filename) = @_;
+
+			# this `eval` is to be able to cache error output (up till 'die')
+			eval { $capture->capture($code, $capture_fh); };
+
+			# note that $cache can catch this error itself (like e.g. CHI);
+			# use "die"-ing error handler to rethrow this exception to outside
+			die $@ if ($@ && ! $opts{'-cache_errors'});
+		});
+	};
+	my $error = $@;
+
+	# if an exception was rethrown, and not caught by caching engine (by $cache)
+	# then ->compute_fh will not set $fh nor $filename; use those used for capture
+	if (!defined $fh) {
+		$filename ||= $capture_filename;
+	}
+
+	if (defined $fh || defined $filename) {
+		# set binmode only if $fh is defined (is a filehandle)
+		# File::Copy::copy opens files given by filename in binary mode
+		binmode $fh,    ':raw' if (defined $h);
+		binmode STDOUT, ':raw';
+		File::Copy::copy($fh || $filename, \*STDOUT);
+	}
+
+	# rethrow error if captured in outer `eval` (i.e. no -cache_errors),
+	# removing temporary file (exception thrown out of cache)
+	if ($error) {
+		unlink $capture_filename
+			if (defined $capture_filename && -e $capture_filename);
+		die $error;
+	}
+	return;
+}
+
+1;
+__END__
+# end of package GitwebCache::CacheOutput
diff --git a/t/t9512-gitweb-cache-output-interface.sh b/t/t9512-gitweb-cache-output-interface.sh
new file mode 100755
index 0000000..fb9525a
--- /dev/null
+++ b/t/t9512-gitweb-cache-output-interface.sh
@@ -0,0 +1,34 @@
+#!/bin/sh
+#
+# Copyright (c) 2010 Jakub Narebski
+#
+
+test_description='gitweb cache
+
+This test checks GitwebCache::CacheOutput Perl module that is
+responsible for capturing and caching gitweb output.'
+
+# for now we are running only cache interface tests
+. ./test-lib.sh
+
+# this test is present in gitweb-lib.sh
+if ! test_have_prereq PERL; then
+	skip_all='perl not available, skipping test'
+	test_done
+fi
+
+"$PERL_PATH" -MTest::More -e 0 >/dev/null 2>&1 || {
+	skip_all='perl module Test::More unavailable, skipping test'
+	test_done
+}
+
+# ----------------------------------------------------------------------
+
+# The external test will outputs its own plan
+test_external_has_tap=1
+
+test_external \
+	'GitwebCache::CacheOutput Perl API (in gitweb/lib/)' \
+	"$PERL_PATH" "$TEST_DIRECTORY"/t9512/test_cache_output.pl
+
+test_done
diff --git a/t/t9512/test_cache_output.pl b/t/t9512/test_cache_output.pl
new file mode 100755
index 0000000..758848c
--- /dev/null
+++ b/t/t9512/test_cache_output.pl
@@ -0,0 +1,162 @@
+#!/usr/bin/perl
+use lib (split(/:/, $ENV{GITPERLLIB}));
+
+use warnings;
+use strict;
+
+use Test::More;
+
+# test source version
+use lib $ENV{GITWEBLIBDIR} || "$ENV{GIT_BUILD_DIR}/gitweb/lib";
+
+# ....................................................................
+
+# prototypes must be known at compile time, otherwise they do not work
+BEGIN { use_ok('GitwebCache::CacheOutput'); }
+
+require_ok('GitwebCache::FileCacheWithLocking');
+require_ok('GitwebCache::Capture::ToFile');
+
+note("Using lib '$INC[0]'");
+note("Testing '$INC{'GitwebCache/CacheOutput.pm'}'");
+note("Testing '$INC{'GitwebCache/FileCacheWithLocking.pm'}'");
+note("Testing '$INC{'GitwebCache/Capture/ToFile.pm'}'");
+
+
+# Test setting up $cache and $capture
+my ($cache, $capture);
+subtest 'setup' => sub {
+	$cache   = new_ok('GitwebCache::FileCacheWithLocking' => [], 'The $cache  ');
+	$capture = new_ok('GitwebCache::Capture::ToFile'      => [], 'The $capture');
+
+	done_testing();
+};
+
+# ......................................................................
+
+# Prepare for testing cache_output
+my $key = 'Key';
+my $action_output = <<'EOF';
+# This is data to be cached and shown
+EOF
+my $cached_output = <<"EOF";
+$action_output# (version recovered from cache)
+EOF
+my $call_count = 0;
+sub action {
+	$call_count++;
+	print $action_output;
+}
+
+my $die_output = <<"EOF";
+$action_output# (died)
+EOF
+sub die_action {
+	print $die_output;
+	die "die_action\n";
+}
+
+# Catch output printed by cache_output
+sub capture_output_of_cache_output {
+	my ($code, @args) = @_;
+
+	GitwebCache::Capture::ToFile->new()->capture(sub {
+		cache_output($cache, $capture, $key, $code, @args);
+	}, 'actual');
+
+	return get_actual();
+}
+
+sub get_actual {
+	open my $fh, '<', 'actual' or return;
+	local $/ = undef;
+	my $result = <$fh>;
+	close $fh;
+	return $result;
+}
+
+# use ->get_fh($key) interface
+sub cache_get_fh {
+	my ($cache, $key) = @_;
+
+	my ($fh, $filename) = $cache->get_fh($key);
+	return unless $fh;
+
+	local $/ = undef;
+	return <$fh>;
+}
+
+# use ->set_coderef_fh($key, $code_fh) to set $key to $value
+sub cache_set_fh {
+	my ($cache, $key, $value) = @_;
+
+	$cache->set_coderef_fh($key, sub { print {$_[0]} $value });
+	return $value;
+}
+
+
+# ......................................................................
+
+# clean state
+$cache->set_expires_in(-1);
+$cache->remove($key);
+my $test_data;
+
+# first time (if there is no cache) generates cache entry
+subtest '1st time (generate data)' => sub {
+	$call_count = 0;
+	$test_data = capture_output_of_cache_output(\&action);
+	is($test_data,                 $action_output, 'action() output is printed');
+	is(cache_get_fh($cache, $key), $action_output, 'action() output is saved in cache');
+	cmp_ok($call_count, '==', 1, 'action() was called to generate data');
+
+	done_testing();
+};
+
+# second time (if cache is set/valid) reads from cache
+subtest '2nd time (retreve from cache)' => sub {
+	cache_set_fh($cache, $key, $cached_output);
+	$call_count = 0;
+	$test_data = capture_output_of_cache_output(\&action);
+	is(cache_get_fh($cache, $key), $cached_output, 'correct value is prepared in cache');
+	is($test_data,                 $cached_output, 'output is printed from cache');
+	cmp_ok($call_count, '==', 0, 'action() was not called');
+
+	done_testing();
+};
+
+# caching output and error handling
+subtest 'errors (exceptions) are not cached by default' => sub {
+	$cache->remove($key);
+	ok(!defined cache_get_fh($cache, $key), 'cache is prepared correctly (no data in cache)');
+	eval {
+		$test_data = capture_output_of_cache_output(\&die_action);
+	};
+	my $error = $@;
+	$test_data = get_actual();
+	is($test_data, $die_output,             'output of an error is printed');
+	ok(!defined cache_get_fh($cache, $key), 'output is not captured and not cached');
+	like($error, qr/^die_action\n/m,        'exception made it to outside, correctly');
+
+	done_testing();
+};
+
+subtest 'errors are cached with -cache_errors => 1' => sub {
+	$cache->remove($key);
+	ok(!defined cache_get_fh($cache, $key), 'cache is prepared correctly (no data in cache)');
+	eval {
+		$test_data = capture_output_of_cache_output(\&die_action, -cache_errors => 1);
+	};
+	my $error = $@;
+	$test_data = get_actual();
+	is($test_data,                 $die_output, 'output of an error is printed');
+	is(cache_get_fh($cache, $key), $die_output, 'output is captured and cached');
+	ok(! $error, 'exception didn\'t made it to outside');
+	diag($error) if $error;
+
+	done_testing();
+};
+
+
+done_testing();
+__END__