view release on metacpan or  search on metacpan

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

	}
    };

    # individual char option
    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];
	$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 => {};

} 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->@*);

    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') {
	    $convert->{$code} = '^' . pack('c',ord($code)+64);
	}
	elsif ($flag =~ /^([a-z\d])$/i) {
	    $convert->{$code} = $char->visible($flag);
	}
	else {
	    $convert->{$char->code} = $flag;
	}
    }
    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/[@c]/;
	} else {
	    qr/(?!)/;
	}
    };
    while (<>) {
	$_ = ansi_expand($_) if $app->expand;
	s{(?=(${repeat_re}?))([$replace]|(?#bug?)(?!))}{$convert->{$2}$1}g
	    if $replace ne '';
	print;
    }