File Coverage

lib/Data/Hash/DotNotation.pm

Criterion	Covered	Total	%
statement	55	60	91.6
branch	10	14	71.4
condition	5	11	45.4
subroutine	10	10	100.0
pod	3	3	100.0
total	83	98	84.6

package Data::Hash::DotNotation;
use strict;
use warnings;

our $VERSION = '1.02';

use Moose;
use Carp;

=head1 NAME

Data::Hash::DotNotation - Convenient representation for nested Hash structures

=head1 SYNOPSYS

    use Data::Hash::DotNotation;

    my $dn = Data::Hash::DotNotation->new({
            name => 'Gurgeh',
            planet  => 'earth',
            score   => {
                contact => 10,
                scrabble => 20,
            },
        });

    print $dn->get('score.contact');

=head1 METHODS

=cut

has 'data' => (
    is      => 'rw',
    default => sub { {}; },
);

=head2 get

=cut

sub get {
    my $self = shift;
    my $name = shift or croak "No name given";
    return $self->_get($name);
}

=head2 set

=cut

sub set {
    my $self  = shift;
    my $name  = shift or croak 'No name given';
    my $value = shift;

    $self->_set($name, $value);

    return $value;
}

=head2 key_exists

=cut

sub key_exists {
    my $self = shift;
    my $name = shift;
    my $data = $self->data;

    my @parts = split(/\./, $name);
    my $node = pop @parts;

    while ($data and (my $section = shift @parts)) {
        if (ref $data->{$section} eq 'HASH') {
            $data = $data->{$section};
        } else {
            return;
        }
    }

    return exists $data->{$node};
}

sub _get {
    my $self = shift;
    my $name = shift;
    my $data = $self->data;

    my @parts = split(/\./, $name);
    my $node = pop @parts;

    while ($data and (my $section = shift @parts)) {
        if (ref $data->{$section} eq 'HASH') {
            $data = $data->{$section};
        } else {
            return;
        }
    }

    if ($data and exists $data->{$node}) {
        return $data->{$node};
    }

    return;
}

sub _set {
    my $self  = shift;
    my $name  = shift;
    my $value = shift;

    unless ($self->data) {
        $self->data({});
    }

    my @tarts = split(/\./, $name);
    my $node = pop @tarts;

    my $current_location = $self->data;
    foreach my $section (@tarts) {
        $current_location->{$section} //= {};
        $current_location = $current_location->{$section};
    }

    if (defined($value)) {
        $current_location->{$node} = $value;
    } else {
        delete $current_location->{$node};
    }

    return $self->data;
}

no Moose;
__PACKAGE__->meta->make_immutable;

=head1 DEPENDENCIES

=over 4

=item L<Moose>

=back

=head1 SOURCE CODE

L<GitHub|https://github.com/binary-com/perl-Data-Hash-DotNotation>

=head1 AUTHOR

binary.com, C<< <perl at binary.com> >>

=head1 BUGS

Please report any bugs or feature requests to
C<bug-moosex-role-registry at rt.cpan.org>, or through the web
interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Data-Hash-DotNotation>.
We will be notified, and then you'll automatically be notified of progress on
your bug as we make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Data::Hash::DotNotation

You can also look for information at:

=over 4

=item * RT: CPAN's request tracker (report bugs here)

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Data-Hash-DotNotation>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Data-Hash-DotNotation>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Data-Hash-DotNotation>

=item * Search CPAN

L<http://search.cpan.org/dist/Data-Hash-DotNotation/>

=back

=cut

1;