File Coverage

blib/lib/Term/Table/Util.pm

Criterion	Covered	Total	%
statement	38	41	92.6
branch	9	18	50.0
condition	2	9	22.2
subroutine	11	11	100.0
pod	0	1	0.0
total	60	80	75.0

package Term::Table::Util;
use strict;
use warnings;

use List::Util qw/max/;
use Config qw/%Config/;

our $VERSION = '0.028';

use base 'Exporter';
our @EXPORT_OK = qw/term_size USE_GCS USE_TERM_READKEY USE_TERM_SIZE_ANY uni_length/;

sub DEFAULT_SIZE() { 80 }

my @IO;
my @TIO;
BEGIN {
    for my $fh (\*STDOUT, \*STDERR, \*STDIN) {
        open(my $io, '>&', $fh) or next;
        push @IO => $io;
        push @TIO => $io if -t $io;
    }
}

sub try(&) {
    my $code = shift;
    local ($@, $?, $!);
    my $ok = eval { $code->(); 1 };
    my $err = $@;
    return ($ok, $err);
}

my ($tsa) = try { require Term::Size::Any; Term::Size::Any->import('chars') };
my ($trk) = try { require Term::ReadKey };
$trk &&= Term::ReadKey->can('GetTerminalSize');

if ($tsa) {
    *USE_TERM_READKEY  = sub() { 0 };
    *USE_TERM_SIZE_ANY = sub() { 1 };
    *_term_size        = sub {
        my $size = max map { chars($_) || DEFAULT_SIZE } @IO;

        if (!$size || $size < DEFAULT_SIZE) {
            return $ENV{COLUMNS} if $ENV{COLUMNS} && $ENV{COLUMNS} > DEFAULT_SIZE;
            return DEFAULT_SIZE;
        }

        return $size;
    };
}
elsif ($trk && @TIO) {
    *USE_TERM_READKEY  = sub() { 1 };
    *USE_TERM_SIZE_ANY = sub() { 0 };
    *_term_size        = sub {
        my @totals;
        try {
            my @warnings;
            {
                local $SIG{__WARN__} = sub { push @warnings => @_ };
                for my $io (@TIO) {
                    my ($total) = Term::ReadKey::GetTerminalSize($io);
                    push @totals => $total;
                }
            }
            @warnings = grep { $_ !~ m/Unable to get Terminal Size/ } @warnings;
            warn @warnings if @warnings;
        };
        my $total = @totals ? max(@totals) : 0;

        if (!$total || $total < DEFAULT_SIZE) {
            return $ENV{COLUMNS} if $ENV{COLUMNS} && $ENV{COLUMNS} > DEFAULT_SIZE;
            return DEFAULT_SIZE;
        }

        return $total;
    };
}
else {
    *USE_TERM_READKEY  = sub() { 0 };
    *USE_TERM_SIZE_ANY = sub() { 0 };
    *term_size         = sub {
        return $ENV{TABLE_TERM_SIZE} if $ENV{TABLE_TERM_SIZE};
        return $ENV{COLUMNS} if $ENV{COLUMNS} && $ENV{COLUMNS} > DEFAULT_SIZE;
        return DEFAULT_SIZE;
    };
}

if (USE_TERM_READKEY() || USE_TERM_SIZE_ANY()) {
    if (index($Config{sig_name}, 'WINCH') >= 0) {
        my $changed = 0;
        my $polled = -1;
        $SIG{WINCH} = sub { $changed++ };

        my $size;
        *term_size = sub {
            return $ENV{TABLE_TERM_SIZE} if $ENV{TABLE_TERM_SIZE};

            unless ($changed == $polled) {
                $polled = $changed;
                $size = _term_size();
            }

            return $size;
        }
    }
    else {
        *term_size = sub {
            return $ENV{TABLE_TERM_SIZE} if $ENV{TABLE_TERM_SIZE};
            _term_size();
        };
    }
}

my ($gcs, $err) = try { require Unicode::GCString };

if ($gcs) {
    *USE_GCS    = sub() { 1 };
    *uni_length = sub   { Unicode::GCString->new($_[0])->columns };
}
else {
    *USE_GCS    = sub() { 0 };
    *uni_length = sub   { length($_[0]) };
}

1;

__END__