Data::Remember::Hybrid - a brain for Data::Remember with multiple personalities

  use Data::Remember Hybrid =>
      [ ]                   => [ 'Memory' ],
      'config'              => [ YAML => file => 'config.yml' ],
      [ data => 'persist' ] => [ DBM  => file => 'state.db'   ],
      [ data => 'temp'    ] => [ 'Memory' ],
      ;

  my $config_opt = recall [ config => 'SomeOption' ];

  remember [ data => persist => 'something' ] => 'what?';
  remember [ data => temp    => 'forgetful' ] => 'huh?';

  remember anything_else => 'blah';

use strict;
use warnings;

package Data::Remember::Hybrid;

use Carp;

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    = Data::Remember::_process_que($que);
    $config = [ $config ] unless ref $config;

    if (scalar(@$que) == 0) {
        $self->{root} = Data::Remember::_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} = Data::Remember::_init_brain(@$config);
    }
}

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

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

    $que = Data::Remember::_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::_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