Getopt-Alt

 view release on metacpan or  search on metacpan

lib/Getopt/Alt.pm  view on Meta::CPAN

        next if $action eq 'next';
        last if $action eq 'last';
    }

    if ( $self->has_sub_command ) {
        shift @{ $self->files }
          if @{ $self->files } && $self->files->[0] eq '--';

        if ( !@{ $self->files } && @args ) {
            $self->files( [@args] );
        }

        $self->cmd( shift @{ $self->files } )
          if !$self->cmd && @{ $self->files };
    }
    if ( !$passed_args && $self->files ) {
        @ARGV = ( @{ $self->files }, @args );    ## no critic
    }

    if ( $self->has_sub_command ) {
        if (
            ref $self->sub_command eq 'HASH'
            && ( !$self->has_auto_complete
                || ( $self->cmd && $self->sub_command->{ $self->cmd } ) )
          )
        {
            if ( !$self->sub_command->{ $self->cmd } ) {
                warn 'Unknown command "' . $self->cmd . "\"!\n";
                die Getopt::Alt::Exception->new(
                    message => "Unknown command '$self->cmd'",
                    help    => 1,
                ) if !$self->help_package;
                $self->_show_help( 1,
                    'Unknown command "' . $self->cmd . "\"!\n" );
            }

            if ( ref $self->sub_command->{ $self->cmd } eq 'ARRAY' ) {

                # make a copy of the sub command
                my $sub = [ @{ $self->sub_command->{ $self->cmd } } ];

                # check the style
                my $options =
                     @$sub == 2
                  && ref $sub->[0] eq 'HASH'
                  && ref $sub->[1] eq 'ARRAY' ? shift @$sub : {};
                my $opt_args = %$options ? $sub->[0] : $sub;

                # build sub command object
                my $sub_obj = Getopt::Alt->new(
                    {
                        helper => $self->helper,
                        %{$options},         ## no critic
                        options =>
                          $self->options,    # inherit this objects options
                        default =>
                          { %{ $self->opt }, %{ $options->{default} || {} } },
                    },
                    $opt_args
                );
                local @ARGV = ();
                if ( $self->opt->auto_complete ) {
                    push @args, '--auto-complete', $self->opt->auto_complete,
                      '--';
                }
                $sub_obj->process(@args);
                $self->opt( $sub_obj->opt );
                $self->files( $sub_obj->files );
            }
        }
        elsif (
            $self->sub_command =~ /^[A-Z].*::$/
            && ( !$self->has_auto_complete
                || ( $self->cmd && $self->sub_command->{ $self->cmd } ) )
          )
        {
            # object based subcommands
            my $run = $self->sub_module_method || 'run';
        }
    }

    if ( $self->help_package ) {
        if ( $self->opt->{version} ) {
            my ($name) = $PROGRAM_NAME =~ m{^.*/(.*?)$}mxs;
            my $version = defined $main::VERSION ? $main::VERSION : 'undef';
            die Getopt::Alt::Exception->new(
                message => "$name Version = $version\n",
                help    => 1,
            );
        }
        elsif ( $self->opt->{man} ) {
            $self->_show_help(2);
        }
        elsif ( $self->opt->{help} ) {
            $self->_show_help(1);
        }
        elsif ( $self->auto_complete && $self->opt->auto_complete ) {
            $self->complete( \@errors );
        }
        elsif ( $self->sub_command && !$self->cmd ) {
            $self->_show_help(1);
        }
    }

    return $self;
}

sub complete {
    my ( $self, $errors ) = @_;

    if ( $self->sub_command && ref $self->sub_command && !$self->cmd ) {
        my $cmd = shift @ARGV;
        my @sub_command =
          grep { $cmd ? /$cmd/ : 1 } sort keys %{ $self->sub_command };
        print join ' ', @sub_command;
    }
    elsif ( $ARGV[-1] && $ARGV[-1] =~ /^-/xms ) {
        my $cmd = $ARGV[-1];
        print join ' ', grep { $cmd ? /^$cmd/ : 1 } sort $self->list_options;
    }
    else {



( run in 1.637 second using v1.01-cache-2.11-cpan-8f98c5d2c55 )