git/list[1] front-page[2] threads[3] people[4] search[5] about
 

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

From
Jakub Narebski <jnareb@gmail.com>
Date
Oct 6, 2010, 22:02 UTC
Message-ID
<1286402526-13143-22-git-send-email-jnareb@gmail.com>
In-Reply-To
<1286402526-13143-1-git-send-email-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
Previous: Jakub NarebskiNext: Jakub Narebski
Message 39 of 41 in “[PATCHv5 00/17] gitweb: Simple file based output caching”
  1. Jakub NarebskiOct 6, 2010
  2. 01/17 t/test-lib.sh: Export also GIT_BUILD_DIR in test_externalJakub Narebski, Oct 6, 2010
  3. 02/17 gitweb: Prepare for splitting gitwebJakub Narebski, Oct 6, 2010
  4. 03/17 gitweb/lib - Very simple file based cacheJakub Narebski, Oct 6, 2010
  5. Thomas AdamOct 6, 2010
  6. Ævar Arnfjörð BjarmasonOct 6, 2010
  7. Thomas AdamOct 6, 2010
  8. Ævar Arnfjörð BjarmasonOct 6, 2010
  9. Jakub NarebskiOct 6, 2010
  10. Thomas AdamOct 6, 2010
  11. Jakub NarebskiOct 6, 2010
  12. Ævar Arnfjörð BjarmasonOct 6, 2010
  13. Jakub NarebskiOct 6, 2010
  14. 04/17 gitweb/lib - Stat-based cache expirationJakub Narebski, Oct 6, 2010
  15. 05/17 gitweb/lib - Regenerate entry if the cache file has size of 0Jakub Narebski, Oct 6, 2010
  16. 06/17 gitweb/lib - Simple select(FH) based output captureJakub Narebski, Oct 6, 2010
  17. Thomas AdamOct 6, 2010
  18. Jakub NarebskiOct 6, 2010
  19. Ævar Arnfjörð BjarmasonOct 6, 2010
  20. Jakub NarebskiOct 6, 2010
  21. 07/17 gitweb/lib - Cache captured output (using get/set)Jakub Narebski, Oct 6, 2010
  22. 08/17 gitweb: Add optional output cachingJakub Narebski, Oct 6, 2010
  23. Ævar Arnfjörð BjarmasonOct 6, 2010
  24. Jakub NarebskiOct 6, 2010
  25. Ævar Arnfjörð BjarmasonOct 6, 2010
  26. 09/17 gitweb/lib - Adaptive cache expiration timeJakub Narebski, Oct 6, 2010
  27. 10/21 gitweb/lib - Use CHI compatibile (compute method) caching interfaceJakub Narebski, Oct 6, 2010
  28. 11/17 gitweb/lib - Use locking to avoid 'cache miss stampede' problemJakub Narebski, Oct 6, 2010
  29. 12/17 gitweb/lib - No need for File::Temp when lockingJakub Narebski, Oct 6, 2010
  30. 13/17 gitweb/lib - Serve stale data when waiting for filling cacheJakub Narebski, Oct 6, 2010
  31. 14/17 gitweb/lib - Regenerate (refresh) cache in backgroundJakub Narebski, Oct 6, 2010
  32. 15/17 gitweb: Introduce %actions_info, gathering information about actionsJakub Narebski, Oct 6, 2010
  33. 16/17 gitweb: Show appropriate "Generating..." page when regenerating cacheJakub Narebski, Oct 6, 2010
  34. 17/17 gitweb: Add startup delay to activity indicator for cacheJakub Narebski, Oct 6, 2010
  35. 18/17 gitweb/lib - Add clear() and size() methods to caching interfaceJakub Narebski, Oct 6, 2010
  36. Thomas AdamOct 6, 2010
  37. 19/17 gitweb: Add beginnings of cache administration pageJakub Narebski, Oct 6, 2010
  38. 20/17 gitweb/lib - Benchmarking GitwebCache::SimpleFileCache (in t/9603/)Jakub Narebski, Oct 6, 2010
  39. 21/17 gitweb/lib - Alternate ways of capturing outputJakub Narebski, Oct 6, 2010
  40. [RFD] Possible improvements for output caching in gitwebJakub Narebski, Oct 10, 2010
  41. J.H.Oct 24, 2010

Read the whole thread, see it on lore, or plain text.

$ cat FOOTERMessages come from the public archive at lore.kernel.org/git, fetched every hour. The front page is chosen and written each morning by an AI editor and can be wrong; the threads themselves are the record. About and API. For agents: an MCP server at https://gitlist.dev/mcp, and any thread, story or person page as Markdown by adding .md to its URL (or sending Accept: text/markdown). Details in /llms.txt.