view release on metacpan or  search on metacpan

lib/Class/DBI/ObjectCache.pm  view on Meta::CPAN

package Class::DBI::ObjectCache;

use strict;
use warnings;
use Cache::Cache qw( $EXPIRES_NOW $EXPIRES_NEVER );
use Cache::FileCache;
use CLASS;

our $VERSION = 0.03;
our %CACHE_OBJ = ();

=head1 NAME

Class::DBI::ObjectCache - Object cache used by Class::DBI::Cacheable

=head1 SYNOPSIS

    package YourClass::Name;
    use base "Class::DBI::ObjectCache";

    sub get {
        my $self = shift;
        if ($self->can('getCache')) {
            my $obj = $self->getCache(@_);
            return $obj if (defined($obj));
        }
        # Do your magic to construct your object
    }

    sub set {
        my $self = shift;
        $self->setCache();
    }

=head1 DESCRIPTION

This method is a generic base-class used for storing and retrieving objects
to and from a L<Cache::Cache> framework.  This is extended by L<Class::DBI::Cacheable>
to provide transparent L<Class::DBI> caching support, though it can be used
for other types of objects as well.

=head1 Method Reference

=cut

=head2 CLASS->getCacheKey( [$data] )

This method composes a unique key to represent this cache with.  This
is used when storing the object in the cache, and for later retrieving
it.  

=cut

sub getCacheKey {
    my $class = shift;
    my $data = undef;
    if (ref($class)) {
        $data = $class;
        $class = ref($class);
    } else {
        $data = shift;
    }

    my @index_fields = ();
    # Attempt to pull the indexable fields from the class' index method
    if ($class->can('CACHE_INDEX')) {
        @index_fields = $class->CACHE_INDEX();
        @index_fields = @{$index_fields[0]} if (ref($index_fields[0]) eq 'ARRAY');
    }
    
    # Since that didn't work, check to see if this object is a Class::DBI
    # object, and retrieve the primary key columns from there.
    elsif ($class->isa('Class::DBI')) {
        @index_fields = sort $class->primary_columns;
        if (ref($data) eq 'ARRAY') {
            my @data_ary = @{$data};
            $data = {};
            foreach ($class->primary_columns) {
                $data->{$_} = shift @data_ary;
            }
        }
    }
    
    # None of that worked.  This seems to be a generic object that hasn't been
    # tuned for this framework.  Assume all the keys are primary keys, and index
    # based on that.
    else {
        @index_fields = sort keys %{$data};
    }

    # Derive the key values to use as the index, and compose a unique string
    # representing this object's state.
    my @key_values = ();
    foreach (@index_fields) {
        return undef unless (exists $data->{$_});
        push @key_values, $data->{$_};
    }
    my $key_str = join(':', @key_values);