view release on metacpan or  search on metacpan

lib/Sub/Params.pm  view on Meta::CPAN

# © 2017-2018 GoodData Corporation

use 5.006;
use strict;
use warnings;

package Sub::Params;

our $VERSION = '1.0.0';

use parent 'Exporter';

use Hash::Util qw[];
use Ref::Util qw[ is_plain_hashref ];

our @EXPORT_OK = (
    'named_or_positional_arguments'
);

sub named_or_positional_arguments {
    my (%args) = @_;
    my $args = $args{args};
    my $names = $args{names};

    return unless $args;
    return unless @$args;
    return @$args unless @$names;

    # Use restricted hashes to detects how function was called
    my %params;
    Hash::Util::lock_keys %params, @$names;

    local $@;
    local $SIG{__DIE__};

    # single argument, hashref => can be named argument hashref
    return %params
        if @$args == 1
        and is_plain_hashref( $args->[0] )
        and eval { %params = %{ $args->[0] }; 1 }
	;

    # with even number of argument => looks like named arguments
    return %params
        if @$args % 2 == 0
        and eval { %params = @$args; 1 }
	;

    # with more arguments than names should be named arguments
    return %params
        if @$args <= @$names
        and do { @params{@$names} = @$args; 1 }
	;

    return @$args;
}

1;

__END__

=encoding utf-8

=head1 NAME

Sub::Params - Handle function arguments

=head1 SYNOPSIS

   use Sub::Params qw[ named_or_positional_arguments ];

   sub foo {
      my ($self, @args) = @_;
	  my %args = named_or_positional_arguments(