File Coverage

blib/lib/Hash/Override.pm

Criterion	Covered	Total	%
statement	46	50	92.0
branch	21	26	80.7
condition	30	39	76.9
subroutine	13	17	76.4
pod	0	12	0.0
total	110	144	76.3

#
# This file is part of Hash-Override
#
# This software is copyright (c) 2012 by Stefan Petrea.
#
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
#
use strict;
use warnings;
package Hash::Override;
use feature ':5.10';
use Carp qw/confess/;
# ABSTRACT: Merges nested data structures. Useful if you need to merge default config files with user-defined settings.


#alias merge as merge_hash_override for exporting
*merge_hash_override = \&merge;

use Exporter 'import';
our @EXPORT = qw/merge_hash_override/;

# Prototypes and meaning for methods:
# the functions merge_* take as parameters hashrefs and a common key
# the functions ARRAY_merge_* take as parameters arrayrefs and an index

sub merge_SCALAR_SCALAR {
  my ($A,$B,$k) = @_;

  $A->{$k} = $B->{$k}
    if exists $A->{$k} &&
       defined $B->{$k};
};
sub merge_SCALAR_HASH   {
  my ($A,$B,$k) = @_;
};
sub merge_SCALAR_ARRAY  {
  my ($A,$B,$k) = @_;
};
sub merge_HASH_SCALAR   {
  my ($A,$B,$k) = @_;
};
sub merge_HASH_HASH     {
  my ($A,$B,$k) = @_;

  merge($A->{$k},$B->{$k});
};
sub merge_HASH_ARRAY    {
  my ($A,$B,$k) = @_;
};
sub merge_ARRAY_SCALAR  {
  my ($A,$B,$k) = @_;
};
sub merge_ARRAY_HASH    {
  my ($A,$B,$k) = @_;
};


sub ARRAY_merge_SCALAR_SCALAR {
  my ($A,$B,$k) = @_;

  $A->[$_] = $B->[$_];
};

sub ARRAY_merge_HASH_HASH     {
  my ($A,$B,$k) = @_;
  merge($A->[$k],$B->[$k]);
};


sub merge_ARRAY_ARRAY   {
  my ($A,$B,$k) = @_;

   for(0..-1+@{$B->{$k}}) {
     my $rA = ref($A->{$k}->[$_]);
     my $rB = ref($B->{$k}->[$_]);

     ARRAY_merge_SCALAR_SCALAR($A->{$k},$B->{$k},$_) if $rA eq ''      && $rB eq ''     ;
     ARRAY_merge_HASH_HASH(    $A->{$k},$B->{$k},$_) if $rA eq 'HASH'  && $rB eq 'HASH' ;
   };
};


sub merge {
  my ($A,$B) = @_;
  confess 'both arguments to merge($,$) need to be hashrefs'
  unless
    ref $A eq 'HASH' &&
    ref $B eq 'HASH'   ;

  for my $key_B (keys %$B) {
    my $rA = ref($A->{$key_B});
    my $rB = ref($B->{$key_B});
    merge_SCALAR_SCALAR($A,$B,$key_B)  if  $rA eq ''      && $rB eq ''      ;
    merge_SCALAR_HASH(  $A,$B,$key_B)  if  $rA eq ''      && $rB eq 'HASH'  ;
    merge_SCALAR_ARRAY( $A,$B,$key_B)  if  $rA eq ''      && $rB eq 'ARRAY' ;
    merge_HASH_SCALAR(  $A,$B,$key_B)  if  $rA eq 'HASH'  && $rB eq ''      ;
    merge_HASH_HASH(    $A,$B,$key_B)  if  $rA eq 'HASH'  && $rB eq 'HASH'  ;
    merge_HASH_ARRAY(   $A,$B,$key_B)  if  $rA eq 'HASH'  && $rB eq 'ARRAY' ;
    merge_ARRAY_SCALAR( $A,$B,$key_B)  if  $rA eq 'ARRAY' && $rB eq ''      ;
    merge_ARRAY_HASH(   $A,$B,$key_B)  if  $rA eq 'ARRAY' && $rB eq 'HASH'  ;
    merge_ARRAY_ARRAY(  $A,$B,$key_B)  if  $rA eq 'ARRAY' && $rB eq 'ARRAY' ;
  };
};



1;
__END__