File Coverage

blib/lib/Cache/FastMmap.pm
Criterion Covered Total %
statement 135 184 73.4
branch 34 64 53.1
condition 42 66 63.6
subroutine 19 23 82.6
pod 11 12 91.7
total 241 349 69.1


line stmt bran cond sub pod time code
1             package Cache::FastMmap;
2              
3 9     9   329 use Data::Dumper;
  9         90  
  9         213  
4              
5             =head1 NAME
6            
7             Cache::FastMmap - Uses an mmap'ed file to act as a shared memory interprocess cache
8            
9             =head1 SYNOPSIS
10            
11             use Cache::FastMmap;
12            
13             # Uses vaguely sane defaults
14             $Cache = Cache::FastMmap->new();
15            
16             # $Value must be a reference...
17             $Cache->set($Key, $Value);
18             $Value = $Cache->get($Key);
19            
20             $Cache = Cache::FastMmap->new(raw_values => 1);
21            
22             # $Value can't be a reference...
23             $Cache->set($Key, $Value);
24             $Value = $Cache->get($Key);
25            
26             =head1 ABSTRACT
27            
28             A shared memory cache through an mmap'ed file. It's core is written
29             in C for performance. It uses fcntl locking to ensure multiple
30             processes can safely access the cache at the same time. It uses
31             a basic LRU algorithm to keep the most used entries in the cache.
32            
33             =head1 DESCRIPTION
34            
35             In multi-process environments (eg mod_perl, forking daemons, etc),
36             it's common to want to cache information, but have that cache
37             shared between processes. Many solutions already exist, and may
38             suit your situation better:
39            
40             =over 4
41            
42             =item *
43            
44             L<MLDBM::Sync> - acts as a database, data is not automatically
45             expired, slow
46            
47             =item *
48            
49             L<IPC::MM> - hash implementation is broken, data is not automatically
50             expired, slow
51            
52             =item *
53            
54             L<Cache::FileCache> - lots of features, slow
55            
56             =item *
57            
58             L<Cache::SharedMemoryCache> - lots of features, VERY slow. Uses
59             IPC::ShareLite which freeze/thaws ALL data at each read/write
60            
61             =item *
62            
63             L<DBI> - use your favourite RDBMS. can perform well, need a
64             DB server running. very global. socket connection latency
65            
66             =item *
67            
68             L<Cache::Mmap> - similar to this module, in pure perl. slows down
69             with larger pages
70            
71             =item *
72            
73             L<BerkeleyDB> - very fast (data ends up mostly in shared memory
74             cache) but acts as a database overall, so data is not automatically
75             expired
76            
77             =back
78            
79             In the case I was working on, I needed:
80            
81             =over 4
82            
83             =item *
84            
85             Automatic expiry and space management
86            
87             =item *
88            
89             Very fast access to lots of small items
90            
91             =item *
92            
93             The ability to fetch/store many items in one go
94            
95             =back
96            
97             Which is why I developed this module. It tries to be quite
98             efficient through a number of means:
99            
100             =over 4
101            
102             =item *
103            
104             Core code is written in C for performance
105            
106             =item *
107            
108             It uses multiple pages within a file, and uses Fcntl to only lock
109             a page at a time to reduce contention when multiple processes access
110             the cache.
111            
112             =item *
113            
114             It uses a dual level hashing system (hash to find page, then hash
115             within each page to find a slot) to make most C<get()> calls O(1) and
116             fast
117            
118             =item *
119            
120             On each C<set()>, if there are slots and page space available, only
121             the slot has to be updated and the data written at the end of the used
122             data space. If either runs out, a re-organisation of the page is
123             performed to create new slots/space which is done in an efficient way
124            
125             =back
126            
127             The class also supports read-through, and write-back or write-through
128             callbacks to access the real data if it's not in the cache, meaning that
129             code like this:
130            
131             my $Value = $Cache->get($Key);
132             if (!defined $Value) {
133             $Value = $RealDataSource->get($Key);
134             $Cache->set($Key, $Value)
135             }
136            
137             Isn't required, you instead specify in the constructor:
138            
139             Cache::FastMmap->new(
140             ...
141             context => $RealDataSourceHandle,
142             read_cb => sub { $_[0]->get($_[1]) },
143             write_cb => sub { $_[0]->set($_[1], $_[2]) },
144             );
145            
146             And then:
147            
148             my $Value = $Cache->get($Key);
149            
150             $Cache->set($Key, $NewValue);
151            
152             Will just work and will be read/written to the underlying data source as
153             needed automatically.
154            
155             =head1 PERFORMANCE
156            
157             If you're storing relatively large and complex structures into
158             the cache, then you're limited by the speed of the Storable module.
159             If you're storing simple structures, or raw data, then
160             Cache::FastMmap has noticeable performance improvements.
161            
162             See L<http://cpan.robm.fastmail.fm/cache_perf.html> for some
163             comparisons to other modules.
164            
165             =head1 COMPATIABILITY
166            
167             Cache::FastMmap uses mmap to map a file as the shared cache space,
168             and fcntl to do page locking. This means it should work on most
169             UNIX like operating systems, but will not work on Windows or
170             Win32 like environments.
171            
172             =head1 MEMORY SIZE
173            
174             Because Cache::FastMmap mmap's a shared file into your processes memory
175             space, this can make each process look quite large, even though it's just
176             mmap'd memory that's shared between all processes that use the cache,
177             and may even be swapped out if the cache is getting low usage.
178            
179             However, the OS will think your process is quite large, which might
180             mean you hit some BSD::Resource or 'ulimits' you set previously that you
181             thought were sane, but aren't anymore, so be aware.
182            
183             =head1 USAGE
184            
185             Because the cache uses shared memory through an mmap'd file, you have
186             to make sure each process connects up to the file. There's probably
187             two main ways to do this:
188            
189             =over 4
190            
191             =item *
192            
193             Create the cache in the parent process, and then when it forks, each
194             child will inherit the same file descriptor, mmap'ed memory, etc and
195             just work.
196            
197             =item *
198            
199             Explicitly connect up in each forked child to the share file
200            
201             =back
202            
203             The first way is usually the easiest. If you're using the cache in a
204             Net::Server based module, you'll want to open the cache in the
205             C<pre_loop_hook>, because that's executed before the fork, but after
206             the process ownership has changed and any chroot has been done.
207            
208             In mod_perl, just open the cache at the global level in the appropriate
209             module, which is executed as the server is starting and before it
210             starts forking children, but you'll probably want to chmod or chown
211             the file to the permissions of the apache process.
212            
213             =head1 METHODS
214            
215             =over 4
216            
217             =cut
218              
219             # Modules/Export/XSLoader {{{
220 9     9   366 use 5.006;
  9         95  
  9         98  
