File Coverage

blib/lib/Devel/TakeHashArgs.pm

Criterion	Covered	Total	%
statement	25	31	80.6
branch	12	14	85.7
condition	2	2	100.0
subroutine	3	4	75.0
pod	2	2	100.0
total	44	53	83.0

package Devel::TakeHashArgs;

use warnings;
use strict;

our $VERSION = '0.006';

require Exporter;
our @ISA = 'Exporter';
our @EXPORT = qw(get_args_as_hash);
our @EXPORT_OK = qw(set_self_args_as_hash);

sub set_self_args_as_hash {
    my ( $in_args, $opts, $mandatory_opts, $valid_opts ) = @_;
    my $class = shift @$in_args;

    get_args_as_hash(
        $in_args, \ my %args, $opts, $mandatory_opts, $valid_opts
    ) or return 0; # $@ will be set with an error;

    my $self = bless {}, $class;

    $self->$_( $args{ $_ } ) for keys %args;

    return $self;
}

sub get_args_as_hash {
    my ( $in_args, $out_args, $opts, $mandatory_opts, $valid_opts ) = @_;

    $valid_opts = []
        unless defined $valid_opts;

    @$in_args & 1
        and $@ = "Must have correct number of arguments"
        and return 0;

    %$out_args = @$in_args;
    $out_args->{ +lc } = delete $out_args->{ $_ } for keys %$out_args;

    %$out_args = (
        %{ $opts || {} },

        %$out_args,
    );

    for ( @$mandatory_opts ) {
        unless ( exists $out_args->{$_} ) {
            $@ = "Missing mandatory argument `$_`";
            return 0;
        }
    }

    if ( @$valid_opts ) {
        my %valid;
        @valid{ @$valid_opts } = (1) x @$valid_opts;
        for ( keys %$out_args ) {
            unless ( $valid{$_} ) {
                $@ = "Invalid argument `$_`";
                return 0;
            }
        }
    }

    1;
}

1;
__END__