File Coverage

blib/lib/Data/Remember/Hybrid.pm

Criterion	Covered	Total	%
statement	69	82	84.1
branch	14	26	53.8
condition			n/a
subroutine	11	12	91.6
pod	7	7	100.0
total	101	127	79.5

use strict;
use warnings;

package Data::Remember::Hybrid;
{
  $Data::Remember::Hybrid::VERSION = '0.140490';
}
# ABSTRACT: a brain for Data::Remember with multiple personalities

use Carp;
use Data::Remember::Util
    process_que => { -as => '_process_que' },
    init_brain  => { -as => '_init_brain' };


sub new {
    my $class = shift;
    my @table = @_;

    my $self = bless { root => undef, mounts => {} }, $class;

    while (my ($que, $config) = splice @table, 0, 2) {
        $self->register_brain($que, $config);
    }

    croak 'No root brain was registered!'
        unless defined $self->{root};

    return $self;
}


sub register_brain {
    my $self   = shift;
    my $que    = shift;
    my $config = shift;

    croak "You must give a que." unless defined $que;
    croak "You must give a configuration." unless defined $config;

    $que    = _process_que($que);
    $config = [ $config ] unless ref $config;

    if (scalar(@$que) == 0) {
        $self->{root} = _init_brain(@$config);
    }

    else {
        my $object = $self->{mounts};
        for my $que_entry (@$que) {
            croak 'You ran amuck of my secret special que name "__BRAIN". '
                . 'I cannot work with such a que name.'
                    if $que_entry eq '__BRAIN';

            if (defined $object->{$que_entry}) {
                $object = $object->{$que_entry};
            }
            else {
                $object = $object->{$que_entry} = {};
            }
        }

        $object->{__BRAIN} = _init_brain(@$config);
    }
}


sub unregister_brain {
    my $self = shift;
    my $que  = shift;

    croak "You must give a que." unless defined $que;

    $que = _process_que($que);

    if (scalar(@$que) == 0) {
        croak 'You cannot unregister the root. You may, however, replace it '
            . 'using register_brain()';
    }

    my $object = $self->{mounts};
    for my $que_entry (@$que) {
        croak 'You ran amuck of my secret special que name "__BRAIN". '
            . 'I cannot work with such a que name.'
                if $que_entry eq '__BRAIN';

        if (defined $object->{$que_entry}) {
            $object = $object->{$que_entry};
        }
        else {
            return;
        }
    }

    return scalar defined delete $object->{__BRAIN};
}


sub brain_for {
    my $self = shift;
    my $que  = shift;

    $que = Data::Remember::Class::_process_que($que);
    push @$que, 'X';

    my ($best_brain) = $self->_best_brain($que);
    return scalar $best_brain;
}


sub _best_brain {
    my $self = shift;
    my $que  = shift;

    my @sub_que  = @$que;
    my $last_que = pop @sub_que;
    my $object   = $self->{mounts};

    my $best_brain = $self->{root};
    my $best_que   = [ @$que ];

    while (my $que_entry = shift @sub_que) {
        if (defined $object->{$que_entry}) {
            $object = $object->{$que_entry};

            if (defined $object->{__BRAIN}) {
                $best_brain = $object->{__BRAIN};
                $best_que   = [ @sub_que, $last_que ];
            }
        }
        else {
            last;
        }
    }

    return ($best_brain, $best_que);
}

sub remember {
    my $self = shift;
    my $que  = shift;
    my $fact = shift;

    my ($best_brain, $best_que) = $self->_best_brain($que);
    return $best_brain->remember($best_que, $fact);
}


sub recall {
    my $self = shift;
    my $que  = shift;

    my ($best_brain, $best_que) = $self->_best_brain($que);
    return $best_brain->recall($best_que);
}


sub forget {
    my $self = shift;
    my $que  = shift;

    my ($best_brain, $best_que) = $self->_best_brain($que);
    return $best_brain->forget($best_que);
}


1

__END__