File Coverage

blib/lib/Data/Keys.pm

Criterion	Covered	Total	%
statement	38	38	100.0
branch	5	8	62.5
condition			n/a
subroutine	9	9	100.0
pod	2	2	100.0
total	54	57	94.7

package Data::Keys;

=head1 NAME

Data::Keys - get/set key+value extensible manipulations, base module for Data::Keys::E::*

=head1 SYNOPSIS

    use Date::Keys;
	my $dk = Data::Keys->new(
		'base_dir'    => '/folder/full/of/json/files',
		'extend_with' => ['Store::Dir', 'Value::InfDef'],
		'inflate'     => sub { JSON::Util->decode($_[0]) },
		'deflate'     => sub { JSON::Util->encode($_[0]) },
	);

	my %data = %{$dk->get('abcd.json')};
	$dk->set('abcd.json', \%data);

=head1 WARNING

experimental, use at your own risk :-)

=head1 DESCRIPTION

L<Data::Keys> is just a base class module that purpose is to allow loading
extensions in C<Data::Keys::E::*> namespace.

=head1 EXTENSIONS

=head2 storage

L<Data::Keys::E::Store::Dir>, L<Data::Keys::E::Store::Mem>

=cut

use warnings;
use strict;

our $VERSION = '0.04';

use Moose;
use Moose::Util;
use Carp::Clan 'confess';
use List::MoreUtils 'none';

=head1 PROPERTIES

=head2 extend_with

Array ref list of extensions to apply to the object.

=cut

has 'extend_with' => ( isa => 'ArrayRef', is => 'ro', lazy => 1, default => sub { [] });
has '_extend_arg' => ( isa => 'HashRef',  is => 'ro');

# store all attributes from extensions
around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my %args  = @_;

    my $extend_with = $args{'extend_with'};
    if ((defined $extend_with) and (not ref $extend_with)) {
        $extend_with = [ $extend_with ];
        $args{'extend_with'} = $extend_with;
    }

    # load extension modules that are not loaded already
    foreach my $extension (@{$extend_with}) {
        my $package = 'Data::Keys::E::'.$extension;
        my $package_file = $package.'.pm';
        $package_file =~ s{::}{/}g;
        if (not $INC{$package_file}) {
            eval 'use '.$package;
            confess 'failed to load '.$package
                if $@;
        }
    }

    my %e_attrs =
        map  { $_ => delete $args{$_} }
        grep { defined $args{$_} }
        map  { $_->meta->get_attribute_list }
        map  { 'Data::Keys::E::'.$_ }
        @{$extend_with}
    ;
    $args{_extend_arg} = \%e_attrs;

    my @attrs = Data::Keys->meta->get_attribute_list;
    my @unknown_keys =
        grep { my $attr = $_; none { $_ eq $attr } @attrs }
        keys %args
    ;
    confess 'unknown attributes - '.join(', ', @unknown_keys)
        if @unknown_keys;

    return $class->$orig(%args);
};

=head2 BUILD

Loads all extensions when L<Key::Values> object is created and calls
C<< $self->init(); >> which can be used to initialize an extension.

=cut

sub BUILD {
    my $self = shift;

    my $extend_with = $self->extend_with;
    if (defined $extend_with) {
        foreach my $to_extend (@{$extend_with}) {
            $to_extend = 'Data::Keys::E::'.$to_extend;
            $to_extend->meta->apply($self);
        }
    }

    # init all attributes from extensions
    my $extend_arg = $self->_extend_arg;
    foreach my $name (keys %{$extend_arg}) {
        confess 'extended attribute '.$name.' not found'
            if not $self->can($name);
        $self->$name(delete $extend_arg->{$name});
    }

    $self->init();
}

__PACKAGE__->meta->make_immutable;

=head1 METHODS

=head2 new()

Object constructor.

=head2 init()

Called after the object is C<BUILD>.

=cut

sub init {
    my $self = shift;

    confess 'role with set/get is mandatory'
        if not $self->can('set');
    confess 'role with set/get is mandatory'
        if not $self->can('get');

    return;
}

1;


__END__

=head1 AUTHOR

Jozef Kutej

=cut


=head1 AUTHOR

[e-mail], C<< <jkutej at cpan.org> >>

=head1 BUGS

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




=head1 SUPPORT

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

    perldoc Data::Keys


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

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

=item * AnnoCPAN: Annotated CPAN documentation

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

=item * CPAN Ratings

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

=item * Search CPAN

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

=back


=head1 ACKNOWLEDGEMENTS


=head1 LICENSE AND COPYRIGHT

Copyright 2010 [e-mail].

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.


=cut

1; # End of Data::Keys