view release on metacpan or  search on metacpan

lib/HTML/Mason/Request.pm  view on Meta::CPAN

    }

    # Combine defaults with options passed in here.
    if ($self->data_cache_defaults) {
        %options = (%{$self->data_cache_defaults}, %options);
    }

    # If using the CHI API, just create and return a CHI handle. Namespace will be escaped by CHI.
    if ($self->data_cache_api eq 'chi') {
        my $chi_root_class = delete($options{chi_root_class}) || 'CHI';
        load_pkg($chi_root_class);
        if (!exists($options{namespace})) {
            $options{namespace} = $self->current_comp->comp_id;
        }
        if (!exists($options{driver}) && !exists($options{driver_class})) {
            $options{driver} = $self->interp->cache_dir ? 'File' : 'Memory';
            $options{global} = 1 if $options{driver} eq 'Memory';            
        }
        $options{root_dir} ||= $self->interp->cache_dir;
        return $chi_root_class->new(%options);
    }

    $options{cache_root} ||= $self->interp->cache_dir;
    $options{namespace}  ||= compress_path($self->current_comp->comp_id);

    # Determine cache_class, adding 'Cache::' in front of user's
    # specification if necessary.
    my $cache_class = $self->interp->cache_dir ? 'Cache::FileCache' : 'Cache::MemoryCache';
    if ($options{cache_class}) {
        $cache_class = $options{cache_class};
        $cache_class = "Cache::$cache_class" unless $cache_class =~ /::/;
        delete($options{cache_class});
    }

    # Now prefix cache class with "HTML::Mason::". This will be a
    # dynamically constructed package that simply inherits from
    # HTML::Mason::Cache::BaseCache and the chosen cache class.
    my $mason_cache_class = "HTML::Mason::$cache_class";
    unless (pkg_loaded($mason_cache_class)) {
        load_pkg('Cache::Cache', '$m->cache requires the Cache::Cache module, available from CPAN.');
        load_pkg($cache_class, 'Fix your Cache::Cache installation or choose another cache class.');
        # need to break up mention of VERSION var or else CPAN/EU::MM can choke when running 'r'
        eval sprintf('package %s; use base qw(HTML::Mason::Cache::BaseCache %s); use vars qw($' . 'VERSION); $' . 'VERSION = 1.0;',
                     $mason_cache_class, $cache_class);
        error "Error constructing mason cache class $mason_cache_class: $@" if $@;
    }

    my $cache = $mason_cache_class->new (\%options)
        or error "could not create cache object";

    # Implement 1.0x cache API or just return cache object.
    if ($self->data_cache_api eq '1.0') {
        return $self->_cache_1_x($cache, %old_cache_options);
    } else {
        return $cache;
    }
}

