gitweb/lib/GitwebCache/Capture/Simple.pm

   1 # gitweb - simple web interface to track changes in git repositories
   2 #
   3 # (C) 2010, Jakub Narebski <jnareb@gmail.com>
   4 #
   5 # This program is licensed under the GPLv2
   6
   7 #
   8 # Simple output capturing via redirecting STDOUT to in-memory file.
   9 #
  10
  11 # This is the same mechanism that Capture::Tiny uses, only simpler;
  12 # we don't capture STDERR at all, we don't tee, we don't support
  13 # capturing output of external commands.
  14
  15 package GitwebCache::Capture::Simple;
  16
  17 use strict;
  18 use warnings;
  19
  20 use PerlIO;
  21
  22 # Constructor
  23 sub new {
  24         my $class = shift;
  25
  26         my $self = {};
  27         $self = bless($self, $class);
  28
  29         return $self;
  30 }
  31
  32 sub capture {
  33         my ($self, $code) = @_;
  34
  35         $self->capture_start();
  36         $code->();
  37         return $self->capture_stop();
  38 }
  39
  40 # ----------------------------------------------------------------------
  41
  42 # Start capturing data (STDOUT)
  43 sub capture_start {
  44         my $self = shift;
  45
  46         # save copy of real STDOUT via duplicating it
  47         my @layers = PerlIO::get_layers(\*STDOUT);
  48         open $self->{'orig_stdout'}, ">&", \*STDOUT
  49                 or die "Couldn't dup STDOUT for capture: $!";
  50
  51         # close STDOUT, so that it isn't used anymode (to have it fd0)
  52         close STDOUT;
  53
  54         # reopen STDOUT as in-memory file
  55         $self->{'data'} = '';
  56         unless (open STDOUT, '>', \$self->{'data'}) {
  57                 open STDOUT, '>&', fileno($self->{'orig_stdout'});
  58                 die "Couldn't reopen STDOUT as in-memory file for capture: $!";
  59         }
  60         _relayer(\*STDOUT, \@layers);
  61
  62         # started capturing
  63         $self->{'capturing'} = 1;
  64 }
  65
  66 # Stop capturing data (required for die_error)
  67 sub capture_stop {
  68         my $self = shift;
  69
  70         # return if we didn't start capturing
  71         return unless delete $self->{'capturing'};
  72
  73         # close in-memory file, and restore original STDOUT
  74         my @layers = PerlIO::get_layers(\*STDOUT);
  75         close STDOUT;
  76         open STDOUT, '>&', fileno($self->{'orig_stdout'});
  77         _relayer(\*STDOUT, \@layers);
  78
  79         return $self->{'data'};
  80 }
  81
  82 # taken from Capture::Tiny by David Golden, Apache License 2.0
  83 # with debugging stripped out, and added filtering out 'scalar' layer
  84 sub _relayer {
  85         my ($fh, $layers) = @_;
  86
  87         my %seen = ( unix => 1, perlio => 1, scalar => 1 ); # filter these out
  88         my @unique = grep { !$seen{$_}++ } @$layers;
  89
  90         binmode($fh, join(":", ":raw", @unique));
  91 }
  92
  93
  94 1;
  95 __END__
  96 # end of package GitwebCache::Capture::Simple