File Coverage

blib/lib/Cache/CacheFactory/Object.pm

Criterion	Covered	Total	%
statement	28	33	84.8
branch	4	4	100.0
condition	6	7	85.7
subroutine	7	8	87.5
pod	4	4	100.0
total	49	56	87.5

###############################################################################
# Purpose : Extension of Cache::Object.pm to support policy meta-data.
# Author  : Sam Graham
# Created : 24 Jun 2008
# CVS     : $Id: Object.pm,v 1.7 2010-02-16 12:25:41 illusori Exp $
###############################################################################

package Cache::CacheFactory::Object;

use warnings;
use strict;

use base qw/Cache::Object/;

use Storable;

$Cache::CacheFactory::Object::VERSION = '1.10';

sub new_from_old
{
    my ( $class, $old_ob, $param ) = @_;
    my ( $ob );

    $ob = $class->new();
    $ob->initialize(
        $old_ob->get_key(),
        $old_ob->get_data(),
        {
            created_at    => $old_ob->get_created_at(),
            accessed_at   => $old_ob->get_accessed_at(),
            expires_at    => $old_ob->get_expires_at(),
            no_deep_clone => $param->{ no_deep_clone },
        } );
    #  TODO: this should probably be recalculated by the policies?
    $ob->set_size( $old_ob->get_size() );
}

sub initialize
{
    my ( $self, $key, $data, $param ) = @_;

    $self->set_key( $key );

    #  Produce a deep clone fo the data unless we don't need to
    #  or we're asked not to.
    $data = Storable::dclone( $data )
        if ref( $data ) and not $param->{ no_deep_clone };

    #  Set the data.
    $self->set_data( $data );
    #  TODO: weaken ref param handling here?

    #  Overrule default properties if they've been supplied.
    foreach my $property ( qw/created_at accessed_at expires_at/ )
    {
        if( exists( $param->{ $property } ) )
        {
            my ( $method );

            $method = "set_${property}";
            $self->$method( $param->{ $property } );
            delete $param->{ $property };
        }
    }
}

sub set_policy_metadata
{
    my ( $self, $policytype, $policy, $metadata ) = @_;

    $self->{ _Policy_Meta_Data } ||= {};
    $self->{ _Policy_Meta_Data }->{ $policytype } ||= {};
    $self->{ _Policy_Meta_Data }->{ $policytype }->{ $policy } = $metadata;
}

sub get_policy_metadata
{
    my ( $self, $policytype, $policy ) = @_;

    return( $self->{ _Policy_Meta_Data }->{ $policytype }->{ $policy } );
}

1;

__END__