File Coverage

blib/lib/Hash/Merge/Extra.pm

Criterion	Covered	Total	%
statement	91	91	100.0
branch	16	16	100.0
condition			n/a
subroutine	10	10	100.0
pod			n/a
total	117	117	100.0

package Hash::Merge::Extra;

use strict;
use warnings FATAL => 'all';

use Hash::Merge qw(_merge_hashes);

our $VERSION = '0.02'; # Don't forget to change in pod below

use constant L_ADDITIVE => {
    'SCALAR' => {
        'SCALAR' => sub { defined $_[0] ? $_[0] : $_[1] },
        'ARRAY'  => sub { defined $_[0] ? $_[0] : $_[1] },
        'HASH'   => sub { defined $_[0] ? $_[0] : $_[1] },
    },
    'ARRAY' => {
        'SCALAR' => sub { $_[0] },
        'ARRAY'  => sub { [ @{$_[0]}, @{$_[1]} ] },
        'HASH'   => sub { $_[0] },
    },
    'HASH' => {
        'SCALAR' => sub { $_[0] },
        'ARRAY'  => sub { $_[0] },
        'HASH'   => sub { _merge_hashes(@_) },
    },
};

use constant R_ADDITIVE => {
    'SCALAR' => {
        'SCALAR' => sub { defined $_[1] ? $_[1] : $_[0] },
        'ARRAY'  => sub { $_[1] },
        'HASH'   => sub { $_[1] },
    },
    'ARRAY' => {
        'SCALAR' => sub { defined $_[1] ? $_[1] : $_[0] },
        'ARRAY'  => sub { [ @{$_[1]}, @{$_[0]} ] },
        'HASH'   => sub { $_[1] },
    },
    'HASH' => {
        'SCALAR' => sub { defined $_[1] ? $_[1] : $_[0] },
        'ARRAY'  => sub { $_[1] },
        'HASH'   => sub { _merge_hashes(@_) },
    },
};

use constant L_OVERRIDE => {
    'SCALAR' => {
        'SCALAR' => sub { $_[0] },
        'ARRAY'  => sub { $_[0] },
        'HASH'   => sub { $_[0] },
    },
    'ARRAY' => {
        'SCALAR' => sub { $_[0] },
        'ARRAY'  => sub { $_[0] },
        'HASH'   => sub { $_[0] },
    },
    'HASH' => {
        'SCALAR' => sub { $_[0] },
        'ARRAY'  => sub { $_[0] },
        'HASH'   => sub { _merge_hashes(@_) },
    },
};

use constant R_OVERRIDE => {
    'SCALAR' => {
        'SCALAR' => sub { $_[1] },
        'ARRAY'  => sub { $_[1] },
        'HASH'   => sub { $_[1] },
    },
    'ARRAY' => {
        'SCALAR' => sub { $_[1] },
        'ARRAY'  => sub { $_[1] },
        'HASH'   => sub { $_[1] },
    },
    'HASH' => {
        'SCALAR' => sub { $_[1] },
        'ARRAY'  => sub { $_[1] },
        'HASH'   => sub { _merge_hashes(@_) },
    },
};

use constant L_REPLACE => {
    'SCALAR' => {
        'SCALAR' => sub { $_[0] },
        'ARRAY'  => sub { $_[0] },
        'HASH'   => sub { $_[0] },
    },
    'ARRAY' => {
        'SCALAR' => sub { $_[0] },
        'ARRAY'  => sub { $_[0] },
        'HASH'   => sub { $_[0] },
    },
    'HASH' => {
        'SCALAR' => sub { $_[0] },
        'ARRAY'  => sub { $_[0] },
        'HASH'   => sub { $_[0] },
    },
};

use constant R_REPLACE => {
    'SCALAR' => {
        'SCALAR' => sub { $_[1] },
        'ARRAY'  => sub { $_[1] },
        'HASH'   => sub { $_[1] },
    },
    'ARRAY' => {
        'SCALAR' => sub { $_[1] },
        'ARRAY'  => sub { $_[1] },
        'HASH'   => sub { $_[1] },
    },
    'HASH' => {
        'SCALAR' => sub { $_[1] },
        'ARRAY'  => sub { $_[1] },
        'HASH'   => sub { $_[1] },
    },
};

my %INDEX = (
    L_ADDITIVE      => L_ADDITIVE,
    L_OVERRIDE      => L_OVERRIDE,
    L_REPLACE       => L_REPLACE,

    R_ADDITIVE      => R_ADDITIVE,
    R_OVERRIDE      => R_OVERRIDE,
    R_REPLACE       => R_REPLACE,
);

sub import {
    shift; # throw off package name

    for (@_ ? @_ : keys %INDEX) {
        unless (exists $INDEX{$_}) {
            require Carp;
            Carp::croak "Unable to register $_ (no such behavior)";
        }
        Hash::Merge::specify_behavior($INDEX{$_}, $_);
    }
}

1;

__END__