[PoC PATCHv5 21/17] gitweb/lib - Alternate ways of capturing output

[Jakub Narebski <jnareb@gmail.com>]

Besides GitwebCache::Capture::SelectFH, which uses select(FH) to
redirect 'print LIST' and 'printf FORMAT, LIST' to in-memory file to
capture output, add GitwebCache::Capture::TiedCapture which uses
tie-ing filehandle to capture output, and GitwebCache::Capture::PerlIO
which uses push_layer method from non-core PerlIO::Util module to
capture output.

Add test (which can be run standalone) for all those implementations,
checking ':utf8' and ':raw' output, and benchmark comparing them
(includes example benchmark tests).  Please note that the test for
alternate implementations is not run from t9504 test.

Signed-off-by: Jakub Narebski <jnareb@gmail.com>
---
Formerly as patch 08/17 in previous version of series, now marked PoC
("proof of concept"), and moved to the end of series.

Differences from v4:
* GitwebCache::Capture::TiedCapture has now two (sub)versions: one
  appending data from tied operations to a string (after conversion)
  via TiedCapture::String (default), other redirecting tied operations
  to save to in-memory file via TiedCapture::PerlIO (new).

  Add tests for new TiedCapture::PerlIO.

* Tie::Restore (non-core module from CPAN) is now in separate file;
  should be probably in 'inc/' and not in 'lib/'.

* Change name of field in TiedCapture::* from 'mode' to 'binmode'.

* New example results of benchmark.

* Add test checking that all those implementations work correctly for
  capturing both ':utf8' and ':raw' printed data.

 gitweb/lib/GitwebCache/Capture/PerlIO.pm      |   79 +++++++++
 gitweb/lib/GitwebCache/Capture/TiedCapture.pm |   76 +++++++++
 gitweb/lib/Tie/Restore.pm                     |   24 +++
 gitweb/lib/TiedCapture/PerlIO.pm              |   56 ++++++
 gitweb/lib/TiedCapture/String.pm              |   53 ++++++
 t/t9504/benchmark_capture_implementations.pl  |  226 +++++++++++++++++++++++++
 t/t9504/test_capture_implementations.pl       |   85 +++++++++
 7 files changed, 599 insertions(+), 0 deletions(-)
 create mode 100644 gitweb/lib/GitwebCache/Capture/PerlIO.pm
 create mode 100644 gitweb/lib/GitwebCache/Capture/TiedCapture.pm
 create mode 100644 gitweb/lib/Tie/Restore.pm
 create mode 100644 gitweb/lib/TiedCapture/PerlIO.pm
 create mode 100644 gitweb/lib/TiedCapture/String.pm
 create mode 100755 t/t9504/benchmark_capture_implementations.pl
 create mode 100755 t/t9504/test_capture_implementations.pl

