view release on metacpan or  search on metacpan

lib/Declare/CLI.pm  view on Meta::CPAN

    return sub { $meta };
};

default_export arg => sub {
    my ( $meta, @params ) = _parse_params(@_);
    $meta->add_arg(@params);
};

default_export opt => sub {
    my ( $meta, @params ) = _parse_params(@_);
    $meta->add_opt(@params);
};

default_export describe_opt => sub {
    my ( $meta, @params ) = _parse_params(@_);
    $meta->describe( 'opt' => @params );
};

default_export describe_arg => sub {
    my ( $meta, @params ) = _parse_params(@_);
    $meta->describe( 'arg' => @params );
};

default_export usage => sub {
    my ( $meta, @params ) = _parse_params(@_);
    $meta->usage(@params);
};

for my $name (qw/ preparse parse process run handle /) {
    default_export "${name}_cli" => sub {
        my $consumer = shift;
        my $meta     = $consumer->CLI_META;
        return $meta->$name( $consumer, @_ );
    };
}

sub _parse_params {
    my ( $first, @params ) = @_;

    my $ref  = ref $first;
    my $type = blessed $first;

    return ( $first->CLI_META, @params )
        if ( $type || !$ref ) && eval { $first->can('CLI_META') };

    my $meta = eval { caller(2)->CLI_META };
    croak "Could not find meta data object: $@"
        unless $meta;

    return ( $meta, @_ );
}

sub class     { shift->{class} }
sub args      { shift->{args} }
sub opts      { shift->{opts} }
sub _defaults { shift->{defaults} }

sub new {
    my $class  = shift;
    my %params = @_;
    my $self   = bless {args => {}, opts => {}, defaults => {}} => $class;

    $self->add_arg( $_ => $params{args}->{$_} ) for keys %{$params{args} || {}};

    $self->add_arg( $_ => $params{opts}->{$_} ) for keys %{$params{opts} || {}};

    return $self;
}

sub describe {
    my $self = shift;
    my ( $type, $name, $desc ) = @_;

    my $meth = $type . 's';
    croak "No such $type '$name'"
        unless $self->$meth->{$name};

    $self->$meth->{$name}->{description} = $desc if $desc;

    return $self->$meth->{$name}->{description};
}

sub valid_arg_params {
    return qr/^(alias|description|handler)$/;
}

sub add_arg {
    my $self = shift;
    my ( $name, @params ) = @_;
    my %config = @params > 1 ? @params : ( handler => $params[0] );

    croak "arg '$name' already defined"
        if $self->args->{$name};

    for my $prop ( keys %config ) {
        next if $prop =~ $self->valid_arg_params;
        croak "invalid arg property: '$prop'";
    }

    $config{name} = $name;
    $config{description} ||= "No Description.";

    croak "You must provide a handler"
        unless $config{handler};

    if ( exists $config{alias} ) {
        my $aliases =
            ref $config{alias}
            ? $config{alias}
            : [$config{alias}];

        $config{_alias} = {map { $_ => 1 } @$aliases};

        for my $alias (@$aliases) {
            croak "Cannot use alias '$alias', name is already taken by another arg."
                if $self->args->{$alias};

            $self->args->{$alias} = \%config;
        }
    }