view release on metacpan or  search on metacpan

lib/App/ClusterSSH/Getopt.pm  view on Meta::CPAN

package App::ClusterSSH::Getopt;

use strict;
use warnings;

use version;
our $VERSION = version->new('0.01');

use Carp;
use Try::Tiny;
use Pod::Usage;
use Getopt::Long qw(:config no_ignore_case bundling no_auto_abbrev);
use FindBin qw($Script);

use base qw/ App::ClusterSSH::Base /;

sub new {
    my ( $class, %args ) = @_;

    # basic setup that is over-rideable by each script as needs may be
    # different depending on the command used
    my %setup = (
        usage => [
            '-h|--help', '[options] [[user@]<server>[:port]|<tag>] [...] ',
        ],
    );

    my $self = $class->SUPER::new( %setup, %args );

    # options common to all connection types
    $self->{command_options} = {};
    $self->add_common_options;

    return $self;
}

sub add_option {
    my ( $self, %args ) = @_;
    my $spec = $args{spec};
    if ( !$spec ) {
        croak(
            App::ClusterSSH::Exception::Getopt->throw(
                error => 'No "spec" passed to add_option',
            ),
        );
    }
    my ( $option, $arg ) = $spec =~ m/^(.*?)(?:[\+=:](.*))?$/;
    if ($arg) {
        my $arg_open  = '<';
        my $arg_close = '>';
        if ( $args{arg_optional} ) {
            $arg_open  = '[';
            $arg_close = ']';
        }
        my $arg_type
            = defined $args{arg_desc}
            ? "${arg_open}$args{arg_desc}${arg_close}"
            : undef;
        $arg =~ s/\+/[[...] || <INTEGER>]/g;
        if ( $arg eq 'i' ) {
            $arg
                = defined $arg_type
                ? $arg_type
                : $arg_open . $self->loc('INTEGER') . $arg_close;
        }
        if ( $arg eq 's' ) {
            $arg
                = defined $arg_type
                ? "'$arg_type'"
                : "'" . $arg_open . $self->loc('STRING') . $arg_close . "'";
        }
    }
    my ( $desc, $long, $short, $accessor );
    foreach my $item ( split /\|/, $option ) {
        $desc .= ', ' if ($desc);

        # assumption - long options are 2 or more chars
        if ( length($item) == 1 ) {
            $desc .= "-$item";
            $short = "-$item";
        }
        else {
            $desc .= "--$item";
            $long = "--$item";
            if ( !$accessor ) {
                $accessor = $item;
            }
        }
        $desc  .= " $arg" if ($arg);
        $short .= " $arg" if ( $short && $arg );
        $long  .= " $arg" if ( $long && $arg );
    }
    $args{option_desc}  = $desc;
    $args{option_short} = $short;
    $args{option_long}  = $long;
    $args{accessor}     = $accessor if ( !defined $args{no_accessor} );

    $self->{command_options}->{$spec} = \%args;
    return $self;
}

# For options common to everything