File Coverage

blib/lib/IO/Divert.pm

Criterion	Covered	Total	%
statement	52	52	100.0
branch	6	8	75.0
condition			n/a
subroutine	14	14	100.0
pod	7	7	100.0
total	79	81	97.5

package IO::Divert;

use v5.14;
use warnings;
use utf8;
use Encode ();
use Carp;

our $VERSION = "0.99";

sub new {
    my $class = shift;
    my %opt = (
	BUFFER    => '',
	encoding  => 'utf-8',
	autoprint => 1,
	@_
    );
    my $encoding = $opt{encoding};
    open $opt{FH}, ">:encoding($encoding)", \$opt{BUFFER}
	or croak "open: $!";
    $opt{STDOUT} = select $opt{FH}
	or croak "select: $!";
    bless \%opt, $class;
}

sub fh {
    my $obj = shift;
    $obj->{FH};
}

sub buffer {
    my $obj = shift;
    \$obj->{BUFFER};
}

sub content {
    my $obj = shift;
    $obj->flush;
    $obj->{BUFFER};
}

sub flush {
    my $obj = shift;
    $obj->fh->flush;
    $obj;
}

sub clear {
    my $obj = shift;
    $obj->flush;
    seek $obj->fh, 0, 0;
    $obj->fh->truncate(0);
    $obj->{BUFFER} = '';
    $obj;
}

sub cancel {
    my $obj = shift;
    $obj->{autoprint} = 0;
    delete $obj->{FINAL};
    $obj;
}

sub DESTROY {
    my $obj = shift;
    select $obj->{STDOUT};
    $obj->fh->close;
    if (my $final = $obj->{FINAL}) {
	local $_ = $obj->{BUFFER};
	$final->();
	$obj->{BUFFER} = $_;
    }
    if ($obj->{autoprint}) {
	print Encode::decode($obj->{encoding}, $obj->{BUFFER});
    }
}

1;

__END__