view release on metacpan or  search on metacpan

lib/Cache/CacheFactory/Object.pm  view on Meta::CPAN

###############################################################################
# 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__

=pod

=head1 NAME

Cache::CacheFactory::Object - the data stored in a Cache::CacheFactory cache.

=head1 DESCRIPTION

L<Cache::CacheFactory::Object> is a subclass extending L<Cache::Object> to
allow for per-policy meta-data needed by L<Cache::CacheFactory>'s policies.

You will not normally need to use this class for anything.

If you are already using L<Cache::Object> then you'll find that
L<Cache::CacheFactory::Object> only extends behaviour, it doesn't
alter existing behaviour.

=head1 SYNOPSIS

 use Cache::CacheFactory::Object;

 my $object = Cache::CacheFactory::Object( );

 $object->set_key( $key );
 $object->set_data( $data );