File Coverage

blib/lib/IO/Pager/Buffered.pm

Criterion	Covered	Total	%
statement	15	39	38.4
branch	0	16	0.0
condition	0	14	0.0
subroutine	5	11	45.4
pod	3	3	100.0
total	23	83	27.7

package IO::Pager::Buffered;
our $VERSION = 1.04; #Untouched since 1.03

use strict;
use base qw( IO::Pager );
use SelectSaver;


sub new(;$) {  # [FH], procedural
  my($class, $tied_fh);

  eval { ($class, $tied_fh) = &IO::Pager::_init };
  #We're not on a TTY so...
  if( defined($class) && $class eq '0' or $@ =~ '!TTY' ){
      #...leave filehandle alone if procedural
      return $_[1] if defined($_[2]) && $_[2] eq 'procedural';

      #...fall back to IO::Handle for transparent OO programming
      eval "require IO::Handle" or die $@;
      return IO::Handle->new_from_fd(fileno($_[1]), 'w');
  }
  $!=$@, return 0 if $@ =~ 'pipe';

  tie *$tied_fh, $class, $tied_fh or return 0;
}

#Punt to base, preserving FH ($_[0]) for pass by reference to gensym
sub open(;$) { # [FH]
#  IO::Pager::open($_[0], 'IO::Pager::Buffered');
  &new('IO::Pager::Buffered', $_[0], 'procedural');
}


# Overload IO::Pager methods

sub PRINT {
  my ($self, @args) = @_;
  $self->{buffer} .= join($,||'', @args);
}


sub CLOSE {
  my ($self) = @_;
  # Print buffer and close using IO::Pager's methods
  $self->SUPER::PRINT($self->{buffer}) if
      exists($self->{buffer}) && length($self->{buffer});
  $self->{buffer}='';
  $self->SUPER::CLOSE();
}

{ no warnings 'once'; *DESTROY = \&CLOSE; }

sub TELL {
  # Return the size of the buffer
  my ($self) = @_;
  use bytes;
  return exists($self->{buffer}) ? length($self->{buffer}) : 0;
}


sub flush(;*) {
  my ($self) = @_;
  if( exists $self->{buffer} ){
    my $saver = SelectSaver->new($self->{real_fh});
    local $|=1;
    ($_, $self->{buffer}) = ( $self->{buffer}, '');
    $self->SUPER::PRINT($_);
  }
}


1;

__END__