view release on metacpan or  search on metacpan

lib/App/cat/v.pm  view on Meta::CPAN

    has [ keys %control ] => ':s', action => sub {
	my($name, $c) = ("$_[0]", $_[1]);
	if ($c =~ s/^\+//) {
	    $_->repeat .= ",$name";
	}
	$c = '1' if $c eq '';
	if (length($c) > 1 and my $u = charnames::string_vianame($c)) {
	    $c = $u;
	}
	$_->flags->{$name} = $c;
    };

    ### --tabstop, --tabstyle
    has [ qw(+tabstop +tabstyle) ] => sub {
	my($name, $val) = map "$_", @_;
	if ($val eq '') {
	    list_tabstyle();
	    exit;
	}
	Text::ANSI::Tabs->configure($name => $val);
    };

    ### --tabhead, --tabspace
    has [ qw(+tabhead +tabspace) ] => sub {
	my($name, $c) = map "$_", @_;
	$c = charnames::string_vianame($c) || die "$c: invalid name\n"
	    if length($c) > 1;
	Text::ANSI::Tabs->configure($name => $c);
    };

    has '+visible' => sub {
	my $param = $_[1];
	if ($param !~ /^\w+=/) {
	    $param = "all=$param";
	}
	$param =~ s{ \ball\b }{ join('=', keys $_->flags->%*) }xe;
	push @{$_->visible}, $param;
    };

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

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

    # internal use

    has flags    => default => { pairmap { $a => $b->default } %control };
    has convert  => default => {};
    has colorize => default => sub { sub { $_[0] } } ;

} no Getopt::EX::Hashed;

sub run {
    my $app = shift;
    local @ARGV = splice @_;
    $app->options->setup->doit;
    return 0;
}

sub options {
    my $app = shift;
    for (@ARGV) {
	$_ = decode 'utf8', $_ unless utf8::is_utf8($_);
    }
    use Getopt::EX::Long qw(:DEFAULT ExConfigure Configure);
    ExConfigure BASECLASS => [ __PACKAGE__, 'Getopt::EX' ];
    Configure qw(bundling);
    $app->getopt || pod2usage();

    Getopt::EX::LabeledParam
	->new(HASH => $app->flags, NEWLABEL => 0, DEFAULT => 1)
	->load_params($app->visible->@*);

    if (my $color = $app->color) {
	$app->colorize = sub { ansi_color($color, @_) };
    }

    return $app;
}

sub setup {
    my $app = shift;
    my $convert = $app->convert;
    my $flags = $app->flags;
    for my $name (keys $flags->%*) {
	my $flag = $flags->{$name} or next;
	my $char = $control{$name};
	my $code = $char->code;
	if ($flag eq 'c') {
	    if ($code =~ /[\x00-\x1f]/) {
		$convert->{$code} = '^' . pack('c',ord($code)+64);
	    }
	}
	elsif ($flag =~ /^([a-z\d])$/i) {
	    $convert->{$code} = $char->visible($flag);
	}
	else {
	    $convert->{$char->code} = $flag;
	}
    }
    $convert->{"\\"} = "\\\\" if $app->escape_backslash;
    return $app;
}

sub doit {
    my $app = shift;
    my $convert = $app->convert;
    my $replace = join '', sort keys $convert->%*;
    my $repeat_re = do {
	if (my @c = map { $code{$_} } $app->repeat =~ /\w+/g) {
	    local $" = "";
	    qr/[\Q@c\E]/;
	} else {
	    qr/(*F)/;
	}