File Coverage

blib/lib/Tie/Handle/TtyRec.pm

Criterion	Covered	Total	%
statement	36	37	97.3
branch	4	6	66.6
condition	5	8	62.5
subroutine	11	12	91.6
pod	0	1	0.0
total	56	64	87.5

package Tie::Handle::TtyRec;
use strict;
use warnings;
use base 'Tie::Handle';

use Symbol;
use Time::HiRes 'gettimeofday';
use Carp 'croak';

our $VERSION = '0.04';

sub new {
    my ($class, $filename, %params) = @_;
    my $symbol = Symbol::gensym;

    tie(*$symbol, __PACKAGE__, $filename, %params);

    return $symbol;
}

sub TIEHANDLE {
    my ($class, $filename, %params) = @_;

    my $mode = -p $filename    ? '+>'
             : $params{append} ? '>>'
             :                   '>';

    open(my $self, $mode, $filename)
        or croak "Unable to open $filename for writing: $!";

    $self->autoflush(1);

    bless $self, (ref $class || $class);
}

sub READ {
    croak "Cannot read from a Tie::Handle::TtyRec";
}

sub WRITE {
    my $self = shift;
    my ($buf, $length, $offset) = @_;
    $offset ||= 0;
    $length ||= length($buf) - $offset;
    syswrite $self, pack('VVV', gettimeofday, $length)
                  . substr($buf, $offset, $length);
}

sub PRINT {
    my $self = shift;
    $self->WRITE($_) for @_;
}

sub CLOSE {
    my $self = shift;
    close $self;
}

1;

__END__