Add GitwebCache::Capture::ToFile package, which captures output by
redirecting STDOUT to given file (specified by filename, or given opened
filehandle), earlier saving original STDOUT to restore it when finished
capturing.
GitwebCache::Capture::ToFile preserves PerlIO layers, both those set
before started capturing output, and those set during capture.
No care was taken to handle the following special cases (prior to
starting capture): closed STDOUT, STDOUT reopened to scalar reference,
tied STDOUT. You shouldn't modify STDOUT during capture.
Includes separate tests for capturing output in
t9510/test_capture_interface.pl which is run as external test from
t9510-gitweb-capture-interface.sh. It tests capturing of utf8 data
printed in :utf8 mode, and of binary data (containing invalid utf8) in
:raw mode.
This patch was based on "gitweb: add output buffering and associated
functions" patch by John 'Warthog9' Hawley (J.H.) in "Gitweb caching v7"
series, and on code of Capture::Tiny by David Golden (Apache License 2.0).
Based-on-work-by: John 'Warthog9' Hawley <warthog9@kernel.org>
Signed-off-by: Jakub Narebski <jnareb@gmail.com>
---
gitweb/lib/GitwebCache/Capture/ToFile.pm | 109 +++++++++++++++++++++++++
t/t9510-gitweb-capture-interface.sh | 34 ++++++++
t/t9510/test_capture_interface.pl | 132 ++++++++++++++++++++++++++++++
3 files changed, 275 insertions(+), 0 deletions(-)
create mode 100644 gitweb/lib/GitwebCache/Capture/ToFile.pm
create mode 100755 t/t9510-gitweb-capture-interface.sh
create mode 100755 t/t9510/test_capture_interface.pl
diff --git a/gitweb/lib/GitwebCache/Capture/ToFile.pm b/gitweb/lib/GitwebCache/Capture/ToFile.pm
new file mode 100644
index 0000000..d2dbf0f
--- /dev/null
+++ b/gitweb/lib/GitwebCache/Capture/ToFile.pm
@@ -0,0 +1,109 @@
+# 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 via redirecting STDOUT to given file.
+#
+
+# This is the same mechanism that Capture::Tiny uses, only simpler;
+# we don't capture STDERR at all, we don't tee, we capture to
+# explicitely provided file (or filehandle).
+
+package GitwebCache::Capture::ToFile;
+
+use strict;
+use warnings;
+
+use PerlIO;
+use Symbol qw(qualify_to_ref);
+
+# Constructor
+sub new {
+ my $class = shift;
+
+ my $self = {};
+ $self = bless($self, $class);
+
+ return $self;
+}
+
+sub capture {
+ my $self = shift;
+ my $code = shift;
+
+ $self->capture_start(@_); # pass rest of params
+ eval { $code->(); 1; };
+ my $exit_code = $?; # save this for later
+ my $error = $@; # save this for later
+
+ my $got_out = $self->capture_stop();
+ $? = $exit_code;
+ die $error if $error;
+
+ return $got_out;
+}
+
+# ----------------------------------------------------------------------
+
+# Start capturing data (STDOUT)
+sub capture_start {
+ my $self = shift;
+ my $to = shift;
+
+ # save copy of real STDOUT via duplicating it
+ my @layers = PerlIO::get_layers(\*STDOUT);
+ open $self->{'orig_stdout'}, ">&", \*STDOUT
+ or die "Couldn't dup STDOUT for capture: $!";
+
+ # close STDOUT, so that it isn't used anymode (to have it fd0)
+ close STDOUT;
+
+ $self->{'to'} = $to;
+ my $fileno = fileno(qualify_to_ref($to));
+ if (defined $fileno) {
+ # if $to is filehandle, redirect
+ open STDOUT, '>&', $fileno;
+ } elsif (! ref($to)) {
+ # if $to is name of file, open it
+ open STDOUT, '>', $to;
+ }
+ _relayer(\*STDOUT, \@layers);
+
+ # started capturing
+ $self->{'capturing'} = 1;
+}
+
+# Stop capturing data (required for die_error)
+sub capture_stop {
+ my $self = shift;
+
+ # return if we didn't start capturing
+ return unless delete $self->{'capturing'};
+
+ # close capture file, and restore original STDOUT
+ my @layers = PerlIO::get_layers(\*STDOUT);
+ close STDOUT;
+ open STDOUT, '>&', fileno($self->{'orig_stdout'});
+ _relayer(\*STDOUT, \@layers);
+
+ return exists $self->{'to'} ? $self->{'to'} : $self->{'data'};
+}
+
+# taken from Capture::Tiny by David Golden, Apache License 2.0
+# with debugging stripped out
+sub _relayer {
+ my ($fh, $layers) = @_;
+
+ my %seen = ( unix => 1, perlio => 1); # filter these out
+ my @unique = grep { !$seen{$_}++ } @$layers;
+
+ binmode($fh, join(":", ":raw", @unique));
+}
+
+
+1;
+__END__
+# end of package GitwebCache::Capture::ToFile
diff --git a/t/t9510-gitweb-capture-interface.sh b/t/t9510-gitweb-capture-interface.sh
new file mode 100755
index 0000000..9151454
--- /dev/null
+++ b/t/t9510-gitweb-capture-interface.sh
@@ -0,0 +1,34 @@
+#!/bin/sh
+#
+# Copyright (c) 2010 Jakub Narebski
+#
+
+test_description='gitweb capturing interface
+
+This test checks capturing interface used for capturing gitweb output
+in gitweb caching (GitwebCache::Capture* modules).'
+
+# 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::Capture* Perl API (in gitweb/lib/)' \
+ "$PERL_PATH" "$TEST_DIRECTORY"/t9510/test_capture_interface.pl
+
+test_done
diff --git a/t/t9510/test_capture_interface.pl b/t/t9510/test_capture_interface.pl
new file mode 100755
index 0000000..6d90497
--- /dev/null
+++ b/t/t9510/test_capture_interface.pl
@@ -0,0 +1,132 @@
+#!/usr/bin/perl
+use lib (split(/:/, $ENV{GITPERLLIB}));
+
+use warnings;
+use strict;
+use utf8;
+
+use Test::More;
+
+# test source version
+use lib $ENV{GITWEBLIBDIR} || "$ENV{GIT_BUILD_DIR}/gitweb/lib";
+
+# ....................................................................
+
+use_ok('GitwebCache::Capture::ToFile');
+note("Using lib '$INC[0]'");
+note("Testing '$INC{'GitwebCache/Capture/ToFile.pm'}'");
+
+# Test setting up capture
+#
+my $capture = new_ok('GitwebCache::Capture::ToFile' => [], 'The $capture');
+
+
+# Test capturing to file (given by filename) and to filehandle
+#
+sub capture_block (&;$) {
+ $capture->capture(shift, shift || 'actual');
+
+ open my $fh, '<', 'actual' or return;
+ local $/ = undef;
+ my $result = <$fh>;
+ close $fh;
+ return $result;
+}
+
+diag('Should not print anything except test results and diagnostic');
+my $test_data = 'Capture this';
+my $captured = capture_block {
+ print $test_data;
+};
+is($captured, $test_data, 'capture simple data: filename');
+
+open my $fh, '>', 'actual';
+$captured = capture_block(sub {
+ print $test_data;
+}, $fh);
+close $fh;
+is($captured, $test_data, 'capture simple data: filehandle');
+
+
+# Test capturing :utf8 and :raw data
+#
+binmode STDOUT, ':utf8';
+$test_data = <<'EOF';
+Zażółć gęsią jaźń
+EOF
+utf8::decode($test_data);
+$captured = capture_block {
+ binmode STDOUT, ':utf8';
+
+ print $test_data;
+};
+utf8::decode($captured);
+is($captured, $test_data, 'capture utf8 data');
+
+$test_data = '|\x{fe}\x{ff}|\x{9F}|\000|'; # invalid utf-8
+$captured = capture_block {
+ binmode STDOUT, ':raw';
+
+ print $test_data;
+};
+is($captured, $test_data, 'capture raw data');
+
+
+# Test nested capturing, useful for future GitwebCache::CacheOutput tests
+#
+sub read_file {
+ my $filename = shift;
+
+ open my $fh, '<', $filename or return;
+ local $/ = undef;
+ my $result = <$fh>;
+ close $fh;
+
+ return $result;
+}
+
+my $outer_capture = GitwebCache::Capture::ToFile->new();
+$captured = $outer_capture->capture(sub {
+ print "pre|";
+ my $captured = $capture->capture(sub {
+ print "INNER";
+ }, 'inner_actual');
+ print "|post";
+}, 'outer_actual');
+
+my $inner = read_file('inner_actual');
+my $outer = read_file('outer_actual');
+
+is($inner, "INNER", 'nested capture: inner');
+is($outer, "pre||post", 'nested capture: outer');
+
+
+# Testing capture when code dies
+#
+$captured = $outer_capture->capture(sub {
+ print "pre|";
+ eval {
+ my $captured = $capture->capture(sub {
+ print "INNER:pre|";
+ die "die from inner\n";
+ print "INNER:post|"
+ }, 'inner_actual');
+ };
+ print "@=$@" if $@;
+ print "|post";
+}, 'outer_actual');
+
+my $inner = read_file('inner_actual');
+my $outer = read_file('outer_actual');
+
+is($inner, "INNER:pre|",
+ 'nested capture with die: inner output captured up to die');
+is($outer, "pre|@=die from inner\n|post",
+ 'nested capture with die: outer caught rethrown exception from inner');
+
+
+done_testing();
+
+# Local Variables:
+# coding: utf-8
+# End:
--
To unsubscribe from this list: send the line "unsubscribe git" in
the body of a message to majordomo@vger.kernel.org
More majordomo info at http://vger.kernel.org/majordomo-info.html
