File Coverage

blib/lib/Role/_Multiton.pm

Criterion	Covered	Total	%
statement	30	33	90.9
branch	7	10	70.0
condition	5	7	71.4
subroutine	5	5	100.0
pod			n/a
total	47	55	85.4

package Role::_Multiton;

use strict;
use warnings;

$Role::_Multiton::VERSION = '0.2';

sub _get_multiton_lookup_hr {
    my ($self) = @_;
    my $class = ref($self) || $self || '';

    no strict 'refs';    ## no critic
    return ${ $class . '::_multitons' } ||= {};
}

sub _get_arg_key {
    my ($arg_ar) = @_;
    my $arg_key;

    if ( !defined $arg_ar ) {
        $arg_ar = [];
    }
    else {
        $arg_ar = [ map { $_ => $arg_ar->[0]{$_} } sort keys %{ $arg_ar->[0] } ] if @{$arg_ar} == 1 && ref( $arg_ar->[0] ) eq 'HASH';
    }

    for my $arg ( @{$arg_ar} ) {
        if ( !defined $arg ) {
            $arg_key .= 'undef(),';
        }
        elsif ( my $ref = ref($arg) ) {
            $arg_key .= "$ref($arg),";    # ? need to expand further or YAGNI ?
        }
        else {
            my $copy = $arg;
            $copy =~ s/'/\\'/g;
            $arg_key .= "'$copy',";
        }
    }

    if ( defined $arg_key ) {
        $arg_key =~ s/,$//;
        return "($arg_key)";
    }
    else {
        return '()';
    }
}

1;

__END__