File Coverage

blib/lib/Class/Data/ConfigHash.pm

Criterion	Covered	Total	%
statement	35	38	92.1
branch	9	12	75.0
condition	8	11	72.7
subroutine	6	6	100.0
pod	2	2	100.0
total	60	69	86.9

# $Id: /mirror/coderepos/lang/perl/Class-Data-ConfigHash/trunk/lib/Class/Data/ConfigHash.pm 69719 2008-08-27T02:20:26.319462Z daisuke  $

package Class::Data::ConfigHash;
use strict;
use warnings;
use base qw(Class::Data::Inheritable);
our $VERSION = '0.00002';

__PACKAGE__->mk_classdata(_config => {});

sub config {
    my $self = shift;
    my $config_sub = $self->can('_config');
    my $config = $self->$config_sub() || {};
    if (@_) {
        my $newconfig = { %{@_ > 1 ? {@_} : ($_[0] || {})} };
        $self->_config(
            $self->merge_config_hashes( $config, $newconfig )
        );
    } else {
        # this is a bit of a kludge, required to make
        # __PACKAGE__->config->{foo} = 'bar';
        # work in a subclass. Calling the Class::Data::Inheritable setter
        # will create a new _config method in the current class if it's
        # currently inherited from the superclass. So, the can() call will
        # return a different subref in that case and that means we know to
        # copy and reset the value stored in the class data.

        $self->_config( $config );

        if ((my $config_sub_now = $self->can('_config')) ne $config_sub) {

            $config = $self->merge_config_hashes( $config, {} );
            $self->$config_sub_now( $config );
        }
    }
    return $config;
}

sub merge_config_hashes
{
    my ($self, $lefthash, $righthash) = @_;
    return __merge_hashes($lefthash, $righthash);
}

sub __merge_hashes
{
    # XXX - If Catalyst is in effect, we might just as well use
    # Catalyst::Utils::merge_hashes, I suppose.
    my ( $lefthash, $righthash ) = @_;

    if ( !defined $righthash ) {
        return $lefthash;
    }

    if ( !defined $lefthash ) {
        return $righthash;
    }

    my %merged = %{$lefthash};
    for my $key ( keys %{$righthash} ) {
        my $right_ref = ( ref $righthash->{$key} || '' ) eq 'HASH';
        my $left_ref =
          ( ( exists $lefthash->{$key} && ref $lefthash->{$key} ) || '' ) eq
          'HASH';
        if ( $right_ref and $left_ref ) {
            $merged{$key} =
              __merge_hashes( $lefthash->{$key}, $righthash->{$key} );
        }
        else {
            $merged{$key} = $righthash->{$key};
        }
    }

    return \%merged;
}

1;

__END__