view release on metacpan or  search on metacpan

lib/App/chot.pm  view on Meta::CPAN

package App::chot;

our $VERSION = "1.04";

use v5.14;
use warnings;

use utf8;
use Encode;
use open IO => 'utf8', ':std';
use Pod::Usage;
use List::Util qw(any first);
use App::chot::Util;
use App::chot::Optex qw(detect_optex);
use App::chot::Found;
use Text::ParseWords qw(shellwords);

use Getopt::EX::Hashed; {
    Getopt::EX::Hashed->configure(DEFAULT => [ is => 'rw' ]);
    has one     => ' 1     ' ;
    has debug   => ' d +   ' ;
    has dryrun  => ' n     ' ;
    has info    => ' i     ' ;
    has raw     => ' r     ' ;
    has help    => ' h     ' , action => sub {
	pod2usage(-verbose => 99, -sections => [qw(SYNOPSIS)])
    } ;
    has list    => ' l +   ' ;
    has deref   => ' L     ' ;
    has man     => ' m     ' ;
    has number  => ' N !   ' , default => 0 ;
    has version => ' v     ' , action => sub { say "Version: $VERSION"; exit } ;
    has pager   => ' p =s  ' ;
    has column  => ' C :i  ' ;
    has suffix  => '   =s  ' , default => [ qw( .pm ) ] ;
    has type    => ' t =s  ' , default => 'Command:Perl:Python:Ruby:Node' ;
    has py      => '       ' , action => sub { $_->type('Python') } ;
    has pl      => '       ' , action => sub { $_->type('Perl') } ;
    has rb      => '       ' , action => sub { $_->type('Ruby') } ;
    has nd      => '       ' , action => sub { $_->type('Node') } ;
    has bat_theme => '   %   ' ,
	default => { light => 'Coldark-Cold', dark => 'Coldark-Dark' } ;
    has skip    => '   =s@ ' ,
	default => [] ;
} no Getopt::EX::Hashed;

sub run {
    my $app = shift;
    @_ = map { utf8::is_utf8($_) ? $_ : decode('utf8', $_) } @_;
    local @ARGV = splice @_;

    use Getopt::EX::Long qw(GetOptions Configure ExConfigure);
    ExConfigure BASECLASS => [ __PACKAGE__, "Getopt::EX" ];
    Configure qw(bundling no_getopt_compat);
    $app->getopt || pod2usage();

    my $name = pop @ARGV;
    if (!defined $name) {
	if ($app->man) {
	    my $script = $ENV{CHOT_SCRIPT_PATH} // $0;
	    exec 'perldoc', $script;
	    die "perldoc: $!\n";
	}
	pod2usage();
    }
    my @option = splice @ARGV;
    my $pager = $app->pager || $ENV{'CHOT_PAGER'} || _default_pager($app);

    #
    # Load and instantiate all finder objects once.
    # Each finder gets the same $app, $name, and shared $found,
    # and is reused across -i, main, and -m dispatch below.
    #
    my $found = App::chot::Found->new;
    my @finders;  # [ [$type, $finder_obj], ... ]
    for my $type (split /:+/, $app->type) {
	$type = _normalize_type($type);
	my $class = __PACKAGE__ . '::' . $type;
	eval "require $class" or do { warn $@ if $app->debug; next };
	push @finders, [
	    $type,
	    $class->new(app => $app, name => $name, found => $found),
	];
    }

    # -i mode: print trace/resolution info and exit
    if ($app->info) {
	for my $pair (@finders) {
	    my($type, $h) = @$pair;
	    $h->get_info if $h->can('get_info');
	}
	return 0;
    }

    #
    # Main discovery loop: try each finder in order.
    # Results are accumulated in $found so that later finders
    # (e.g., Python) can use paths found by earlier ones (e.g., Command).
    #
    my @found;
    for my $pair (@finders) {
	my($type, $h) = @$pair;
	warn "Trying finder: $type\n" if $app->debug;
	my @paths = grep { defined } $h->get_path;
	if (@paths) {
	    warn "Found by $type: @paths\n" if $app->debug;
	    push @found, @paths;
	    $found->add($type, @paths);
	    last if $app->one;
	} else {