diff --git a/gitweb/lib/GitwebCache/Capture/PerlIO.pm b/gitweb/lib/GitwebCache/Capture/PerlIO.pm
new file mode 100644
index 0000000..199aeed
--- /dev/null
+++ b/gitweb/lib/GitwebCache/Capture/PerlIO.pm
@@ -0,0 +1,79 @@
+# gitweb - simple web interface to track changes in git repositories
+#
+# (C) 2010, Jakub Narebski <jnareb@gmail.com>
+#
+# This program is licensed under the GPLv2
+
+#
+# Output capturing using PerlIO layers
+#
+
+# This module requires PaerlIO::Util installed.
+
+package GitwebCache::Capture::PerlIO;
+
+use PerlIO::Util;
+
+use strict;
+use warnings;
+
+use base qw(GitwebCache::Capture);
+use GitwebCache::Capture qw(:all);
+
+use Exporter qw(import);
+our @EXPORT      = @GitwebCache::Capture::EXPORT;
+our @EXPORT_OK   = @GitwebCache::Capture::EXPORT_OK;
+our %EXPORT_TAGS = %GitwebCache::Capture::EXPORT_TAGS;
+
+# Constructor
+sub new {
+	my $proto = shift;
+
+	my $class = ref($proto) || $proto;
+	my $self  = {};
+	$self = bless($self, $class);
+
+	$self->{'data'} = '';
+
+	return $self;
+}
+
+# Start capturing data (STDOUT)
+# (printed using 'print <sth>' or 'printf <sth>')
+sub start {
+	my $self = shift;
+
+	$self->{'data'}    = '';
+	*STDOUT->push_layer('scalar' => \$self->{'data'});
+
+	# push ':utf8' on top, if it was on top
+	*STDOUT->push_layer(':utf8')
+		if ((*STDOUT->get_layers())[-2] eq 'utf8');
+}
+
+# Stop capturing data (required for die_error)
+sub stop {
+	my $self = shift;
+
+	# return if we didn't start capturing
+	my @layers = *STDOUT->get_layers();
+	return unless grep { $_ eq 'scalar' } @layers;
+
+	my $was_utf8 = $layers[-1] eq 'utf8';
+	# stop saving to scalar, i.e. remove topmost 'scalar' layer,
+	# but remember that 'utf8' layer might be on top of it
+	while ((my $layer = *STDOUT->pop_layer())) {
+		pop @layers;
+		last if $layer eq 'scalar';
+	}
+	# restore ':utf8' mode, if needed
+	if ($was_utf8 && $layers[-1] ne 'utf8') {
+		*STDOUT->push_layer('utf8');
+	}
+
+	return $self->{'data'};
+}
+
+1;
+__END__
+# end of package GitwebCache::Capture::PerlIO;
diff --git a/gitweb/lib/GitwebCache/Capture/TiedCapture.pm b/gitweb/lib/GitwebCache/Capture/TiedCapture.pm
new file mode 100644
index 0000000..6bed0f8
--- /dev/null
+++ b/gitweb/lib/GitwebCache/Capture/TiedCapture.pm
@@ -0,0 +1,76 @@
+# gitweb - simple web interface to track changes in git repositories
+#
+# (C) 2010, Jakub Narebski <jnareb@gmail.com>
+#
+# This program is licensed under the GPLv2
+
+#
+# Simple output capturing by tie-ing filehandle
+#
+
+package GitwebCache::Capture::TiedCapture;
+
+use PerlIO;
+
+use strict;
+use warnings;
+
+use base qw(GitwebCache::Capture);
+use GitwebCache::Capture qw(:all);
+
+use Exporter qw(import);
+our @EXPORT      = @GitwebCache::Capture::EXPORT;
+our @EXPORT_OK   = @GitwebCache::Capture::EXPORT_OK;
+our %EXPORT_TAGS = %GitwebCache::Capture::EXPORT_TAGS;
+
+# Constructor
+sub new {
+	my $proto = shift;
+
+	my $class = ref($proto) || $proto;
+	my $self  = {};
+	$self = bless($self, $class);
+
+	$self->{'data'} = '';
+	$self->{'tied'} = undef;
+	$self->{'tie_class'} = shift || 'TiedCapture::String';
+	eval "require $self->{'tie_class'}";
+
+	return $self;
+}
+
+# Start capturing data (STDOUT)
+# (printed using 'print <sth>' or 'printf <sth>')
+sub start {
+	my $self = shift;
+
+	# savie tie
+	$self->{'tied'} = tied *STDOUT;
+
+	$self->{'data'} = '';
+	tie *STDOUT, $self->{'tie_class'}, \$self->{'data'};
+
+	# re-binmode, so that tied class would pick it up
+	binmode STDOUT,
+		(PerlIO::get_layers(*STDOUT))[-1] eq 'utf8' ? ':utf8' : ':raw';
+}
+
+# Stop capturing data (required for die_error)
+sub stop {
+	my $self = shift;
+
+	# return if we didn't start capturing
+	return unless tied(*STDOUT)->isa($self->{'tie_class'});
+
+	# restore ties, if there were any
+	untie *STDOUT;
+	if ($self->{'tied'}) {
+		tie *STDOUT, 'Tie::Restore', $self->{'tied'};
+	}
+
+	return $self->{'data'};
+}
+
+1;
+__END__
+# end of package GitwebCache::Capture::TiedCapture;
diff --git a/gitweb/lib/Tie/Restore.pm b/gitweb/lib/Tie/Restore.pm
new file mode 100644
index 0000000..687434e
--- /dev/null
+++ b/gitweb/lib/Tie/Restore.pm
@@ -0,0 +1,24 @@
+########################################################################
+# This package should probably be put in `gitweb/inc/' instead
+#
+# taken from http://search.cpan.org/~robwalker/Tie-Restore-0.11/Restore.pm
+# with POD documentation stripped out
+
+package Tie::Restore;
+# Written by Robby Walker ( webmaster@pointwriter.com )
+# for Point Writer ( http://www.pointwriter.com/ ).
+
+our $VERSION = '0.11';
+$VERSION = eval $VERSION;
+
+# $object = tied %hash;                # save
+# tie %hash, 'Tie::Restore', $object;  # restore
+
+sub TIESCALAR { $_[1] }
+sub TIEARRAY  { $_[1] }
+sub TIEHASH   { $_[1] }
+sub TIEHANDLE { $_[1] }
+
+1;
+__END__
+# end of package Tie::Restore
diff --git a/gitweb/lib/TiedCapture/PerlIO.pm b/gitweb/lib/TiedCapture/PerlIO.pm
new file mode 100644
index 0000000..4bbd724
--- /dev/null
+++ b/gitweb/lib/TiedCapture/PerlIO.pm
@@ -0,0 +1,56 @@
+########################################################################
+
+package TiedCapture::PerlIO;
+
+our $VERSION = '0.001';
+$VERSION = eval $VERSION;
+
+use strict;
+use warnings;
+
+use PerlIO;
+
+sub TIEHANDLE {
+	my ($proto, $dataref) = @_;
+	my $class = ref($proto) || $proto;
+	my $self = {};
+	$self = bless($self, $class);
+	$self->{'scalar'} = $dataref;
+	$self->{'binmode'} = ':utf8';
+
+	$self->{'scalar_fh'} = undef;
+	open $self->{'scalar_fh'}, '>', $self->{'scalar'}
+		or die "Couldn't open in-memory file for capture: $!";
+
+	return $self;
+}
+
+sub WRITE {
+	my $self = shift;
+	syswrite $self->{'scalar_fh'}, @_;
+}
+
+sub PRINT {
+	my $self = shift;
+	print { $self->{'scalar_fh'} } @_;
+}
+
+sub PRINTF {
+	my $self = shift;
+	printf { $self->{'scalar_fh'} } @_;
+}
+
+sub BINMODE {
+	my $self = shift;
+	$self->{'binmode'} = shift || ':raw';
+	binmode $self->{'scalar_fh'}, $self->{'binmode'};
+}
+
+#sub UNTIE {
+#	close $self->{'scalar_fh'};
+#	$self->{'scalar_fh'} = undef;
+#}
+
+1;
+__END__
+# end of package TiedCapture::PerlIO
diff --git a/gitweb/lib/TiedCapture/String.pm b/gitweb/lib/TiedCapture/String.pm
new file mode 100644
index 0000000..72b15a7
--- /dev/null
+++ b/gitweb/lib/TiedCapture/String.pm
@@ -0,0 +1,53 @@
+########################################################################
+
+package TiedCapture::String;
+
+our $VERSION = '0.001';
+$VERSION = eval $VERSION;
+
+use strict;
+use warnings;
+
+sub TIEHANDLE {
+	my ($proto, $dataref) = @_;
+	my $class = ref($proto) || $proto;
+	my $self = {};
+	$self = bless($self, $class);
+	$self->{'scalar'} = $dataref;
+	$self->{'binmode'} = ':utf8';
+	return $self;
+}
+
+sub append_str {
+	my ($self, $str) = @_;
+	utf8::encode($str) if ($self->{'binmode'} eq ':utf8');
+	${$self->{'scalar'}} .= $str;
+}
+
+sub WRITE {
+	my ($self, $buffer, $length, $offset) = @_;
+	$self->append_str(substr($buffer, $offset, $length));
+}
+
+sub PRINT {
+	my $self = shift;
+	$self->append_str(join('',@_));
+}
+
+sub PRINTF {
+	my $self = shift;
+	$self->append_str(sprintf(@_));
+}
+
+sub BINMODE {
+	my $self = shift;
+	$self->{'binmode'} = shift || ':raw';
+}
+
+#sub UNTIE {
+#	local $^W = 0;
+#}
+
+1;
+__END__
+# end of package TiedCapture::String
diff --git a/t/t9504/benchmark_capture_implementations.pl b/t/t9504/benchmark_capture_implementations.pl
new file mode 100755
index 0000000..588c1dc
--- /dev/null
+++ b/t/t9504/benchmark_capture_implementations.pl
@@ -0,0 +1,226 @@
+#!/usr/bin/perl
+use lib (split(/:/, $ENV{GITPERLLIB}));
+
+use warnings;
+use strict;
+
+use File::Spec;
+use File::Path;
+use Benchmark qw(:all);
+
+use PerlIO;
+
+# benchmark source version
+sub __DIR__ () {
+	File::Spec->rel2abs(join '', (File::Spec->splitpath(__FILE__))[0, 1]);
+}
+use lib __DIR__."/../../gitweb/lib";
+
+# ....................................................................
+
+# Load modules (without importing)
+#
+my @modules =
+	map { "GitwebCache::Capture::$_" }
+	qw(SelectFH TiedCapture);
+foreach my $mod (@modules) {
+	eval "require $mod";
+}
+if (eval { require PerlIO::Util; 1 }) {
+	require GitwebCache::Capture::PerlIO;
+	push @modules, 'GitwebCache::Capture::PerlIO';
+}
+
+# Set up capturing, for each module
+#
+my @captures = map { $_->new() } @modules;
+push @captures, GitwebCache::Capture::TiedCapture->new('TiedCapture::PerlIO');
+
+
+my $test_data = <<'EOF';
+Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do
+eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad
+minim veniam, quis nostrud exercitation ullamco laboris nisi ut
+aliquip ex ea commodo consequat. Duis aute irure dolor in
+reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla
+pariatur. Excepteur sint occaecat cupidatat non proident, sunt in
+culpa qui officia deserunt mollit anim id est laborum.
+
+Sed ut perspiciatis unde omnis iste natus error sit voluptatem
+accusantium doloremque laudantium, totam rem aperiam, eaque ipsa quae
+ab illo inventore veritatis et quasi architecto beatae vitae dicta
+sunt explicabo. Nemo enim ipsam voluptatem quia voluptas sit
+aspernatur aut odit aut fugit, sed quia consequuntur magni dolores eos
+qui ratione voluptatem sequi nesciunt. Neque porro quisquam est, qui
+dolorem ipsum quia dolor sit amet, consectetur, adipisci velit, sed
+quia non numquam eius modi tempora incidunt ut labore et dolore magnam
+aliquam quaerat voluptatem. Ut enim ad minima veniam, quis nostrum
+exercitationem ullam corporis suscipit laboriosam, nisi ut aliquid ex
+ea commodi consequatur? Quis autem vel eum iure reprehenderit qui in
+ea voluptate velit esse quam nihil molestiae consequatur, vel illum
+qui dolorem eum fugiat quo voluptas nulla pariatur?
+EOF
+
+my @captured_output;
+my $repeat = 100;
+sub capture_output {
+	my ($class, $mode) = @_;
+
+	$class->start();
+	binmode select(), $mode if defined($mode);
+	print $test_data for (1..$repeat);
+
+	return $class->stop();
+}
+
+my %codehash;
+for (my $i = 0; $i < @captures; $i++) {
+	my $capture = $captures[$i];
+	my $name = ref($capture);
+	$name =~ s/^.*:://;
+	$name .= " ($captures[$i]->{'tie_class'})"
+		if $captures[$i]->{'tie_class'};
+	$name =~ s/TiedCapture:://;
+
+	$codehash{$name} = sub { $captured_output[$i] = capture_output($capture) };
+}
+
+# ....................................................................
+
+my $test_other_modules = 0;
+
+if ($test_other_modules) {
+
+	if (eval { require Capture::Tiny; 1; }) {
+		$codehash{'Capture::Tiny'} = sub {
+			my ($stdout, $stderr) = Capture::Tiny::capture(sub {
+				print $test_data for (1..$repeat);
+			});
+			print STDERR $stderr if defined($stderr);
+		};
+	}
+
+	if (eval { require IO::CaptureOutput; 1; }) {
+		$codehash{'IO::CaptureOutput'} = sub {
+			my ($stdout, $stderr);
+			IO::CaptureOutput::capture(sub {
+				print $test_data for (1..$repeat);
+			}, \$stdout, \$stderr);
+			print STDERR $stderr if defined($stderr);
+		};
+		# somehow it interferes with capturing in GitwebCache::Capture::PerlIO
+		delete $codehash{'PerlIO'};
+	}
+
+	if (eval { require IO::Capture::Stdout; 1; }) {
+		$codehash{'IO::Capture'} = sub {
+			my $capture = IO::Capture::Stdout->new();
+
+			$capture->start();
+			print $test_data for (1..$repeat);
+			$capture->stop();
+
+			my $captured_output = join('', $capture->read());
+		};
+	}
+} # end if ($test_other_modules)
+
+# ....................................................................
+
+print "Capturing $repeat x ".length($test_data).
+      " = ".($repeat * length($test_data))." characters\n";
+my $count = -10; # CPU seconds
+my $result = timethese($count, \%codehash);
+cmpthese($result);
+
+#if (exists $codehash{PerlIO}) {
+#	cmpthese(-10, {
+#		'PerlIO::get_layers'  => sub { PerlIO::get_layers(*STDOUT); },
+#		'PerlIO::Util method' => sub { *STDOUT->get_layers(); },
+#	});
+#}
+
+1;
+__END__
+## EXAMPLE OUTPUT ##
+#
+## 1 x $test_data, PerlIO using *STDOUT->get_layers();
+# Benchmark: running PerlIO, SelectFH, TiedCapture for at least 10 CPU seconds...
+#      PerlIO:  9 wallclock secs (10.38 usr +  0.13 sys = 10.51 CPU) @  9676.31/s (n=101698)
+#    SelectFH: 12 wallclock secs (10.51 usr +  0.02 sys = 10.53 CPU) @ 12294.21/s (n=129458)
+# TiedCapture: 10 wallclock secs (10.24 usr +  0.06 sys = 10.30 CPU) @  9489.22/s (n=97739)
+#                Rate TiedCapture      PerlIO    SelectFH
+# TiedCapture  9489/s          --         -2%        -23%
+# PerlIO       9676/s          2%          --        -21%
+# SelectFH    12294/s         30%         27%          --
+#
+## 10 x $test_data, PerlIO using *STDOUT->get_layers();
+# Benchmark: running PerlIO, SelectFH, TiedCapture for at least 10 CPU seconds...
+#      PerlIO:  9 wallclock secs (10.47 usr +  0.07 sys = 10.54 CPU) @ 7558.35/s (n=79665)
+#    SelectFH: 11 wallclock secs (10.36 usr +  0.04 sys = 10.40 CPU) @ 8970.87/s (n=93297)
+# TiedCapture: 11 wallclock secs (10.45 usr +  0.02 sys = 10.47 CPU) @ 2602.77/s (n=27251)
+#               Rate TiedCapture      PerlIO    SelectFH
+# TiedCapture 2603/s          --        -66%        -71%
+# PerlIO      7558/s        190%          --        -16%
+# SelectFH    8971/s        245%         19%          --
+#
+## 100 x $test_data, PerlIO using *STDOUT->get_layers();
+# Benchmark: running PerlIO, SelectFH, TiedCapture for at least 50 CPU seconds...
+#      PerlIO: 67 wallclock secs (35.28 usr + 17.82 sys = 53.10 CPU) @ 832.41/s (n=44201)
+#    SelectFH: 73 wallclock secs (33.83 usr + 18.63 sys = 52.46 CPU) @ 830.06/s (n=43545)
+# TiedCapture: 71 wallclock secs (50.93 usr +  0.41 sys = 51.34 CPU) @  95.31/s (n=4893)
+#               Rate TiedCapture    SelectFH      PerlIO
+# TiedCapture 95.3/s          --        -89%        -89%
+# SelectFH     830/s        771%          --         -0%
+# PerlIO       832/s        773%          0%          --
+#
+## 100 x $test_data, PerlIO using mix of *STDOUT->get_layers() and PerlIO::get_layers(*STDOUT);
+# Capturing 100 x 1314 = 131400 characters
+# Benchmark: timing 25000 iterations of PerlIO, SelectFH, TiedCapture...
+#      PerlIO:  30 wallclock secs  (19.05 usr + 10.29 sys =  29.34 CPU) @ 852.08/s (n=25000)
+#    SelectFH:  30 wallclock secs  (18.95 usr + 10.26 sys =  29.21 CPU) @ 855.87/s (n=25000)
+# TiedCapture: 307 wallclock secs (267.37 usr +  2.95 sys = 270.32 CPU) @  92.48/s (n=25000)
+#               Rate TiedCapture      PerlIO    SelectFH
+# TiedCapture 92.5/s          --        -89%        -89%
+# PerlIO       852/s        821%          --         -0%
+# SelectFH     856/s        825%          0%          --
+#
+## 100 x $test_data (IO::CaptureOutput interferes with GitwebCache::Capture::PerlIO)
+# Capturing 100 x 1314 = 131400 characters
+# Benchmark: running IO::CaptureOutput, SelectFH, TiedCapture for at least 10 CPU seconds...
+# IO::CaptureOutput: 12 wallclock secs ( 5.12 usr +  5.63 sys = 10.75 CPU) @ 126.60/s (n=1361)
+#          SelectFH: 12 wallclock secs ( 6.93 usr +  3.45 sys = 10.38 CPU) @ 808.29/s (n=8390)
+#       TiedCapture: 11 wallclock secs (10.11 usr +  0.01 sys = 10.12 CPU) @ 103.26/s (n=1045)
+#                    Rate       TiedCapture IO::CaptureOutput          SelectFH
+# TiedCapture       103/s                --              -18%              -87%
+# IO::CaptureOutput 127/s               23%                --              -84%
+# SelectFH          808/s              683%              538%                --
+#
+## PerlIO::get_layers   == PerlIO::get_layers(*STDOUT)
+## PerlIU::Util method  == *STDOUT->get_layers()
+#                        Rate PerlIO::Util method  PerlIO::get_layers
+# PerlIO::Util method 54405/s                  --                -38%
+# PerlIO::get_layers  87672/s                 61%                  --
+
+##
+# Capturing 100 x 1314 = 131400 characters
+# Benchmark: running PerlIO, SelectFH, TiedCapture (PerlIO), TiedCapture (String)
+#   for at least 10 CPU seconds...
+#                        Rate TiedCapture (String) TiedCapture (PerlIO) SelectFH PerlIO
+# TiedCapture (String) 96.5/s                   --                 -76%     -88%   -88%
+# TiedCapture (PerlIO)  407/s                 322%                   --     -48%   -48%
+# SelectFH              787/s                 715%                  93%       --    -0%
+# PerlIO                789/s                 717%                  94%       0%     --
+#
+# comment: you can see effects of perltie overhead and repeated string concatenation here.
+
+##
+#
+# Capturing 100 x 1314 = 131400 characters
+# Benchmark: running IO::CaptureOutput, SelectFH, TiedCapture (PerlIO), TiedCapture (String)
+#   for at least 10 CPU seconds...
+#                       Rate TiedCapture (String) IO::CaptureOutput TiedCapture (PerlIO) SelectFH
+# TiedCapture (String) 109/s                   --               -4%                 -72%     -84%
+# IO::CaptureOutput    114/s                   4%                --                 -70%     -84%
+# TiedCapture (PerlIO) 384/s                 253%              237%                   --     -45%
+# SelectFH             693/s                 536%              509%                  80%       --
diff --git a/t/t9504/test_capture_implementations.pl b/t/t9504/test_capture_implementations.pl
new file mode 100755
index 0000000..86796ac
--- /dev/null
+++ b/t/t9504/test_capture_implementations.pl
@@ -0,0 +1,85 @@
+#!/usr/bin/perl
+use lib (split(/:/, $ENV{GITPERLLIB}));
+
+use warnings;
+use strict;
+
+use File::Spec;
+
+use Test::More;
+
+# test source version
+#use if defined($ENV{TEST_DIRECTORY}),
+#	lib => "$ENV{TEST_DIRECTORY}/../gitweb/lib";
+sub __DIR__ () {
+	File::Spec->rel2abs(join '', (File::Spec->splitpath(__FILE__))[0, 1]);
+}
+use lib __DIR__."/../../gitweb/lib";
+
+# ....................................................................
+
+# Load modules
+my @modules =
+	map { "GitwebCache::Capture::$_" }
+	qw(SelectFH TiedCapture);
+require_ok($_) foreach @modules;
+if (eval { require PerlIO::Util; 1 }) {
+	require_ok('GitwebCache::Capture::PerlIO');
+	unshift @modules, 'GitwebCache::Capture::PerlIO';
+}
+
+# Test setting up capture
+#
+my @captures = map { new_ok($_ => []) } @modules;
+push @captures, new_ok('GitwebCache::Capture::TiedCapture' => ['TiedCapture::PerlIO']);
+isa_ok($_, 'GitwebCache::Capture', ref($_)) foreach @captures;
+
+# Test capturing
+#
+diag('Should not print anything except test results and diagnostic');
+
+my $test_data;
+my @captured_output;
+sub capture {
+	my ($class, $mode) = @_;
+
+	$class->start();
+	binmode select(), $mode if defined($mode);
+	print $test_data;
+	return $class->stop();
+}
+sub test_captures {
+	my $mode = shift;
+
+	@captured_output = map { capture($_, $mode); } @captures;
+	if ($mode eq ':utf8') {
+		utf8::decode($_) foreach @captured_output;
+	}
+	for (my $i = 0; $i < @captures; $i++) {
+		my $name = ref($captures[$i]);
+		$name .= " ($captures[$i]->{'tie_class'})"
+			if $captures[$i]->{'tie_class'};
+		my $output = $captured_output[$i];
+		is($output, $test_data, "$name captures $mode data");
+	}
+}
+
+
+binmode STDOUT, ':utf8';
+$test_data = 'Zażółć gęsią jaźń';
+utf8::decode($test_data);
+#diag("\$test_data = $test_data (decoded)\n");
+ok(utf8::is_utf8($test_data), '$test_data is utf8  (utf8::is_utf8)');
+ok(utf8::valid($test_data),   '$test_data is valid (utf8::valid)');
+test_captures(':utf8');
+
+$test_data = '|\x{fe}\x{ff}|\x{9F}|\000|'; # invalid utf-8
+ok(!utf8::is_utf8($test_data), '$test_data is not utf8 (utf8::is_utf8)');
+ok(utf8::valid($test_data),    '$test_data is valid    (utf8::valid)');
+test_captures(':raw');
+
+done_testing();
+
+# Local Variables:
+# encoding: utf-8
+# End:
-- 
1.7.3