view release on metacpan or  search on metacpan

lib/Getopt/Chain/Context.pm  view on Meta::CPAN

has parent => qw/is ro isa Maybe[Getopt::Chain::Context::Step]/;

has dollar1 => qw/is ro/;

sub run {
    my $self = shift;
    my $control = shift;

    my $options = {};
    my $arguments = [ $self->starting_arguments ];
    my $argument_schema = [ $self->argument_schema ];
    my ( $last );

    warn "Context::Step::run ", $self->context->path_as_string, " [@$arguments] {@$argument_schema}\n" if $DEBUG;

    eval {
        $options = Getopt::Chain::Context::consume_arguments $argument_schema, $arguments;
        unless ( $control->{terminator} ) {
            if ( @$arguments && Getopt::Chain::Context::is_option_like $arguments->[0] ) {
                die "Unknown option-like argument: $arguments->[0]", "\n";
            }
        }
    };
    die "Exception at \"", join( '/', $self->path ), "\" with arguments [ @$arguments ]: $@" if $@;

    while (my ($key, $value) = each %$options) {
        $self->option( $key => $value );
        $self->context->option( $key => $value ); # TODO Better way to do this...
    }

    $self->_remaining_arguments( $arguments );
    if ( $control->{terminator} ) {
        $self->context->_parsing_arguments( [] );
        $last = 1;
    }
    else {
        $self->context->_parsing_arguments( [ @$arguments ] );
        $last = @$arguments ? 0 : 1; # Same as $ctx->last, really
    }
    
    unless ( $last || $control->{always_run} ) {
        warn "Context::Step::run ", $self->context->path_as_string, " SKIP\n" if DEBUG;
        return;
    }

    {
        # on 'A *'

        # A b -x c (Although this is an error condition)
        # A b -x c      $1 = ''     [ b -x c ]
        # A/b -x c      $1 = 'b'    [ -x c ] # Error, -x wasn't parsed!
        # A/b/c         $1 = 'b c'  [ ]

        # A b c d
        # A b c d       $1 = ''         [ b c d ]
        # A/b c d       $1 = 'b'        [ c d ]
        # A/b/c d       $1 = 'b c'      [ d ]
        # A/b/c/d       $1 = 'b c d'    [ ]

        my @arguments;
        push @arguments, grep { length } split m/\s+/, $self->dollar1 if defined $self->dollar1;
        push @arguments, @$arguments;
        my $run = $self->_run;
        $run->( $self->context, @arguments ) if $run;
    }

    return 1;
}

1;