home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / BaseCache.pm < prev    next >
Encoding:
Perl POD Document  |  2003-11-12  |  4.2 KB  |  171 lines
  1. # Copyright (c) 1998-2003 by Jonathan Swartz. All rights reserved.
  2. # This program is free software; you can redistribute it and/or modify it
  3. # under the same terms as Perl itself.
  4.  
  5. package HTML::Mason::Cache::BaseCache;
  6. use strict;
  7.  
  8. #
  9. # Override to handle busy_lock and expire_if.
  10. #
  11. sub get
  12. {
  13.     my ($self, $key, %params) = @_;
  14.     die "must specify key" unless defined($key);
  15.  
  16.     foreach my $param (keys(%params)) {
  17.     unless ($param =~ /^(busy_lock|expire_if)$/) {
  18.         die "unknown param '$param'";
  19.     }
  20.     }
  21.  
  22.     $self->_conditionally_auto_purge_on_get();
  23.  
  24.     if (my $sub = $params{expire_if}) {
  25.     $self->expire_if($key, $sub);
  26.     }
  27.  
  28.     my $object = $self->get_object($key) or
  29.     return undef;
  30.  
  31.     if (Cache::BaseCache::Object_Has_Expired($object))
  32.     {
  33.     if ($params{busy_lock}) {
  34.         # If busy_lock value provided, set a new "temporary"
  35.         # expiration time that many seconds forward, and return
  36.         # undef so that this process will start recomputing.
  37.         my $busy_lock_time = Cache::BaseCache::Canonicalize_Expiration_Time($params{busy_lock});
  38.         $object->set_expires_at(time + $busy_lock_time);
  39.         $self->set_object($key, $object);
  40.     } else {
  41.         $self->remove($key);
  42.     }
  43.     return undef;
  44.     }
  45.  
  46.     return $object->get_data( );
  47. }
  48.  
  49. sub expire
  50. {
  51.     my ($self, $key) = @_;
  52.  
  53.     if (my $obj = $self->get_object($key)) {
  54.     $obj->set_expires_at(time-1);
  55.     $self->set_object($key, $obj);
  56.     }
  57. }
  58.  
  59. sub expire_if
  60. {
  61.     my ($self, $key, $sub) = @_;
  62.     die "must specify subroutine" unless defined($sub) and ref($sub) eq 'CODE';
  63.  
  64.     if (my $obj = $self->get_object($key)) {
  65.     my $retval = $sub->($obj);
  66.     if ($retval) {
  67.         $self->expire($key);
  68.     }
  69.     return $retval;
  70.     } else {
  71.     return 1;
  72.     }
  73. }
  74.  
  75.  
  76. 1;
  77.  
  78. __END__
  79.  
  80. =head1 NAME
  81.  
  82. HTML::Mason::Cache::BaseCache - Base cache object
  83.  
  84. =head1 DESCRIPTION
  85.  
  86. This is the base module for all cache implementations used in Mason.
  87. It provides a few additional methods on top of C<Cache::BaseCache> in
  88. Dewitt Clinton's C<Cache::Cache> package.
  89.  
  90. An object of this class is returned from L<$m-E<gt>cache|HTML::Mason::Request/item_cache>.
  91.  
  92. =head1 METHODS
  93.  
  94. =over
  95.  
  96. =for html <a name="item_clear"></a>
  97.  
  98. =item clear ()
  99.  
  100. Remove all values in the cache.
  101.  
  102. =for html <a name="item_get"></a>
  103.  
  104. =item get (key, [%params])
  105.  
  106. Returns the value associated with I<key> or undef if it is
  107. non-existent or expired. This is extended with the following optional
  108. name/value parameters:
  109.  
  110. =over
  111.  
  112. =item busy_lock => duration
  113.  
  114. If the value has expired, set its expiration time to the current time plus
  115. I<duration> (instead of removing it from the cache) before returning undef.
  116. This is used to prevent multiple processes from recomputing the same
  117. expensive value simultaneously. The I<duration> may be of any form acceptable
  118. to L<set|HTML::Mason::Cache::BaseCache/item_set>.
  119.  
  120. =item expire_if => sub
  121.  
  122. If the value exists and has not expired, call I<sub> with the cache
  123. object as a single parameter. If I<sub> returns a true value, expire
  124. the value.
  125.  
  126. =back
  127.  
  128. =for html <a name="item_get_object"></a>
  129.  
  130. =item get_object (key)
  131.  
  132. Returns the underlying C<Cache::Object> object associated with I<key>.
  133. The most useful methods on this object are
  134.  
  135.     $co->get_created_at();    # when was object stored in cache
  136.     $co->get_accessed_at();   # when was object last accessed
  137.     $co->get_expires_at();    # when does object expire
  138.  
  139. =for html <a name="item_expire"></a>
  140.  
  141. =item expire (key)
  142.  
  143. Expires the value associated with I<key>, if it exists. Differs from
  144. L<remove|HTML::Mason::Cache::BaseCache/item_remove> only in that
  145. the cache object is left around, e.g. for retrieval by
  146. L<get_object|HTML::Mason::Cache::BaseCache/item_get_object>.
  147.  
  148. =for html <a name="item_remove"></a>
  149.  
  150. =item remove (key)
  151.  
  152. Removes the cache object associated with I<key>, if it exists.
  153.  
  154. =for html <a name="item_set"></a>
  155.  
  156. =item set (key, data, [duration])
  157.  
  158. Associates I<data> with I<key> in the cache. I<duration>
  159. indicates the time until the value should be erased.  If
  160. I<duration> is unspecified, the value will never expire
  161. by time.
  162.  
  163. I<$expires_in> may be a simple number of seconds, or a string of the
  164. form "[number] [unit]", e.g., "10 minutes".  The valid units are s,
  165. second, seconds, sec, m, minute, minutes, min, h, hour, hours, d, day,
  166. days, w, week, weeks, M, month, months, y, year, and years.
  167.  
  168. =back
  169.  
  170. =cut
  171.