view release on metacpan or  search on metacpan

lib/Attribute/Cached.pm  view on Meta::CPAN

    my $sub = encache($pkg, $name, $code, %config);
    my $subname = "${pkg}::${name}";
    warn "Installing into $subname" if DEBUG;
    no strict 'refs';
    no warnings 'redefine';
    *{$subname} = $sub;
}

sub encache {
    my ($pkg, $name, $code, %config) = @_;
    return unless my $ct 
        = $config{time} || $pkg->can('getCacheTime');

    warn "code is $name, $code" if DEBUG;

    my $getCache      = $config{cache}     || $pkg->can('getCache');
    my $getCacheKey   = $config{key}       
                     || $pkg->can('getCacheKey') 
                     || \&getCacheKeyDefault;
    my $transform     = $config{transform} || $pkg->can('cacheTransform');

    my $sub = sub {
        # give the anonymous sub a name
        # (alternatively, use Sub::Named, as suggested by Ash)
        local *__ANON__ = "Cached($name)";
        my $cache = literalOrCall($getCache, @_);
        my $key   = $pkg->$getCacheKey( $name, @_ );

        my $result = $cache->get( $key );
        if ($result) {
            warn "Cache($name) hit for $key => $result" if DEBUG;
        } else {
            warn "Cache($name) miss for $key" if DEBUG;
            $result = $code->(@_);
            # we could have been passed a subroutine!
            my $cachetime = literalOrCall($ct, $pkg, $name, @_);
            warn "Cache($name) Setting $key => $result ($cachetime)" if DEBUG;
            $cache->set( $key, $result, $cachetime );
        }
        return $result unless $transform;
        return $transform->($result, @_);
    };
    return $sub;
}

sub getCacheKeyDefault {
    return join ';' => @_;
}
sub literalOrCall {
    my $what = shift;
    return $what unless ref $what eq 'CODE';
    return $what->(@_);
}

1;

=head1 PERFORMANCE

Automatically wrapping the caching logic requires a slightly generic approach
which may not be optimal.  The bundled C<attr_bench.pl> program tries to
quantify this.  In a sample run of 1,000,000 iterations, it can be seen that
the additional work requires approximately 10 millionths of a second per
iteration.  This is likely to be fast enough for most requirements.  

Using the Attribute::Handling (instead of manually using the C<encache>
subroutine which does the actual work) appears to be a tiny fraction of the
total overhead (1 millionth of a second per iteration).

(Benchmark results on my machine, please give me a shout if you get wildly
different results).

=head1 SEE ALSO

The attribute code is "inspired" by L<Attribute::Memoize>, and uses the very
funky L<Attribute::Handlers>.  This latter seems to be full of very tasty
crack, but is also much nicer than doing the attribute parsing ourselves.

You'll need a caching module like L<Cache::Cache> or L<Cache::Memcached>.

The wrapping might be done better with L<Hook::LexWrap>

=head1 STATUS and BUGS

This is version 0.01, in alpha.  The interface is likely to
change, as indicated in several places in comments in the above
POD.  Please get in touch if you have suggestions or concerns
about the public API.

Please report via RT on cpan, or to L<mailto:osfameron@cpan.org>.  

Or grab osfameron on IRC, for example on C<irc.perl.org #london.pm>

=head1 AUTHOR and LICENSE

By osfameron, for Thermeon Ltd.

(C)2007 Thermeon Europe

This program is free software, you can redistribute it and/or modify it under
the same terms as Perl itself.

=cut