221 9     9   145 use strict;
  9         81  
  9         142  
222 9     9   132 use warnings;
  9         82  
  9         145  
223 9     9   146 use bytes;
  9         110  
  9         119  
224 9     9   440 use Cache::FastMmap::CImpl;
  9         1430  
  9         372  
225              
226             require Exporter;
227              
228             our @ISA = qw(Exporter);
229              
230             # Items to export into callers namespace by default. Note: do not export
231             # names by default without a very good reason. Use EXPORT_OK instead.
232             # Do not simply export all your public functions/methods/constants.
233              
234             # This allows declaration use Cache::FastMmap ':all';
235             # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
236             # will save memory.
237             our %EXPORT_TAGS = ( 'all' => [ qw(
238            
239             ) ] );
240              
241             our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
242              
243             our @EXPORT = qw(
244            
245             );
246              
247             our $VERSION = '1.14';
248              
249 9     9   510 use constant FC_ISDIRTY => 1;
  9         79  
  9         160  
250             # }}}
251              
252             =item I<new(%Opts)>
253            
254             Create a new Cache::FastMmap object.
255            
256             Basic global parameters are:
257            
258             =over 4
259            
260             =item * B<share_file>
261            
262             File to mmap for sharing of data (default: /tmp/sharefile)
263            
264             =item * B<init_file>
265            
266             Clear any existing values and re-initialise file. Useful to do in a
267             parent that forks off children to ensure that file is empty at the start
268             (default: 0)
269            
270             B<Note:> This is quite important to do in the parent to ensure a
271             consistent file structure. The shared file is not perfectly transaction
272             safe, and so if a child is killed at the wrong instant, it might leave
273             the the cache file in an inconsistent state.
274            
275             =item * B<raw_values>
276            
277             Store values as raw binary data rather than using Storable to free/thaw
278             data structures (default: 0)
279            
280             =item * B<expire_time>
281            
282             Maximum time to hold values in the cache in seconds. A value of 0
283             means does no explicit expiry time, and values are expired only based
284             on LRU usage. Can be expressed as 1m, 1h, 1d for minutes/hours/days
285             respectively. (default: 0)
286            
287             =back
288            
289             You may specify the cache size as:
290            
291             =over 4
292            
293             =item * B<cache_size>
294            
295             Size of cache. Can be expresses as 1k, 1m for kilobytes or megabytes
296             respectively. Automatically guesses page size/page count values.
297            
298             =back
299            
300             Or specify explicit page size/page count values. If none of these are
301             specified, the values page_size = 64k and num_pages = 89 are used.
302            
303             =over 4
304            
305             =item * B<page_size>
306            
307             Size of each page. Must be a power of 2 between 4k and 1024k. If not,
308             is rounded to the nearest value.
309            
310             =item * B<num_pages>
311            
312             Number of pages. Should be a prime number for best hashing
313            
314             =back
315            
316             The cache allows the use of callbacks for reading/writing data to an
317             underlying data store.
318            
319             =over 4
320            
321             =item * B<context>
322            
323             Opaque reference passed as the first parameter to any callback function
324             if specified
325            
326             =item * B<read_cb>
327            
328             Callback to read data from the underlying data store. Called as:
329            
330             $read_cb->($context, $Key)
331            
332             Should return the value to use. This value will be saved in the cache
333             for future retrievals. Return undef if there is no value for the
334             given key
335            
336             =item * B<write_cb>
337            
338             Callback to write data to the underlying data store.
339             Called as:
340            
341             $write_cb->($context, $Key, $Value, $ExpiryTime)
342            
343             In 'write_through' mode, it's always called as soon as a I<set(...)>
344             is called on the Cache::FastMmap class. In 'write_back' mode, it's
345             called when a value is expunged from the cache if it's been changed
346             by a I<set(...)> rather than read from the underlying store with the
347             I<read_cb> above.
348            
349             Note: Expired items do result in the I<write_cb> being
350             called if 'write_back' caching is enabled and the item has been
351             changed. You can check the $ExpiryTime against C<time()> if you only
352             want to write back values which aren't expired.
353            
354             Also remember that I<write_cb> may be called in a different process
355             to the one that placed the data in the cache in the first place
356            
357             =item * B<delete_cb>
358            
359             Callback to delete data from the underlying data store. Called as:
360            
361             $delete_cb->($context, $Key)
362            
363             Called as soon as I<remove(...)> is called on the Cache::FastMmap class
364            
365             =item * B<cache_not_found>
366            
367             If set to true, then if the I<read_cb> is called and it returns
368             undef to say nothing was found, then that information is stored
369             in the cache, so that next time a I<get(...)> is called on that
370             key, undef is returned immediately rather than again calling
371             the I<read_cb>
372            
373             =item * B<write_action>
374            
375             Either 'write_back' or 'write_through'. (default: write_through)
376            
377             =item * B<empty_on_exit>
378            
379             When you have 'write_back' mode enabled, then
380             you really want to make sure all values from the cache are expunged
381             when your program exits so any changes are written back. This is a
382             bit tricky, because we don't know if you're in a child, so you
383             must ensure that the parent process either explicitly calls
384             I<empty()> or that this flag is set to true when the parent connects
385             to the cache, and false in all the children
386            
387             =back
388            
389             =cut
390             sub new {
391 10     10 1 450   my $Proto = shift;
392 10   33     186   my $Class = ref($Proto) || $Proto;
393 10         139   my %Args = @_;
394              
395 10         102   my $Self = {};
396 10         162   bless ($Self, $Class);
397              
398             # Work out cache file and whether to init
399 10   50     266   my $share_file = $Self->{share_file}
400                 = $Args{share_file} || '/tmp/sharefile';
401 10   50     142   my $init_file = $Args{init_file} || 0;
402 10   50     160   my $test_file = $Args{test_file} || 0;
403              
404             # Storing raw/storable values?
405 10   100     194   my $raw_values = $Self->{raw_values} = int($Args{raw_values} || 0);
406              
407             # Need storable module if not using raw values
408 10 100       114   if (!$raw_values) {
409 2 50   2   24     eval "use Storable qw(freeze thaw); 1;"
  2         29  
  2         19  
  2         45  
410                   || die "Could not load Storable module: $@";
411               }
412              
413             # Work out expiry time in seconds
414 10   100     263   my $expire_time = $Args{expire_time} || 0;
415 10         139   my %Times = (m => 60, h => 60*60, d => 24*60*60);
416 10 50       148   $expire_time *= $Times{$1} if $expire_time =~ s/([mhd])$//i;
417 10         155   $Self->{expire_time} = $expire_time = int($expire_time);
418              
419             # Function rounds to the nearest power of 2
420 10     10 0 186   sub RoundPow2 { return int(2 ** int(log($_[0])/log(2)) + 0.1); }
421              
422             # Work out cache size
423 10         92   my ($cache_size, $num_pages, $page_size);
424              
425 10         114   my %Sizes = (k => 1024, m => 1024*1024);
426 10 50       122   if ($cache_size = $Args{cache_size}) {
427 0 0       0     $cache_size *= $Sizes{$1} if $cache_size =~ s/([km])$//i;
428              
429 0 0       0     if ($num_pages = $Args{num_pages}) {
430 0         0       $page_size = RoundPow2($cache_size / $num_pages);
431 0 0       0       $page_size = 4096 if $page_size < 4096;
432              
433                 } else {
434 0   0     0       $page_size = $Args{page_size} || 65536;
435 0 0       0       $page_size *= $Sizes{$1} if $page_size =~ s/([km])$//i;
436 0 0       0       $page_size = 4096 if $page_size < 4096;
437              
438             # Increase num_pages till we exceed
439 0         0       $num_pages = 89;
440 0 0       0       if ($num_pages * $page_size <= $cache_size) {
441 0         0         while ($num_pages * $page_size <= $cache_size) {
442 0         0           $num_pages = $num_pages * 2 + 1;
443                     }
444                   } else {
445 0         0         while ($num_pages * $page_size > $cache_size) {
446 0         0           $num_pages = int(($num_pages-1) / 2);
447                     }
448 0         0         $num_pages = $num_pages * 2 + 1;
449                   }
450              
451                 }
452              
453               } else {
454 10         115     ($num_pages, $page_size) = @Args{qw(num_pages page_size)};
455 10   100     146     $num_pages ||= 89;
456 10   100     184     $page_size ||= 65536;
457 10 50       173     $page_size *= $Sizes{$1} if $page_size =~ s/([km])$//i;
458 10         107     $page_size = RoundPow2($page_size);
459               }
460              
461 10         101   $cache_size = $num_pages * $page_size;
462 10         119   @$Self{qw(cache_size num_pages page_size)}
463                 = ($cache_size, $num_pages, $page_size);
464              
465             # Number of slots to start in each page
466 10   50     331   my $start_slots = int($Args{start_slots} || 0) || 89;
      50        
467              
468             # Save read through/write back/write through details
469 10   100     264   my $write_back = ($Args{write_action} || 'write_through') eq 'write_back';
470 10         189   @$Self{qw(context read_cb write_cb delete_cb)}
471                 = @Args{qw(context read_cb write_cb delete_cb)};
472 10         136   @$Self{qw(empty_on_exit cache_not_found write_back)}
473                 = (@Args{qw(empty_on_exit cache_not_found)}, $write_back);
474              
475             # Initialise C cache code
476 10         139   my $Cache = Cache::FastMmap::CImpl::fc_new();
477              
478             # We bless the returned scalar ref into the same namespace,
479             # and store it in our own hash ref. We have to be sure
480             # that we only call C functions on this scalar ref, and
481             # only call PERL functions the hash ref we return
482 10         125   bless ($Cache, 'Cache::FastMmap::CImpl');
483              
484 10         101   $Self->{Cache} = $Cache;
485              
486             # Setup cache parameters
487 10         576   $Cache->fc_set_param('init_file', $init_file);
488 10         158   $Cache->fc_set_param('test_file', $test_file);
489 10         119   $Cache->fc_set_param('page_size', $page_size);
490 10         114   $Cache->fc_set_param('num_pages', $num_pages);
491 10         114   $Cache->fc_set_param('expire_time', $expire_time);
492 10         104   $Cache->fc_set_param('share_file', $share_file);
493 10         111   $Cache->fc_set_param('start_slots', $start_slots);
494              
495             # And initialise it
496 10         375206   $Cache->fc_init();
497              
498             # All done, return PERL hash ref as class
499 10         316   return $Self;
500             }
501              
502             =item I<get($Key, [ \%Options ])>
503            
504             Search cache for given Key. Returns undef if not found. If
505             I<read_cb> specified and not found, calls the callback to try
506             and find the value for the key, and if found (or 'cache_not_found'
507             is set), stores it into the cache and returns the found value.
508            
509             I<%Options> is optional, and is used by get_and_set() to control
510             the locking behaviour. For now, you should probably ignore it
511             unless you read the code to understand how it works
512            
513             =cut
514             sub get {
515 45623     45623 1 1342251   my ($Self, $Cache) = ($_[0], $_[0]->{Cache});
516              
517             # Hash value, lock page, read result
518 45623         664309   my ($HashPage, $HashSlot) = $Cache->fc_hash($_[1]);
519 45623         1174071   $Cache->fc_lock($HashPage);
520 45623         1078549   my ($Val, $Flags, $Found) = $Cache->fc_read($HashSlot, $_[1]);
521              
522             # Value not found, check underlying data store
523 45623 100 100     727134   if (!$Found && (my $read_cb = $Self->{read_cb})) {
524              
525             # Callback to read from underlying data store
526 13817         162328     $Val = eval { $read_cb->($Self->{context}, $_[1]); };
  13817         183120  
527              
528             # If we found it, or want to cache not-found, store back into our cache
529 13817 50 33     363828     if (defined $Val || $Self->{cache_not_found}) {
530              
531             # Are we doing writeback's? If so, need to mark as dirty in cache
532 13817         170452       my $write_back = $Self->{write_back};
533              
534             # If not using raw values, use freeze() to turn data
535 13817 50       174206       $Val = freeze(\$Val) if !$Self->{raw_values};
536              
537             # Get key/value len (we've got 'use bytes'), and do expunge check to
538             # create space if needed
539 13817         152936       my $KVLen = length($_[1]) + length($Val);
540 13817         169630       $Self->_expunge_page(2, 1, $KVLen);
541              
542 13817         307102       $Cache->fc_write($HashSlot, $_[1], $Val, 0);
543                 }
544               }
545              
546             # Unlock page and return any found value
547             # Unlock is done only if we're not in the middle of a get_set() operation.
548 45623 50 33     966223   $Cache->fc_unlock() unless $_[2] && $_[2]->{skip_unlock};
549              
550             # If not using raw values, use thaw() to turn data back into object
551 45623 100       633218   if (!$Self->{raw_values}) {
552 12207 100       145935     $Val = ${thaw($Val)} if defined $Val;
  12204         170508  
553               }
554              
555 45623         864725   return $Val;
556             }
557              
558             =item I<set($Key, $Value, [ \%Options ])>
559            
560             Store specified key/value pair into cache
561            
562             I<%Options> is optional, and is used by get_and_set() to control
563             the locking behaviour. For now, you should probably ignore it
564             unless you read the code to understand how it works
565            
566             =cut
567             sub set {
568 14854     14854 1 20811426   my ($Self, $Cache) = ($_[0], $_[0]->{Cache});
569              
570             # Hash value, lock page
571 14854         243862   my ($HashPage, $HashSlot) = $Cache->fc_hash($_[1]);
572 14854 50 33     448496   $Cache->fc_lock($HashPage) unless $_[3] && $_[3]->{skip_lock};
573              
574             # Are we doing writeback's? If so, need to mark as dirty in cache
575 14854         161526   my $write_back = $Self->{write_back};
576              
577             # If not using raw values, use freeze() to turn data
578 14854 100       196711   my $Val = $Self->{raw_values} ? $_[2] : freeze(\$_[2]);
579              
580             # Get key/value len (we've got 'use bytes'), and do expunge check to
581             # create space if needed
582 14854         178686   my $KVLen = length($_[1]) + length($Val);
583 14854         193456   $Self->_expunge_page(2, 1, $KVLen);
584              
585             # Now store into cache
586 14854 100       401964   my $DidStore = $Cache->fc_write($HashSlot, $_[1], $Val, $write_back ? FC_ISDIRTY : 0);
587              
588             # Unlock page
589 14854         265021   $Cache->fc_unlock();
590              
591             # If we're doing write-through, or write-back and didn't get into cache,
592             # write back to the underlying store
593 14854 100 66     269187   if ((!$write_back || !$DidStore) && (my $write_cb = $Self->{write_cb})) {
      100        
594 3000         31815     eval { $write_cb->($Self->{context}, $_[1], $_[2]); };
  3000         40131  
595               }
596              
597 14854         248305   return $DidStore;
598             }
599              
600             =item I<get_and_set($Key, $Sub)>
601            
602             Atomically retrieve and set the value of a Key.
603            
604             The page is locked while retrieving the $Key and is unlocked only after
605             the value is set, thus guaranteeing the value does not change betwen
606             the get and set operations.
607            
608             $Sub is a reference to a subroutine that is called to calculate the
609             new value to store. $Sub gets $Key and the current value
610             as parameters, and
611             should return the new value to set in the cache for the given $Key.
612            
613             For example, to atomically increment a value in the cache, you
614             can just use:
615            
616             $Cache->get_and_set($Key, sub { return ++$_[1]; });
617            
618             The return value from this function is the new value stored back
619             into the cache.
620            
621             Notes:
622            
623             =over 4
624            
625             =item *
626            
627             Do not perform any get/set operations from the callback sub, as these
628             operations lock the page and you may end up with a dead lock!
629            
630             =item *
631            
632             Make sure your sub does not die/throw an exception, otherwise the
633             unlocking code will be skipped. You can protect yourself by
634             wrapping everything in your sub in an C<eval { }>
635            
636             =back
637            
638             =cut
639             sub get_and_set {
640 0     0 1 0   my ($Self, $Cache) = ($_[0], $_[0]->{Cache});
641              
642 0         0   my $Value = $Self->get($_[1], { skip_unlock => 1 });
643 0         0   $Value = $_[2]->($_[1], $Value);
644 0         0   $Self->set($_[1], $Value, { skip_lock => 1 });
645              
646 0         0   return $Value;
647             }
648              
649             =item I<remove($Key)>
650            
651             Delete the given key from the cache
652            
653             =cut
654             sub remove {
655 301     301 1 7937   my ($Self, $Cache) = ($_[0], $_[0]->{Cache});
656              
657             # Hash value, lock page, read result
658 301         3470   my ($HashPage, $HashSlot) = $Cache->fc_hash($_[1]);
659 301         7046   $Cache->fc_lock($HashPage);
660 301         6373   my ($DidDel, $Flags) = $Cache->fc_delete($HashSlot, $_[1]);
661 301         4137   $Cache->fc_unlock();
662              
663             # If we deleted from the cache, and it's not dirty, also delete
664             # from underlying store
665 301 50 33     5168   if ((!$DidDel || ($DidDel && !($Flags & FC_ISDIRTY)))
      66        
      33        
666                  && (my $delete_cb = $Self->{delete_cb})) {
667 301         3001     eval { $delete_cb->($Self->{context}, $_[1]); };
  301         3732  
668               }
669               
670 301         6176   return $DidDel;
671             }
672              
673             =item I<clear()>
674            
675             Clear all items from the cache
676            
677             Note: If you're using callbacks, this has no effect
678             on items in the underlying data store. No delete
679             callbacks are made
680            
681             =cut
682             sub clear {
683 3     3 1 39   my $Self = shift;
684 3         40   $Self->_expunge_all(1, 0);
685             }
686              
687             =item I<purge()>
688            
689             Clear all expired items from the cache
690            
691             Note: If you're using callbacks, this has no effect
692             on items in the underlying data store. No delete
693             callbacks are made, and no write callbacks are made
694             for the expired data
695            
696             =cut
697             sub purge {
698 0     0 1 0   my $Self = shift;
699 0         0   $Self->_expunge_all(0, 0);
700             }
701              
702             =item I<empty($OnlyExpired)>
703            
704             Empty all items from the cache, or if $OnlyExpired is
705             true, only expired items.
706            
707             Note: If 'write_back' mode is enabled, any changed items
708             are written back to the underlying store. Expired items are
709             written back to the underlying store as well.
710            
711             =cut
712             sub empty {
713 2     2 1 74   my $Self = shift;
714 2 50       879   $Self->_expunge_all($_[0] ? 0 : 1, 1);
715             }
716              
717             =item I<get_keys($Mode)>
718            
719             Get a list of keys/values held in the cache. May immediately be out of
720             date because of the shared access nature of the cache
721            
722             If $Mode == 0, an array of keys is returned
723            
724             If $Mode == 1, then an array of hashrefs, with 'key',
725             'last_access', 'expire_time' and 'flags' keys is returned
726            
727             If $Mode == 2, then hashrefs also contain 'value' key
728            
729             =cut
730             sub get_keys {
731 11     11 1 181   my ($Self, $Cache) = ($_[0], $_[0]->{Cache});
732              
733 11   100     139   my $Mode = $_[1] || 0;
734 11 100 66     18458   return $Cache->fc_get_keys($Mode)
      100        
735                 if $Mode <= 1 || ($Mode == 2 && $Self->{raw_values});
736              
737             # If we're getting values as well, and they're not raw, unfreeze them
738 1         1144   my @Details = $Cache->fc_get_keys(2);
739 1         15   for (@Details) { $_->{value} = ${thaw($_->{value})}; }
  2         17  
  2         27  
740 1         15   return @Details;
741             }
742              
743             =item I<multi_get($PageKey, [ $Key1, $Key2, ... ])>
744            
745             The two multi_xxx routines act a bit differently to the
746             other routines. With the multi_get, you pass a separate
747             PageKey value and then multiple keys. The PageKey value
748             is hashed, and that page locked. Then that page is
749             searched for each key. It returns a hash ref of
750             Key => Value items found in that page in the cache.
751            
752             The main advantage of this is just a speed one, if you
753             happen to need to search for a lot of items on each call.
754            
755             For instance, say you have users and a bunch of pieces
756             of separate information for each user. On a particular
757             run, you need to retrieve a sub-set of that information
758             for a user. You could do lots of get() calls, or you
759             could use the 'username' as the page key, and just
760             use one multi_get() and multi_set() call instead.
761            
762             A couple of things to note:
763            
764             =over 4
765            
766             =item 1.
767            
768             This makes multi_get()/multi_set() and get()/set()
769             incompatiable. Don't mix calls to the two, because
770             you won't find the data you're expecting
771            
772             =item 2.
773            
774             The writeback and callback modes of operation do
775             not work with multi_get()/multi_set(). Don't attempt
776             to use them together.
777            
778             =back
779            
780             =cut
781             sub multi_get {
782 0     0 1 0   my ($Self, $Cache) = ($_[0], $_[0]->{Cache});
783              
784             # Hash value page key, lock page
785 0         0   my ($HashPage, $HashSlot) = $Cache->fc_hash($_[1]);
786 0         0   $Cache->fc_lock($HashPage);
787              
788             # For each key to find
789 0         0   my ($Keys, %KVs) = ($_[2]);
790 0         0   for (@$Keys) {
791              
792             # Hash key to get slot in this page and read
793 0         0     my $FinalKey = "$_[1]-$_";
794 0         0     (undef, $HashSlot) = $Cache->fc_hash($FinalKey);
795 0         0     my ($Val, $Flags, $Found) = $Cache->fc_read($HashSlot, $FinalKey);
796 0 0       0     next unless $Found;
797              
798             # If not using raw values, use thaw() to turn data back into object
799 0 0       0     $Val = ${thaw($Val)} unless $Self->{raw_values};
  0         0  
800              
801             # Save to return
802 0         0     $KVs{$_} = $Val;
803               }
804              
805             # Unlock page and return any found value
806 0         0   $Cache->fc_unlock();
807              
808 0         0   return \%KVs;
809             }
810              
811             =item I<multi_set($PageKey, { $Key1 => $Value1, $Key2 => $Value2, ... })>
812            
813             Store specified key/value pair into cache
814            
815             =cut
816             sub multi_set {
817 0     0 1 0   my ($Self, $Cache) = ($_[0], $_[0]->{Cache});
818              
819             # Hash page key value, lock page
820 0         0   my ($HashPage, $HashSlot) = $Cache->fc_hash($_[1]);
821 0         0   $Cache->fc_lock($HashPage);
822              
823             # Loop over each key/value storing into this page
824 0         0   my $KVs = $_[2];
825 0         0   while (my ($Key, $Val) = each %$KVs) {
826              
827             # If not using raw values, use freeze() to turn data
828 0 0       0     $Val = freeze(\$Val) unless $Self->{raw_values};
829              
830             # Get key/value len (we've got 'use bytes'), and do expunge check to
831             # create space if needed
832 0         0     my $FinalKey = "$_[1]-$Key";
833 0         0     my $KVLen = length($FinalKey) + length($Val);
834 0         0     $Self->_expunge_page(2, 1, $KVLen);
835              
836             # Now hash key and store into page
837 0         0     (undef, $HashSlot) = $Cache->fc_hash($FinalKey);
838 0         0     $Cache->fc_write($HashSlot, $FinalKey, $Val, 0);
839               }
840              
841             # Unlock page
842 0         0   $Cache->fc_unlock();
843              
844 0         0   return 1;
845             }
846              
847             =back
848            
849             =cut
850              
851             =head1 INTERNAL METHODS
852            
853             =over 4
854            
855             =cut
856              
857             =item I<_expunge_all($Mode, $WB)>
858            
859             Expunge all items from the cache
860            
861             Expunged items (that have not expired) are written
862             back to the underlying store if write_back is enabled
863            
864             =cut
865             sub _expunge_all {
866 5     5   63   my ($Self, $Cache, $Mode, $WB) = ($_[0], $_[0]->{Cache}, $_[1], $_[2]);
867              
868             # Repeat expunge for each page
869 5         64   for (0 .. $Self->{num_pages}-1) {
870 273         7238     $Cache->fc_lock($_);
871 273         2729     $Self->_expunge_page($Mode, $WB, -1);
872 273         7423     $Cache->fc_unlock();
873               }
874              
875             }
876              
877             =item I<_expunge_page($Mode, $WB, $Len)>
878            
879             Expunge items from the current page to make space for
880             $Len bytes key/value items
881            
882             Expunged items (that have not expired) are written
883             back to the underlying store if write_back is enabled
884            
885             =cut
886             sub _expunge_page {
887 28944     28944   400665   my ($Self, $Cache, $Mode, $WB, $Len) = ($_[0], $_[0]->{Cache}, @_[1 .. 3]);
888              
889             # If writeback mode, need to get expunged items to write back
890 28944 100 100     423710   my $write_cb = $Self->{write_back} && $WB ? $Self->{write_cb} : undef;
891              
892 28944 100       636365   my @WBItems = $Cache->fc_expunge($Mode, $write_cb ? 1 : 0, $Len);
893              
894 28944         376343   for (@WBItems) {
895 11202 100       197519     next if !($_->{flags} & FC_ISDIRTY);
896 3100         30891     eval { $write_cb->($Self->{context}, $_->{key}, $_->{value}, $_->{expire_time}); };
  3100         45150  
897               }
898             }
899              
900             sub DESTROY {
901 10     10   139   my ($Self, $Cache) = ($_[0], $_[0]->{Cache});
902              
903             # Expunge all entries on exit if requested
904 10 50 33     152   if ($Self->{empty_on_exit} && $Cache) {
905 0         0     $Self->empty();
906               }
907              
908 10 50       120   if ($Cache) {
909             # The destructor calls close for us
910 10         93     $Cache = undef;
911 10         117     delete $Self->{Cache};
912               }
913             }
914              
915             1;
916              
917             __END__
918            
919             =back
920            
921             =head1 SEE ALSO
922            
923             L<MLDBM::Sync>, L<IPC::MM>, L<Cache::FileCache>, L<Cache::SharedMemoryCache>,
924             L<DBI>, L<Cache::Mmap>, L<BerkeleyDB>
925            
926             Latest news/details can also be found at:
927            
928             L<http://cpan.robm.fastmail.fm/cachefastmmap/>
929            
930             =head1 AUTHOR
931            
932             Rob Mueller E<lt>L<mailto:cpan@robm.fastmail.fm>E<gt>
933            
934             =head1 COPYRIGHT AND LICENSE
935            
936             Copyright (C) 2003-2006 by FastMail IP Partners
937            
938             This library is free software; you can redistribute it and/or modify
939             it under the same terms as Perl itself.
940            
941             =cut
942            
943