view release on metacpan or  search on metacpan

lib/Data/ObjectDriver/Driver/Cache/Apache.pm  view on Meta::CPAN

# $Id$

package Data::ObjectDriver::Driver::Cache::Apache;
use strict;
use warnings;

use base qw( Data::ObjectDriver::Driver::BaseCache );

sub init {
    my $driver = shift;
    my %param  = @_;
    $param{cache} ||= 1; # hack
    $driver->SUPER::init(%param);
}

sub r {
    my $driver = shift;
    if ($INC{"mod_perl.pm"}) {
        return Apache->request;
    } elsif ($INC{"mod_perl2.pm"}) {
        return Apache2::RequestUtil->request;
    } else {
        die "Not running on mod_perl environment.";
    }
}

sub get_from_cache {
    my $driver = shift;
    my $r = $driver->r or return;

    $driver->start_query('APACHECACHE_GET ?', \@_);
    my $ret = $r->pnotes($_[0]);
    $driver->end_query(undef);

    return if !defined $ret;
    return $ret;
}

sub add_to_cache {
    my $driver = shift;
    my $r = $driver->r or return;

    $driver->start_query('APACHECACHE_ADD ?,?', \@_);
    my $ret = $r->pnotes($_[0], $_[1]);
    $driver->end_query(undef);

    return if !defined $ret;
    return $ret;
}

sub update_cache {
    my $driver = shift;
    my $r = $driver->r or return;

    $driver->start_query('APACHECACHE_SET ?,?', \@_);
    my $ret = $r->pnotes($_[0], $_[1]);
    $driver->end_query(undef);

    return if !defined $ret;
    return $ret;
}

sub remove_from_cache {
    my $driver = shift;
    my $r = $driver->r or return;

    $driver->start_query('APACHECACHE_DELETE ?', \@_);
    my $ret = delete $r->pnotes->{$_[0]};
    $driver->end_query(undef);

    return if !defined $ret;
    return $ret;
}

1;

__END__

=head1 NAME

Data::ObjectDriver::Driver::Cache::Apache - object driver for caching objects in Apache's request space

=head1 SYNOPSIS

    package MyObject;
    use base qw( Data::ObjectDriver::BaseObject );

    __PACKAGE__->install_properties({
        ...
        driver => Data::ObjectDriver::Driver::Cache::Apache->new(
            fallback => Data::ObjectDriver::Driver::Cache::Memcached->new(
                cache    => Cache::Memcached->new({ servers => \@MEMCACHED_SERVERS }),
                fallback => Data::ObjectDriver::Driver::DBI->new( @$DBI_INFO ),
            ),
        ),
        ...
    });

    1;

=head1 DESCRIPTION

I<Data::ObjectDriver::Driver::Cache::Apache> provides automatic caching of
retrieved objects in the per-request memory space of your Apache mod_perl
processes, when used in conjunction with your actual object driver. It can be
used to provide even faster results over memcached when requesting objects that
have already been requested during the same request by some other part of your
application, at the cost of the memory necessary to store the objects.

If your models can be used in an Apache mod_perl application as well as another
context such as a command line shell, consider replacing the Apache layer of