File Coverage

blib/lib/App/bif/Pager.pm

Criterion	Covered	Total	%
statement	26	45	57.7
branch	3	18	16.6
condition	2	6	33.3
subroutine	10	11	90.9
pod	2	3	66.6
total	43	83	51.8

package App::bif::Pager;
use strict;
use warnings;
use Bif::Mo;
use Carp ();
use File::Which;
use IO::Handle;

our @CARP_NOT = (__PACKAGE__);

has auto => (
    is      => 'ro',
    default => 1,
);

has encoding => (
    is      => 'ro',
    default => ':utf8',
);

has pager => (
    is      => 'ro',
    default => \&_build_pager,
);

has fh => (
    is      => 'rw',
    default => sub { IO::Handle->new },
);

has pid => ( is => 'rw' );

has orig_fh => (
    is      => 'ro',
    default => sub { select },
);

sub _build_pager {
    my $self = shift;

    if ( exists $ENV{PAGER} ) {

        # Explicit pager defined
        my ( $pager, @options ) = split ' ', $ENV{PAGER};
        my $path = File::Which::which($pager);
        Carp::croak("pager not found: $pager") unless $path;
        return join( ' ', $path, @options );
    }

    # Otherwise take the first from our own list
    foreach my $pager (qw/pager less most w3m lv pg more/) {
        my $path = File::Which::which($pager);
        return $path if $path;
    }

    Carp::croak("no suitable pager found");
}

sub BUILD {
    my $self = shift;
    $self->open if $self->auto;
}

sub open {
    my $self = shift;
    return unless -t $self->orig_fh and !$self->fh->opened;

    my $pager = $self->pager;

    my $pid = CORE::open( $self->fh, '|-', $pager )
      or Carp::croak "Could not pipe to PAGER ('$pager'): $!\n";

    binmode( $self->fh, $self->encoding ? $self->encoding : () )
      or Carp::cluck "Could not set bindmode: $!";

    select $self->fh;
    $| = 1;

    $self->pid($pid);

    return;
}

sub close {
    my $self = shift;
    return unless $self->fh && $self->fh->opened;

    select $self->orig_fh;
    $self->fh->close;
}

sub DESTROY {
    my $self = shift;
    $self->close;
}

1;

__END__