#
# Implement 1.0x cache API in terms of Cache::Cache.
# Supported: action, busy_lock, expire_at, expire_if, expire_in, expire_next, key, value
# Silently not supported: keep_in_memory, tie_class
#
sub _cache_1_x
{
    my ($self, $cache, %options) = @_;

    my $action = $options{action} || 'retrieve';
    my $key = $options{key} || 'main';
    
    if ($action eq 'retrieve') {
        
        # Validate parameters.
        if (my @invalids = grep(!/^(expire_if|action|key|busy_lock|keep_in_memory|tie_class)$/, keys(%options))) {
            param_error "cache: invalid parameter '$invalids[0]' for action '$action'\n";
        }

        # Handle expire_if.
        if (my $sub = $options{expire_if}) {
            if (my $obj = $cache->get_object($key)) {
                if ($sub->($obj->get_created_at)) {
                    $cache->expire($key);
                }
            }
        }

        # Return the value or undef, handling busy_lock.
        if (my $result = $cache->get($key, ($options{busy_lock} ? (busy_lock=>$options{busy_lock}) : ()))) {
            return $result;
        } else {
            return undef;
        }

    } elsif ($action eq 'store') {

        # Validate parameters   
        if (my @invalids = grep(!/^(expire_(at|next|in)|action|key|value|keep_in_memory|tie_class)$/, keys(%options))) {
            param_error "cache: invalid parameter '$invalids[0]' for action '$action'\n";
        }
        param_error "cache: no store value provided" unless exists($options{value});

        # Determine $expires_in if expire flag given. For the "next"
        # options, we're jumping through hoops to find the *top* of
        # the next hour or day.
        #
        my $expires_in;
        my $time = time;
        if (exists($options{expire_at})) {
            param_error "cache: invalid expire_at value '$options{expire_at}' - must be a numeric time value\n" if $options{expire_at} !~ /^[0-9]+$/;
            $expires_in = $options{expire_at} - $time;
        } elsif (exists($options{expire_next})) {
            my $term = $options{expire_next};
            my ($sec, $min, $hour) = localtime($time);
            if ($term eq 'hour') {
                $expires_in = 60*(59-$min)+(60-$sec);
            } elsif ($term eq 'day') {
                $expires_in = 3600*(23-$hour)+60*(59-$min)+(60-$sec);
            } else {
                param_error "cache: invalid expire_next value '$term' - must be 'hour' or 'day'\n";
            }
        } elsif (exists($options{expire_in})) {
            $expires_in = $options{expire_in};
        }

        # Set and return the value.
        my $value = $options{value};
        $cache->set($key, $value, $expires_in);
        return $value;

    } elsif ($action eq 'expire') {
        my @keys = (ref($key) eq 'ARRAY') ? @$key : ($key);
        foreach my $key (@keys) {
            $cache->expire($key);
        }

    } elsif ($action eq 'keys') {
        return $cache->get_keys;
    }
}

sub cache_self {
    my ($self, %options) = @_;

    return if $self->{top_stack}->[STACK_IN_CALL_SELF]->{'CACHE_SELF'};

    my (%store_options, %retrieve_options);
    my ($expires_in, $key, $cache);
    if ($self->data_cache_api eq '1.0') {
        foreach (qw(key expire_if busy_lock)) {
            $retrieve_options{$_} = $options{$_} if (exists($options{$_}));
        }
        foreach (qw(key expire_at expire_next expire_in)) {
            $store_options{$_} = $options{$_} if (exists($options{$_}));
        }
    } else {
        #
        # key, expires_in/expire_in, expire_if and busy_lock go into
        # the set and get methods as appropriate. All other options
        # are passed into $self->cache.
        #
        foreach (qw(expire_if busy_lock)) {
            $retrieve_options{$_} = delete($options{$_}) if (exists($options{$_}));
        }
        $expires_in = delete $options{expires_in} || delete $options{expire_in} || 'never';
        $key = delete $options{key} || '__mason_cache_self__';
        $cache = $self->cache(%options);
    }

    my ($output, @retval, $error);

    my $cached =
        ( $self->data_cache_api eq '1.0' ?
          $self->cache(%retrieve_options) :
          $cache->get($key, %retrieve_options)
        );

    if ($cached) {
        ($output, my $retval) = @$cached;
        @retval = @$retval;
    } else {
        $self->call_self( \$output, \@retval, \$error, 'CACHE_SELF' );

        # If user aborted or declined, store in cache and print output
        # before repropagating.
        #
        rethrow_exception $error
            unless ($self->_aborted_or_declined($error));

        my $value = [$output, \@retval];
        if ($self->data_cache_api eq '1.0') {
            $self->cache(action=>'store', key=>$key, value=>$value, %store_options);
        } else {
            $cache->set($key, $value, $expires_in);
        }
    }

    #
    # Print the component output.
    #
    $self->print($output);

    #
    # Rethrow abort/decline exception if any.
    #
    rethrow_exception $error;

    #
    # Return the component return value in case the caller is interested,
    # followed by 1 indicating the cache retrieval success.
    #
    return (@retval, 1);
}

