File Coverage

blib/lib/App/ansiecho.pm

Criterion	Covered	Total	%
statement	110	113	97.3
branch	33	38	86.8
condition	10	13	76.9
subroutine	21	22	95.4
pod	0	3	0.0
total	174	189	92.0

package App::ansiecho;

our $VERSION = "1.04";

use v5.14;
use warnings;

use utf8;
use Encode;
use charnames ':full';
use Data::Dumper;
{
    no warnings 'redefine';
    *Data::Dumper::qquote = sub { qq["${\(shift)}"] };
    $Data::Dumper::Useperl = 1;
}
use open IO => 'utf8', ':std';
use Pod::Usage;

use Getopt::EX::Hashed; {
    Getopt::EX::Hashed->configure(DEFAULT => [ is => 'rw' ]);
    has debug      => "      " ;
    has n          => "      " , action => sub { $_->terminate = '' };
    has join       => " j    " , action => sub { $_->separate = '' };
    has escape     => " e !  " , default => 1;
    has rgb24      => "   !  " ;
    has separate   => "   =s " , default => " ";
    has help       => " h    " ;
    has version    => " v    " ;

    has '+separate' => sub {
	my($name, $arg) = map "$_", @_;
	$_->$name = safe_backslash($arg);
    };

    has '+rgb24' => sub {
	$Term::ANSIColor::Concise::RGB24 = !!$_[1];
    };

    has '+help' => sub {
	pod2usage
	    -verbose  => 99,
	    -sections => [ qw(SYNOPSIS VERSION) ];
    };

    has '+version' => sub {
	say "Version: $VERSION";
	exit;
    };

    has terminate  => default => "\n";
    has params     => default => [];

} no Getopt::EX::Hashed;

use App::ansiecho::Util;
use Getopt::EX v1.24.1;
use Text::ANSI::Printf 2.01 qw(ansi_sprintf);

use List::Util qw(sum);

sub run {
    my $app = shift;
    $app->options(@_);
    print join($app->separate, $app->retrieve), $app->terminate;
}

sub options {
    my $app = shift;
    my @argv = decode_argv @_;
    use Getopt::EX::Long qw(GetOptionsFromArray Configure ExConfigure);
    ExConfigure BASECLASS => [ __PACKAGE__, "Getopt::EX" ];
    Configure qw(bundling no_getopt_compat pass_through);
    $app->getopt(\@argv) || pod2usage();
    $app->params(\@argv);
    $app;
}

use Term::ANSIColor::Concise qw(ansi_color ansi_code);

sub retrieve {
    my $app = shift;
    my $count = shift;
    my $in = $app->params;
    my @out;
    my @pending;
    my(@style, @effect);

    my $append = sub {
	push @out, join '', splice(@pending), @_;
    };

    while (@$in) {
	my $arg = shift @$in;

	# -S
	if ($arg =~ /^-S$/) {
	    unshift @style, [ \&ansi_code ];
	    next;
	}
	# -c, -C
	if ($arg =~ /^-([cC])(.+)?$/) {
	    my $target = $1 eq 'c' ? \@effect : \@style;
	    my($color) = defined $2 ? safe_backslash($2) : $app->retrieve(1);
	    unshift @$target, [ \&ansi_color, $color ];
	    next;
	}
	# -F
	if ($arg =~ /^-(F)(.+)?$/) {
	    my($format) = defined $2 ? safe_backslash($2) : $app->retrieve(1);
	    unshift @style, [ \&ansi_sprintf, $format ];
	    next;
	}
	# -E
	if ($arg =~ /^-E$/) {
	    @style = ();
	    next;
	}

	#
	# -s, -i, -a : ANSI sequence
	#
	if ($arg =~ /^-([sia])(.+)?$/) {
	    my $opt = $1;
	    my $text = $2 // shift(@$in) // die "Not enough argument.\n";
	    my $code = ansi_code($text);
	    if ($opt eq 's') {
		$arg = $code;
	    } else {
		if (@out == 0 or $opt eq 'i') {
		    push @pending, $code;
		} else {
		    $out[-1] .= $code;
		}
		next;
	    }
	}
	#
	# -f : format
	#
	elsif ($arg =~ /^-f(.+)?$/) {
	    my($format) = defined $1 ? safe_backslash($1) : $app->retrieve(1);
	    my $n = sum map {
		{ '%' => 0, '*' => 2, '*.*' => 3 }->{$_} // 1
	    } $format =~ /(?| %(%) | %[-+ #0]*+(\*(?:\.\*)?|.) )/xg;
	    $arg = ansi_sprintf($format, $app->retrieve($n));
	}
	#
	# normal string argument
	#
	else {
	    if ($app->escape) {
		$arg = safe_backslash($arg);
	    }
	}

	#
	# apply @effect and @style
	#
	for (splice(@effect), @style) {
	    my($func, @opts) = @$_;
	    $arg = $func->(@opts, $arg);
	}

	$append->($arg);

	if ($count) {
	    my $out = @out + !!@pending;
	    die "Unexpected behavior.\n" if $out > $count;
	    last if $out == $count;
	}
    }
    @pending and $append->();
    die "Not enough argument.\n" if $count and @out < $count;
    return @out;
}

1;

__END__