view release on metacpan or  search on metacpan

lib/App/karr/Dispatch.pm  view on Meta::CPAN

# MooX::Options ever look at argv (ticket #256).
#
# App::karr::Role::CliArgs/normalize_option_argv carries the whole diagnosis and
# the condition under which this call may go again. What belongs here is only
# why the CALL is here: the rewrite has to know which token is a flag and which
# is the value of the flag in front of it, that answer comes out of the option
# table of the command being run, and this is the last point at which the whole
# argv is still in one piece.
#
# Which command that is, is decided exactly the way MooX::Cmd decides it half a
# millisecond later: the first argv token that names a command
# (MooX::Cmd::Role::_initialize_from_cmd, `first_index` across the WHOLE argv --
# see the %COMMAND_ALIASES comment in App::karr for why the table is asked and
# argv is not rewritten). Everything before that token is the root's own argv
# and is normalized against App::karr, everything after it against the command
# class. The command name itself is passed through untouched, which is what
# keeps the dashed command spellings (`get-refs`) findable in the table.
sub _normalize_option_argv {
    my $commands = App::karr->_build_command_commands( {} );

    my ( $at, $class );
    for my $i ( 0 .. $#ARGV ) {
        next unless defined $commands->{ $ARGV[$i] };
        ( $at, $class ) = ( $i, $commands->{ $ARGV[$i] } );
        last;
    }

    my @root = defined $at ? @ARGV[ 0 .. $at - 1 ]      : @ARGV;
    my @name = defined $at ? ( $ARGV[$at] )             : ();
    my @rest = defined $at ? @ARGV[ $at + 1 .. $#ARGV ] : ();

    # Both calls are class-method calls: normalize_option_argv reads the option
    # table and nothing else, so it needs no instance -- and no instance exists
    # yet, which is the point of doing this here. Every App::karr::Cmd::* class
    # composes App::karr::Role::CliArgs (t/256 pins that, because a command that
    # forgot to would silently keep the defect for its own dashed options), but
    # the guard stays: MooX::Cmd's plugin scan decides what a command class is,
    # not this file.
    @root = App::karr->normalize_option_argv( \@root );
    if ( defined $class ) {
        use_module($class);
        @rest = $class->normalize_option_argv( \@rest )
            if $class->can('normalize_option_argv');
    }

    @ARGV = ( @root, @name, @rest );
    return;
}

sub dispatch {
    my (@argv) = @_;

    # dispatch operates on the global @ARGV, exactly as bin/karr did inline:
    # the two rewrites above and MooX::Cmd::new_with_cmd all read and write it.
    # Localising it lets an embedding host call dispatch repeatedly, and lets
    # bin/karr pass its own @ARGV in unchanged.
    local @ARGV = @argv;

    # The character/octet boundary (ticket #53). Everything the OS hands in is
    # bytes; everything a command body sees is Perl characters. @ARGV comes in
    # decoded, STDOUT and STDERR encode on the way out, and no command body
    # encodes anything itself. STDIN stays raw on purpose -- every reader of it
    # decodes its own payload (#246).
    enable_std_utf8();
    decode_argv();

    # The caller's own words, kept for the suggestion line an option-parse error
    # ends on (ticket k263). Recorded HERE because both rewrites below change
    # argv and neither leaves what anyone typed: _refuse_empty_argument's
    # diagnosis reads the raw line, and _normalize_option_argv respells
    # --claimed-by as --claimed_by and folds a flag-shaped value onto its option
    # with an `=`. App::karr::Role::ExitCodes reads it back through
    # App::karr::Error, and prints no suggestion at all where nothing was
    # recorded.
    set_original_argv(@ARGV);

    # Inside the eval on purpose: the "Usage error:" marker is what
    # App::karr::Error::is_usage_error keys on, so the handler below turns this
    # into exit 2 through the same path as every other usage error.
    my $ran = eval { _refuse_empty_argument(); _normalize_option_argv(); App::karr->new_with_cmd; 1 };
    if ( !$ran ) {
        my $err = $@;

        # An embedding host's exit-signal (see EMBEDDING) is not a command that
        # died: hand it back rather than classifying it. Nothing in karr's own
        # code answers this, so under bin/karr -- where exit() really exits and
        # never reaches this eval -- it never fires.
        die $err if blessed($err) && $err->can('__karr_dispatch_exit');

        # Exit-code contract (ADR 0002): 0 success / 1 runtime failure / 2 usage
        # error. This is the central handler the ADR calls for: it catches every
        # uncaught die from a command body and turns it into a deterministic 1
        # or 2, replacing the accidental 255 an uncaught die used to leak.
        #
        # Usage-error dies carry one of these stable leading markers:
        #   "Unknown command:"          the dispatch guard in App::karr
        #   "unexpected extra argument"  surplus positionals (Role::CliArgs)
        #   "Usage:"                     a missing required positional
        #   "Usage error:"               anything a command rejects as misuse
        #                                that is not one of the shapes above --
        #                                raised via App::karr::Role::ExitCodes'
        #                                usage_error(), the generic entry point
        #                                for e.g. an out-of-range option value
        # Any new usage-error die must start with one of these; prefer
        # usage_error() over inventing a fifth marker. Everything else -- task
        # not found, board missing, a Git/sync failure, a refused destructive
        # operation -- is a runtime failure (1).
        #
        # The markers themselves live in App::karr::Error::is_usage_error,
        # because this handler is no longer their only reader: the batch runner
        # in App::karr::Role::TaskMutation asks the same question to decide
        # whether a failure belongs to one id or to the whole invocation (#61).
        #
        # Option-parse errors (unknown option, unparseable option value) never
        # reach here: MooX::Options exits 2 directly via
        # App::karr::Role::ExitCodes (and the root's _print_help), so those
        # exits bypass this eval.
        my $is_usage = is_usage_error($err);

        print STDERR $err if defined $err && length $err;
        exit( $is_usage ? 2 : 1 );