File Coverage

blib/lib/Pinto/Chrome/Term.pm

Criterion	Covered	Total	%
statement	71	94	75.5
branch	27	60	45.0
condition	4	7	57.1
subroutine	17	19	89.4
pod	0	9	0.0
total	119	189	62.9

# ABSTRACT: Interface for terminal-based interaction

package Pinto::Chrome::Term;

use Moose;
use MooseX::StrictConstructor;
use MooseX::Types::Moose qw(Bool ArrayRef Str);
use MooseX::MarkAsMethods ( autoclean => 1 );

use Term::ANSIColor;
use File::Which qw(which);

use Pinto::Editor;
use Pinto::Types qw(Io ANSIColorPalette);
use Pinto::Util qw(user_palette itis throw is_interactive);

#-----------------------------------------------------------------------------

our $VERSION = '0.14'; # VERSION

#-----------------------------------------------------------------------------

extends qw( Pinto::Chrome );

#-----------------------------------------------------------------------------

has color => (
    is      => 'ro',
    isa     => Bool,
    default => sub { !$ENV{PINTO_NO_COLOR} },
);

has palette => (
    is      => 'ro',
    isa     => ANSIColorPalette,
    default => sub { user_palette() },
    lazy    => 1,
);

has stdout => (
    is      => 'ro',
    isa     => Io,
    builder => '_build_stdout',
    coerce  => 1,
    lazy    => 1,
);

has stderr => (
    is      => 'ro',
    isa     => Io,
    default => sub { [ fileno(*STDERR), '>' ] },
    coerce  => 1,
    lazy    => 1,
);

has has_made_progress => (
    is      => 'rw',
    isa     => Bool,
    default => 0,
);

#-----------------------------------------------------------------------------

sub _build_stdout {
    my ($self) = @_;

    my $pager = $ENV{PINTO_PAGER} || $ENV{PAGER};
    my $stdout = [ fileno(*STDOUT), '>' ];

    return $stdout if not -t STDOUT;
    return $stdout if not $pager;

    my @pager_options = $ENV{PINTO_PAGER_OPTIONS} ?
        ( $ENV{PINTO_PAGER_OPTIONS} ) : ();

    open my $pager_fh, q<|->, $pager, @pager_options
        or throw "Failed to open pipe to pager $pager: $!";


    my $io = bless $pager_fh, 'IO::Handle';    # HACK!
    $io->autoflush(1);

    return $io;
}

#------------------------------------------------------------------------------

sub show {
    my ( $self, $msg, $opts ) = @_;

    $opts ||= {};

    $msg = $self->colorize( $msg, $opts->{color} );

    $msg .= "\n" unless $opts->{no_newline};

    print { $self->stdout } $msg or croak $!;

    return $self;
}

#-----------------------------------------------------------------------------

sub diag {
    my ( $self, $msg, $opts ) = @_;

    $opts ||= {};

    return if $self->quiet;

    $msg = $msg->() if ref $msg eq 'CODE';

    if ( itis( $msg, 'Pinto::Exception' ) ) {

        # Show full stack trace if we are debugging
        $msg = $ENV{PINTO_DEBUG} ? $msg->as_string : $msg->message;
    }

    chomp $msg;
    $msg = $self->colorize( $msg, $opts->{color} );
    $msg .= "\n" unless $opts->{no_newline};

    print { $self->stderr } $msg or croak $!;
}

#-----------------------------------------------------------------------------

sub show_progress {
    my ($self) = @_;

    return if not $self->should_render_progress;

    $self->stderr->autoflush;    # Make sure pipes are hot

    print { $self->stderr } '.' or croak $!;

    $self->has_made_progress(1);
}

#-----------------------------------------------------------------------------

sub progress_done {
    my ($self) = @_;

    return unless $self->has_made_progress;
    return unless $self->should_render_progress;

    print { $self->stderr } "\n" or croak $!;
}

#-----------------------------------------------------------------------------

sub should_render_progress {
    my ($self) = @_;

    return 0 if $self->verbose;
    return 0 if $self->quiet;
    return 0 if not is_interactive;
    return 1;
}

#-----------------------------------------------------------------------------

sub edit {
    my ( $self, $document ) = @_;

    local $ENV{VISUAL} = $self->find_editor
        or throw 'Unable to find an editor.  Please set PINTO_EDITOR';

    # If this command is reading input from a pipe or file, then
    # STDIN will not be connected to a terminal.  This causes vim
    # and emacs to behave oddly (or even segfault).  After searching
    # the internets, this seems to a portable way to reconnect STDIN
    # to the actual terminal.  I haven't actually tried it on Windows.
    # I'm not sure if/how I should be localizing STDIN here.

    my $term = ( $^O eq 'MSWin32' ) ? 'CON' : '/dev/tty';
    open( STDIN, '<', $term ) or throw $!;

    return Pinto::Editor->edit( document => $document );
}

#-----------------------------------------------------------------------------

sub colorize {
    my ( $self, $string, $color_number ) = @_;

    return ''      if not $string;
    return $string if not defined $color_number;
    return $string if not $self->color;

    my $color = $self->get_color($color_number);

    return $color . $string . Term::ANSIColor::color('reset');
}

#-----------------------------------------------------------------------------

sub get_color {
    my ( $self, $color_number ) = @_;

    return '' if not defined $color_number;

    my $color = $self->palette->[$color_number];

    throw "Invalid color number: $color_number" if not defined $color;

    return Term::ANSIColor::color($color);
}

#-----------------------------------------------------------------------------

sub find_editor {
    my ($self) = @_;

    # Try unsing environment variables first
    for my $env_var (qw(PINTO_EDITOR VISUAL EDITOR)) {
        return $ENV{$env_var} if $ENV{$env_var};
    }

    # Then try typical editor commands
    for my $cmd (qw(nano pico vi)) {
        my $found_cmd = which($cmd);
        return $found_cmd if $found_cmd;
    }

    return;
}

#-----------------------------------------------------------------------------

my %color_map = ( warning => 1, error => 2 );
while ( my ( $level, $color ) = each %color_map ) {
    around $level => sub {
        my ( $orig, $self, $msg, $opts ) = @_;
        $opts ||= {};
        $opts->{color} = $color;
        return $self->$orig( $msg, $opts );
    };
}

#-----------------------------------------------------------------------------

__PACKAGE__->meta->make_immutable;

#-----------------------------------------------------------------------------
1;

__END__

=pod

=encoding UTF-8

=for :stopwords Jeffrey Ryan Thalhammer

=head1 NAME

Pinto::Chrome::Term - Interface for terminal-based interaction

=head1 VERSION

version 0.14

=head1 AUTHOR

Jeffrey Ryan Thalhammer <[e-mail]>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2015 by Jeffrey Ryan Thalhammer.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut