File Coverage

blib/lib/Memoize/Saves.pm

Criterion	Covered	Total	%
statement	29	58	50.0
branch	9	30	30.0
condition	4	11	36.3
subroutine	6	6	100.0
pod			n/a
total	48	105	45.7

use strict; use warnings;

package Memoize::Saves;
our $VERSION = '0.700';

our $DEBUG;

sub TIEHASH
{
    my ($package, %args) = @_;
    my $cache = $args{HASH} || {};

    # Convert the CACHE to a referenced hash for quick lookup
    #
    if( $args{CACHE} )
    {
        my %hash;
        $args{CACHE} = [ $args{CACHE} ] unless ref $args{CACHE} eq "ARRAY";
        foreach my $value ( @{$args{CACHE}} )
        {
            $hash{$value} = 1;
        }
        $args{CACHE} = \%hash;
    }

    # Convert the DUMP list to a referenced hash for quick lookup
    #
    if( $args{DUMP} )
    {
        my %hash;
        $args{DUMP} = [ $args{DUMP} ] unless ref $args{DUMP} eq "ARRAY";
        foreach my $value (  @{$args{DUMP}} )
        {
            $hash{$value} = 1;
        }
        $args{DUMP} = \%hash;
    }

    if ($args{TIE})
    {
        my ($module, @opts) = @{$args{TIE}};
        my $modulefile = $module . '.pm';
        $modulefile =~ s{::}{/}g;
        eval { require $modulefile };
        if ($@) {
            die "Memoize::Saves: Couldn't load hash tie module `$module': $@; aborting";
        }
        my $rc = (tie %$cache => $module, @opts);
        unless ($rc)         {
            die "Memoize::Saves: Couldn't tie hash to `$module': $@; aborting";
        }
    }

    $args{C} = $cache;
    bless \%args => $package;
}

sub EXISTS
{
    my $self = shift;
    my $key  = shift;

    if( exists $self->{C}->{$key} )
    {
        return 1;
    }

    return 0;
}


sub FETCH
{
    my $self = shift;
    my $key  = shift;

    return $self->{C}->{$key};
}

sub STORE
{
    my $self  = shift;
    my $key   = shift;
    my $value = shift;

    # If CACHE defined and this is not in our list don't save it
    #
    if(( defined $self->{CACHE} )&&
       ( ! defined $self->{CACHE}->{$value} ))
    {
        print "$value not in CACHE list.\n" if $DEBUG;
        return;
    }

    # If DUMP is defined and this is in our list don't save it
    #
    if(( defined $self->{DUMP} )&&
       ( defined $self->{DUMP}->{$value} ))
    {
        print "$value in DUMP list.\n" if $DEBUG;
        return;
    }

    # If REGEX is defined we will store it only if its true
    #
    if(( defined $self->{REGEX} )&&
       ( $value !~ /$self->{REGEX}/ ))
    {
        print "$value did not match regex.\n" if $DEBUG;
        return;
    }

    # If we get this far we should save the value
    #
    print "Saving $key:$value\n" if $DEBUG;
    $self->{C}->{$key} = $value;
}

1;

__END__