view release on metacpan or  search on metacpan

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

package Declare::Args;
use strict;
use warnings;

our $VERSION = "0.009";

use Carp qw/croak/;

use Exporter::Declare qw{
    import
    gen_default_export
    default_export
};

gen_default_export 'ARGS_META' => sub {
    my ( $class, $caller ) = @_;
    my $meta = $class->new();
    $meta->{class} = $caller;
    return sub { $meta };
};

default_export arg        => sub { caller->ARGS_META->arg( @_ )   };
default_export parse_args => sub { caller->ARGS_META->parse( @_ ) };
default_export arg_info   => sub { caller->ARGS_META->info        };

sub class   { shift->{class}   }
sub args    { shift->{args}    }
sub default { shift->{default} }

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

    my $self = bless { args => {}, default => {} } => $class;
    $self->arg( $_, $args{$_} ) for keys %args;

    return $self;
}

sub valid_arg_params {
    return qr/^(alias|list|bool|default|check|transform|description)$/;
}

sub arg {
    my $self = shift;
    my ( $name, %config ) = @_;

    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;

    croak "'check' cannot be used with 'bool'"
        if $config{bool} && $config{check};

    croak "'transform' cannot be used with 'bool'"
        if $config{bool} && $config{transform};

    croak "arg properties 'list' and 'bool' are mutually exclusive"
        if $config{list} && $config{bool};

    if (exists $config{default}) {
        croak "References cannot be used in default, wrap them in a sub."
            if ref $config{default} && ref $config{default} ne 'CODE';
        $self->default->{$name} = $config{default};
    }

    if ( exists $config{check} ) {
        my $ref = ref $config{check};
        croak "'$config{check}' is not a valid value for 'check'"
            if ($ref && $ref !~ m/^(CODE|Regexp)$/)
            || (!$ref && $config{check} !~ m/^(file|dir|number)$/);
    }

    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;
        }
    }

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