sub call_self
{
    my ($self, $output, $retval, $error, $tag) = @_;

    # Keep track of each individual invocation of call_self in the
    # component, via $tag.  $tag is 'CACHE_SELF' or 'FILTER' when used
    # by $m->cache_self and <%filter> sections respectively.
    #

lib/HTML/Mason/Request.pm  view on Meta::CPAN

This may return nothing if the base component is not yet known, for
example inside a plugin's C<start_request_hook()> method, where we
have created a request but it does not yet know anything about the
component being called.

=item cache

=for html <a name="item_cache"></a>

C<$m-E<gt>cache> returns a new L<cache object|HTML::Mason::Cache::BaseCache> with a
namespace specific to this component. The parameters to and return value from
C<$m-E<gt>cache> differ depending on which L<data_cache_api> you are using.

=over

=item If data_cache_api = 1.1 (default)

I<cache_class> specifies the class of cache object to create. It
defaults to C<FileCache> in most cases, or C<MemoryCache> if the
interpreter has no data directory, and must be a backend subclass of
C<Cache::Cache>. The prefix "Cache::" need not be included.  See the
C<Cache::Cache> package for a full list of backend subclasses.
 
Beyond that, I<cache_options> may include any valid options to the new() method of the
cache class. e.g. for C<FileCache>, valid options include C<default_expires_in> and
C<cache_depth>.

See L<HTML::Mason::Cache::BaseCache|HTML::Mason::Cache::BaseCache> for
information about the object returned from C<$m-E<gt>cache>.

=item If data_cache_api = CHI

I<chi_root_class> specifies the factory class that will be called to
create cache objects. The default is 'CHI'.

I<driver> specifies the driver to use, for example C<Memory> or
C<FastMmap>.  The default is C<File> in most cases, or C<Memory> if
the interpreter has no data directory.

Beyond that, I<cache_options> may include any valid options to the
new() method of the driver. e.g. for the C<File> driver, valid options
include C<expires_in> and C<depth>.

=back

=item cache_self ([expires_in => '...'], [key => '...'], [get_options], [cache_options])

=for html <a name="item_cache_self"></a>

C<$m-E<gt>cache_self> caches the entire output and return result of a
component.

C<cache_self> either returns undef, or a list containing the
return value of the component followed by '1'. You should return
immediately upon getting the latter result, as this indicates
that you are inside the second invocation of the component.

C<cache_self> takes any of parameters to C<$m-E<gt>cache>
(e.g. I<cache_depth>), any of the optional parameters to
C<$cache-E<gt>get> (I<expire_if>, I<busy_lock>), and two additional
options:

=over

=item *

I<expire_in> or I<expires_in>: Indicates when the cache expires - it
is passed as the third argument to C<$cache-E<gt>set>. e.g. '10 sec',
'5 min', '2 hours'.

=item *

I<key>: An identifier used to uniquely identify the cache results - it
is passed as the first argument to C<$cache-E<gt>get> and
C<$cache-E<gt>set>.  The default key is '__mason_cache_self__'.

=back

To cache the component's output:

    <%init>
    return if $m->cache_self(expire_in => '10 sec'[, key => 'fookey']);
    ... <rest of init> ...
    </%init>

To cache the component's scalar return value:

    <%init>
    my ($result, $cached) = $m->cache_self(expire_in => '5 min'[, key => 'fookey']);

    return $result if $cached;
    ... <rest of init> ...
    </%init>

To cache the component's list return value:

    <%init>
    my (@retval) = $m->cache_self(expire_in => '3 hours'[, key => 'fookey']);

    return @retval if pop @retval;
    ... <rest of init> ...
    </%init>

We call C<pop> on C<@retval> to remove the mandatory '1' at the end of
the list.

If a component has a C<< <%filter> >> block, then the I<filtered>
output is cached.

Note: users upgrading from 1.0x and earlier can continue to use the
old C<$m-E<gt>cache_self> API by setting L<data_cache_api|HTML::Mason::Params/data_cache_api> to '1.0'.
This support will be removed at a later date.

See the the L<DATA CACHING|HTML::Mason::Devel/DATA CACHING> section of the developer's manual section for more details on how to
exercise finer control over caching.

=item caller_args

=for html <a name="item_caller_args"></a>