File Coverage

blib/lib/Data/Remember/Class.pm

Criterion	Covered	Total	%
statement	87	111	78.3
branch	21	36	58.3
condition	8	11	72.7
subroutine	16	18	88.8
pod	9	9	100.0
total	141	185	76.2

package Data::Remember::Class;
{
  $Data::Remember::Class::VERSION = '0.140490';
}
use strict;
use warnings;

# ABSTRACT: remember complex information without giving yourself a headache, now with POOP!

use Carp;
use Scalar::Util qw( reftype );
use Class::Load ();
use Data::Remember::Util
    process_que => { -as => '_process_que' },
    init_brain  => { -as => '_init_brain' };


sub new {
    my $class   = shift;
    my $brain   = shift || 'Memory';

    my $caller = caller;

    my $gray_matter = _init_brain($brain, @_);

    return bless { brain => $gray_matter }, $class;
}


sub remember {
    my ($self, $que, $fact) = @_;

    my $clean_que = _process_que($que);;

    unless (defined $clean_que) {
        carp "Undefined que element found in call to remember().";
        return;
    }

    $self->{brain}->remember($clean_que, $fact);

    return;
}


sub remember_these {
    my ($self, $que, $fact) = @_;

    my $clean_que = _process_que($que);;

    unless (defined $clean_que) {
        carp "Undefined que element found in call to remember_these().";
        return;
    }

    my $brain = $self->{brain};

    my $fact_list = $brain->recall($clean_que);

    if (defined reftype $fact_list and reftype $fact_list eq 'ARRAY') {
        push @$fact_list, $fact;
    }

    else {
        $brain->remember($clean_que, [ $fact ]);
    }

    return;
}


sub recall {
    my ($self, $que) = @_;

    my $clean_que = _process_que($que);

    unless (defined $clean_que) {
        carp "Undefined que element used in call to recall().";
        return;
    }

    return scalar $self->{brain}->recall($clean_que);
}


sub recall_each {
    my ($self, $que) = @_;
    my $brain = $self->{brain};

    my $clean_que = _process_que($que);

    unless (defined $clean_que) {
        carp "Undefined que element used in call to recall_each().";
        return;
    }

    my $value = $brain->recall($clean_que);

    my $value_ref_type = reftype($value);
    $value_ref_type = '' unless defined $value_ref_type;

    if ($value_ref_type eq 'HASH') {
        my @keys = keys %$value;
        return sub {
            return unless @keys;
            my $k = shift @keys;
            return ($k, $value->{$k});
        };
    }

    elsif ($value_ref_type eq 'ARRAY') {
        my @indexes = 0 .. $#$value;
        return sub {
            return unless @indexes;
            my $i = shift @indexes;
            return ($i, $value->[$i]);
        };
    }

    else {
        my @values = ($value);
        return sub {
            return unless @values;
            my $v = shift @values;
            return (undef, $v);
        };
    }
}


sub recall_and_update {
    my ($self, $code, $que) = @_;

    my $clean_que = _process_que($que);

    unless (defined $clean_que) {
        carp "Undefined que element used in call to recall_and_update().";
        return;
    }

    my $brain = $self->{brain};

    # Recall and modify $_
    local $_ = $brain->recall($clean_que);
    my $result = $code->();

    # Store that value back
    $brain->remember($clean_que, $_);

    # Return the result
    return $result;
}


sub forget {
    my ($self, $que) = @_;

    my $clean_que = _process_que($que);

    unless (defined $clean_que) {
        carp "Undefined que element used in call to forget().";
        return;
    }

    $self->{brain}->forget($clean_que);

    return;
}


sub forget_when {
    my ($self, $code, $que) = @_;

    my $clean_que = _process_que($que);

    unless (defined $clean_que) {
        carp "Undefined que element used in call to forget_when().";
        return;
    }

    my $brain = $self->{brain};
    my $fact = $brain->recall($clean_que);

    if (ref $fact and reftype $fact eq 'HASH') {
        for my $key (keys %$fact) {
            my $value = $fact->{ $key };
            local $_ = $value;
            delete $fact->{ $key } if $code->($key, $value);
        }
    }

    elsif (ref $fact and reftype $fact eq 'ARRAY') {
        my $index = 0;
        my @new_fact
            = grep { my $value = $_; not $code->($index++, $value) } @$fact;
        $brain->remember($clean_que, \@new_fact);
    }

    else {
        local $_ = $fact;
        $brain->forget($clean_que) if $code->(undef, $fact);
    }

    return;
}


sub brain {
    my $self = shift;
    return $self->{brain};
}


1;

__END__