File Coverage

blib/lib/HTTP/Server/Simple/Recorder.pm

Criterion	Covered	Total	%
statement	44	47	93.6
branch	7	14	50.0
condition	1	2	50.0
subroutine	10	11	90.9
pod	0	4	0.0
total	62	78	79.4

package HTTP::Server::Simple::Recorder;

our $VERSION = '0.03';

use warnings;
use strict;
use Carp;

use IO::File;

sub stdio_handle {
    my $self = shift;
    if (@_) {
	my $handle = $_[0];
	$self->{'_recorder_stdio_handle'} = $handle;

	my $serial = ++ $self->{'_recorder_serial'};
	my $prefix = $self->recorder_prefix;

	my $infile = "$prefix.$serial.in";
	my $outfile = "$prefix.$serial.out";

	my $in = IO::File->new("$infile", ">") or die "Couldn't open $infile: $!";
	$in->autoflush(1);
	my $out = IO::File->new("$outfile", ">") or die "Couldn't open $outfile: $!";
	$out->autoflush(1);

	$self->{'_recorder_stdin_handle'} = IO::Tee::Binmode->new($handle, $in);
	$self->{'_recorder_stdout_handle'} = IO::Tee::Binmode->new($handle, $out);
    }
    return $self->{'_recorder_stdio_handle'};
}

sub stdin_handle {
    my $self = shift;
    return $self->{'_recorder_stdin_handle'};
}

sub stdout_handle {
    my $self = shift;
    return $self->{'_recorder_stdout_handle'};
}

sub recorder_prefix { "/tmp/http-server-simple-recorder"; }

package IO::Tee::Binmode;

use base qw/IO::Tee/;

sub BINMODE {
    my $self = shift;
    my $ret = 1;
    if (@_) {
	for my $fh (@$self) { undef $ret unless binmode $fh, $_[0] }
    } else {
	for my $fh (@$self) { undef $ret unless binmode $fh }
    }
    return $ret;
}

sub READ {
    my $self = shift;
    my $bytes = $self->[0]->read(@_);
    # add the || 0 to silence warnings
    $bytes and $self->_multiplex_input(substr($_[0], $_[2] || 0, $bytes));
    $bytes;
}


1; # Magic true value required at end of module
__END__