1package Cache::FastMmap; 2 3=head1 NAME 4 5Cache::FastMmap - Uses an mmap'ed file to act as a shared memory interprocess cache 6 7=head1 SYNOPSIS 8 9 use Cache::FastMmap; 10 11 # Uses vaguely sane defaults 12 $Cache = Cache::FastMmap->new(); 13 14 # Uses Storable to serialize $Value to bytes for storage 15 $Cache->set($Key, $Value); 16 $Value = $Cache->get($Key); 17 18 $Cache = Cache::FastMmap->new(serializer => ''); 19 20 # Stores stringified bytes of $Value directly 21 $Cache->set($Key, $Value); 22 $Value = $Cache->get($Key); 23 24=head1 ABSTRACT 25 26A shared memory cache through an mmap'ed file. It's core is written 27in C for performance. It uses fcntl locking to ensure multiple 28processes can safely access the cache at the same time. It uses 29a basic LRU algorithm to keep the most used entries in the cache. 30 31=head1 DESCRIPTION 32 33In multi-process environments (eg mod_perl, forking daemons, etc), 34it's common to want to cache information, but have that cache 35shared between processes. Many solutions already exist, and may 36suit your situation better: 37 38=over 4 39 40=item * 41 42L<MLDBM::Sync> - acts as a database, data is not automatically 43expired, slow 44 45=item * 46 47L<IPC::MM> - hash implementation is broken, data is not automatically 48expired, slow 49 50=item * 51 52L<Cache::FileCache> - lots of features, slow 53 54=item * 55 56L<Cache::SharedMemoryCache> - lots of features, VERY slow. Uses 57IPC::ShareLite which freeze/thaws ALL data at each read/write 58 59=item * 60 61L<DBI> - use your favourite RDBMS. can perform well, need a 62DB server running. very global. socket connection latency 63 64=item * 65 66L<Cache::Mmap> - similar to this module, in pure perl. slows down 67with larger pages 68 69=item * 70 71L<BerkeleyDB> - very fast (data ends up mostly in shared memory 72cache) but acts as a database overall, so data is not automatically 73expired 74 75=back 76 77In the case I was working on, I needed: 78 79=over 4 80 81=item * 82 83Automatic expiry and space management 84 85=item * 86 87Very fast access to lots of small items 88 89=item * 90 91The ability to fetch/store many items in one go 92 93=back 94 95Which is why I developed this module. It tries to be quite 96efficient through a number of means: 97 98=over 4 99 100=item * 101 102Core code is written in C for performance 103 104=item * 105 106It uses multiple pages within a file, and uses Fcntl to only lock 107a page at a time to reduce contention when multiple processes access 108the cache. 109 110=item * 111 112It uses a dual level hashing system (hash to find page, then hash 113within each page to find a slot) to make most C<get()> calls O(1) and 114fast 115 116=item * 117 118On each C<set()>, if there are slots and page space available, only 119the slot has to be updated and the data written at the end of the used 120data space. If either runs out, a re-organisation of the page is 121performed to create new slots/space which is done in an efficient way 122 123=back 124 125The class also supports read-through, and write-back or write-through 126callbacks to access the real data if it's not in the cache, meaning that 127code like this: 128 129 my $Value = $Cache->get($Key); 130 if (!defined $Value) { 131 $Value = $RealDataSource->get($Key); 132 $Cache->set($Key, $Value) 133 } 134 135Isn't required, you instead specify in the constructor: 136 137 Cache::FastMmap->new( 138 ... 139 context => $RealDataSourceHandle, 140 read_cb => sub { $_[0]->get($_[1]) }, 141 write_cb => sub { $_[0]->set($_[1], $_[2]) }, 142 ); 143 144And then: 145 146 my $Value = $Cache->get($Key); 147 148 $Cache->set($Key, $NewValue); 149 150Will just work and will be read/written to the underlying data source as 151needed automatically. 152 153=head1 PERFORMANCE 154 155If you're storing relatively large and complex structures into 156the cache, then you're limited by the speed of the Storable module. 157If you're storing simple structures, or raw data, then 158Cache::FastMmap has noticeable performance improvements. 159 160See L<http://cpan.robm.fastmail.fm/cache_perf.html> for some 161comparisons to other modules. 162 163=head1 COMPATIBILITY 164 165Cache::FastMmap uses mmap to map a file as the shared cache space, 166and fcntl to do page locking. This means it should work on most 167UNIX like operating systems. 168 169Ash Berlin has written a Win32 layer using MapViewOfFile et al. to 170provide support for Win32 platform. 171 172=head1 MEMORY SIZE 173 174Because Cache::FastMmap mmap's a shared file into your processes memory 175space, this can make each process look quite large, even though it's just 176mmap'd memory that's shared between all processes that use the cache, 177and may even be swapped out if the cache is getting low usage. 178 179However, the OS will think your process is quite large, which might 180mean you hit some BSD::Resource or 'ulimits' you set previously that you 181thought were sane, but aren't anymore, so be aware. 182 183=head1 CACHE FILES AND OS ISSUES 184 185Because Cache::FastMmap uses an mmap'ed file, when you put values into 186the cache, you are actually "dirtying" pages in memory that belong to 187the cache file. Your OS will want to write those dirty pages back to 188the file on the actual physical disk, but the rate it does that at is 189very OS dependent. 190 191In Linux, you have some control over how the OS writes those pages 192back using a number of parameters in /proc/sys/vm 193 194 dirty_background_ratio 195 dirty_expire_centisecs 196 dirty_ratio 197 dirty_writeback_centisecs 198 199How you tune these depends heavily on your setup. 200 201As an interesting point, if you use a highmem linux kernel, a change 202between 2.6.16 and 2.6.20 made the kernel flush memory a LOT more. 203There's details in this kernel mailing list thread: 204L<http://www.uwsg.iu.edu/hypermail/linux/kernel/0711.3/0804.html> 205 206In most cases, people are not actually concerned about the persistence 207of data in the cache, and so are happy to disable writing of any cache 208data back to disk at all. Baically what they want is an in memory only 209shared cache. The best way to do that is to use a "tmpfs" filesystem 210and put all cache files on there. 211 212For instance, all our machines have a /tmpfs mount point that we 213create in /etc/fstab as: 214 215 none /tmpfs tmpfs defaults,noatime,size=1000M 0 0 216 217And we put all our cache files on there. The tmpfs filesystem is smart 218enough to only use memory as required by files actually on the tmpfs, 219so making it 1G in size doesn't actually use 1G of memory, it only uses 220as much as the cache files we put on it. In all cases, we ensure that 221we never run out of real memory, so the cache files effectively act 222just as named access points to shared memory. 223 224Some people have suggested using anonymous mmaped memory. Unfortunately 225we need a file descriptor to do the fcntl locking on, so we'd have 226to create a separate file on a filesystem somewhere anyway. It seems 227easier to just create an explicit "tmpfs" filesystem. 228 229=head1 PAGE SIZE AND KEY/VALUE LIMITS 230 231To reduce lock contention, Cache::FastMmap breaks up the file 232into pages. When you get/set a value, it hashes the key to get a page, 233then locks that page, and uses a hash table within the page to 234get/store the actual key/value pair. 235 236One consequence of this is that you cannot store values larger than 237a page in the cache at all. Attempting to store values larger than 238a page size will fail (the set() function will return false). 239 240Also keep in mind that each page has it's own hash table, and that we 241store the key and value data of each item. So if you are expecting to 242store large values and/or keys in the cache, you should use page sizes 243that are definitely larger than your largest key + value size + a few 244kbytes for the overhead. 245 246=head1 USAGE 247 248Because the cache uses shared memory through an mmap'd file, you have 249to make sure each process connects up to the file. There's probably 250two main ways to do this: 251 252=over 4 253 254=item * 255 256Create the cache in the parent process, and then when it forks, each 257child will inherit the same file descriptor, mmap'ed memory, etc and 258just work. This is the recommended way. (BEWARE: This only works under 259UNIX as Win32 has no concept of forking) 260 261=item * 262 263Explicitly connect up in each forked child to the share file. In this 264case, make sure the file already exists and the children connect with 265init_file => 0 to avoid deleting the cache contents and possible 266race corruption conditions. Also be careful that multiple children 267may race to create the file at the same time, each overwriting and 268corrupting content. Use a separate lock file if you must to ensure 269only one child creates the file. (This is the only possible way under 270Win32) 271 272=back 273 274The first way is usually the easiest. If you're using the cache in a 275Net::Server based module, you'll want to open the cache in the 276C<pre_loop_hook>, because that's executed before the fork, but after 277the process ownership has changed and any chroot has been done. 278 279In mod_perl, just open the cache at the global level in the appropriate 280module, which is executed as the server is starting and before it 281starts forking children, but you'll probably want to chmod or chown 282the file to the permissions of the apache process. 283 284=head1 RELIABILITY 285 286Cache::FastMmap is being used in an extensive number of systems at 287L<www.fastmail.com> and is regarded as extremely stable and reliable. 288Development has in general slowed because there are currently no 289known bugs and no additional needed features at this time. 290 291=head1 METHODS 292 293=over 4 294 295=cut 296 297# Modules/Export/XSLoader {{{ 298use 5.006; 299use strict; 300use warnings; 301use bytes; 302 303our $VERSION = '1.57'; 304 305require XSLoader; 306XSLoader::load('Cache::FastMmap', $VERSION); 307 308# Track currently live caches so we can cleanup in END {} 309# if we have empty_on_exit set 310our %LiveCaches; 311 312# Global time override for testing 313my $time_override; 314 315use constant FC_ISDIRTY => 1; 316 317use File::Spec; 318 319# }}} 320 321=item I<new(%Opts)> 322 323Create a new Cache::FastMmap object. 324 325Basic global parameters are: 326 327=over 4 328 329=item * B<share_file> 330 331File to mmap for sharing of data. 332default on unix: /tmp/sharefile-$pid-$time-$random 333default on windows: %TEMP%\sharefile-$pid-$time-$random 334 335=item * B<init_file> 336 337Clear any existing values and re-initialise file. Useful to do in a 338parent that forks off children to ensure that file is empty at the start 339(default: 0) 340 341B<Note:> This is quite important to do in the parent to ensure a 342consistent file structure. The shared file is not perfectly transaction 343safe, and so if a child is killed at the wrong instant, it might leave 344the cache file in an inconsistent state. 345 346=item * B<serializer> 347 348Use a serialization library to serialize perl data structures before 349storing in the cache. If not set, the raw value in the variable passed 350to set() is stored as a string. You must set this if you want to store 351anything other than basic scalar values. Supported values are: 352 353 '' for none 354 'storable' for 'Storable' 355 'sereal' for 'Sereal' 356 'json' for 'JSON' 357 [ $s, $d ] for custom serializer/de-serializer 358 359If this parameter has a value the module will attempt to load the 360associated package and then use the API of that package to serialize data 361before storing in the cache, and deserialize it upon retrieval from the 362cache. (default: 'storable') 363 364You can use a custom serializer/de-serializer by passing an array-ref 365with two values. The first should be a subroutine reference that takes 366the data to serialize as a single argument and returns an octet stream 367to store. The second should be a subroutine reference that takes the 368octet stream as a single argument and returns the original data structure. 369 370One thing to note, the data structure passed to the serializer is always 371a *scalar* reference to the original data passed in to the ->set(...) 372call. If your serializer doesn't support that, you might need to 373dereference it first before storing, but rembember to return a reference 374again in the de-serializer. 375 376(Note: Historically this module only supported a boolean value for the 377`raw_values` parameter and defaulted to 0, which meant it used Storable 378to serialze all values.) 379 380=item * B<raw_values> 381 382Deprecated. Use B<serializer> above 383 384=item * B<compressor> 385 386Compress the value (but not the key) before storing into the cache, using 387the compression package identified by the value of the parameter. Supported 388values are: 389 390 'zlib' for 'Compress::Zlib' 391 'lz4' for 'Compress::LZ4' 392 'snappy' for 'Compress::Snappy' 393 [ $c, $d ] for custom compressor/de-compressor 394 395If this parameter has a value the module will attempt to load the 396associated package and then use the API of that package to compress data 397before storing in the cache, and uncompress it upon retrieval from the 398cache. (default: undef) 399 400You can use a custom compressor/de-compressor by passing an array-ref 401with two values. The first should be a subroutine reference that takes 402the data to compress as a single octet stream argument and returns an 403octet stream to store. The second should be a subroutine reference that 404takes the compressed octet stream as a single argument and returns the 405original uncompressed data. 406 407(Note: Historically this module only supported a boolean value for the 408`compress` parameter and defaulted to use Compress::Zlib. The note for the 409old `compress` parameter stated: "Some initial testing shows that the 410uncompressing tends to be very fast, though the compressing can be quite 411slow, so it's probably best to use this option only if you know values in 412the cache are long-lived and have a high hit rate." 413 414Comparable test results for the other compression tools are not yet available; 415submission of benchmarks welcome. However, the documentation for the 'Snappy' 416library (http://google.github.io/snappy/) states: For instance, compared to 417the fastest mode of zlib, Snappy is an order of magnitude faster for most 418inputs, but the resulting compressed files are anywhere from 20% to 100% 419bigger. ) 420 421=item * B<compress> 422 423Deprecated. Please use B<compressor>, see above. 424 425=item * B<enable_stats> 426 427Enable some basic statistics capturing. When enabled, every read to 428the cache is counted, and every read to the cache that finds a value 429in the cache is also counted. You can then retrieve these values 430via the get_statistics() call. This causes every read action to 431do a write on a page, which can cause some more IO, so it's 432disabled by default. (default: 0) 433 434=item * B<expire_time> 435 436Maximum time to hold values in the cache in seconds. A value of 0 437means does no explicit expiry time, and values are expired only based 438on LRU usage. Can be expressed as 1m, 1h, 1d for minutes/hours/days 439respectively. (default: 0) 440 441=back 442 443You may specify the cache size as: 444 445=over 4 446 447=item * B<cache_size> 448 449Size of cache. Can be expresses as 1k, 1m for kilobytes or megabytes 450respectively. Automatically guesses page size/page count values. 451 452=back 453 454Or specify explicit page size/page count values. If none of these are 455specified, the values page_size = 64k and num_pages = 89 are used. 456 457=over 4 458 459=item * B<page_size> 460 461Size of each page. Must be a power of 2 between 4k and 1024k. If not, 462is rounded to the nearest value. 463 464=item * B<num_pages> 465 466Number of pages. Should be a prime number for best hashing 467 468=back 469 470The cache allows the use of callbacks for reading/writing data to an 471underlying data store. 472 473=over 4 474 475=item * B<context> 476 477Opaque reference passed as the first parameter to any callback function 478if specified 479 480=item * B<read_cb> 481 482Callback to read data from the underlying data store. Called as: 483 484 $read_cb->($context, $Key) 485 486Should return the value to use. This value will be saved in the cache 487for future retrievals. Return undef if there is no value for the 488given key 489 490=item * B<write_cb> 491 492Callback to write data to the underlying data store. 493Called as: 494 495 $write_cb->($context, $Key, $Value, $ExpiryTime) 496 497In 'write_through' mode, it's always called as soon as a I<set(...)> 498is called on the Cache::FastMmap class. In 'write_back' mode, it's 499called when a value is expunged from the cache if it's been changed 500by a I<set(...)> rather than read from the underlying store with the 501I<read_cb> above. 502 503Note: Expired items do result in the I<write_cb> being 504called if 'write_back' caching is enabled and the item has been 505changed. You can check the $ExpiryTime against C<time()> if you only 506want to write back values which aren't expired. 507 508Also remember that I<write_cb> may be called in a different process 509to the one that placed the data in the cache in the first place 510 511=item * B<delete_cb> 512 513Callback to delete data from the underlying data store. Called as: 514 515 $delete_cb->($context, $Key) 516 517Called as soon as I<remove(...)> is called on the Cache::FastMmap class 518 519=item * B<cache_not_found> 520 521If set to true, then if the I<read_cb> is called and it returns 522undef to say nothing was found, then that information is stored 523in the cache, so that next time a I<get(...)> is called on that 524key, undef is returned immediately rather than again calling 525the I<read_cb> 526 527=item * B<write_action> 528 529Either 'write_back' or 'write_through'. (default: write_through) 530 531=item * B<allow_recursive> 532 533If you're using a callback function, then normally the cache is not 534re-enterable, and attempting to call a get/set on the cache will 535cause an error. By setting this to one, the cache will unlock any 536pages before calling the callback. During the unlock time, other 537processes may change data in current cache page, causing possible 538unexpected effects. You shouldn't set this unless you know you 539want to be able to recall to the cache within a callback. 540(default: 0) 541 542=item * B<empty_on_exit> 543 544When you have 'write_back' mode enabled, then 545you really want to make sure all values from the cache are expunged 546when your program exits so any changes are written back. 547 548The trick is that we only want to do this in the parent process, 549we don't want any child processes to empty the cache when they exit. 550So if you set this, it takes the PID via $$, and only calls 551empty in the DESTROY method if $$ matches the pid we captured 552at the start. (default: 0) 553 554=item * B<unlink_on_exit> 555 556Unlink the share file when the cache is destroyed. 557 558As with empty_on_exit, this will only unlink the file if the 559DESTROY occurs in the same PID that the cache was created in 560so that any forked children don't unlink the file. 561 562This value defaults to 1 if the share_file specified does 563not already exist. If the share_file specified does already 564exist, it defaults to 0. 565 566=item * B<catch_deadlocks> 567 568Sets an alarm(10) before each page is locked via fcntl(F_SETLKW) to catch 569any deadlock. This used to be the default behaviour, but it's not really 570needed in the default case and could clobber sub-second Time::HiRes 571alarms setup by other code. Defaults to 0. 572 573=back 574 575=cut 576sub new { 577 my $Proto = shift; 578 my $Class = ref($Proto) || $Proto; 579 580 # If first item is a hash ref, use it as arguments 581 my %Args = ref($_[0]) eq 'HASH' ? %{shift()} : @_; 582 583 my $Self = {}; 584 bless ($Self, $Class); 585 586 # Work out cache file and whether to init 587 my $share_file = $Args{share_file}; 588 if (!$share_file) { 589 my $tmp_dir = File::Spec->tmpdir; 590 $share_file = File::Spec->catfile($tmp_dir, "sharefile"); 591 $share_file .= "-" . $$ . "-" . time . "-" . int(rand(100000)); 592 } 593 !ref($share_file) || die "share_file argument was a reference"; 594 $Self->{share_file} = $share_file; 595 my $permissions = $Args{permissions}; 596 597 my $init_file = $Args{init_file} ? 1 : 0; 598 my $test_file = $Args{test_file} ? 1 : 0; 599 my $enable_stats = $Args{enable_stats} ? 1 : 0; 600 my $catch_deadlocks = $Args{catch_deadlocks} ? 1 : 0; 601 602 # Worth out unlink default if not specified 603 if (!exists $Args{unlink_on_exit}) { 604 $Args{unlink_on_exit} = -f($share_file) ? 0 : 1; 605 } 606 607 # Serialise stored values? 608 my $serializer = $Args{serializer}; 609 $serializer = ($Args{raw_values} ? '' : 'storable') if !defined $serializer; 610 611 if ($serializer) { 612 if (ref $serializer eq 'ARRAY') { 613 $Self->{serialize} = $serializer->[0]; 614 $Self->{deserialize} = $serializer->[1]; 615 } elsif ($serializer eq 'storable') { 616 eval "require Storable;" 617 || die "Could not load serialization package: Storable : $@"; 618 $Self->{serialize} = Storable->can("freeze"); 619 $Self->{deserialize} = Storable->can("thaw"); 620 } elsif ($serializer eq 'sereal') { 621 eval "require Sereal::Encoder; require Sereal::Decoder;" 622 || die "Could not load serialization package: Sereal : $@"; 623 my $SerealEnc = Sereal::Encoder->new(); 624 my $SerealDec = Sereal::Decoder->new(); 625 $Self->{serialize} = sub { $SerealEnc->encode(@_); }; 626 $Self->{deserialize} = sub { $SerealDec->decode(@_); }; 627 } elsif ($serializer eq 'json') { 628 eval "require JSON;" 629 || die "Could not load serialization package: JSON : $@"; 630 my $JSON = JSON->new->utf8->allow_nonref; 631 $Self->{serialize} = sub { $JSON->encode(${$_[0]}); }; 632 $Self->{deserialize} = sub { \$JSON->decode($_[0]); }; 633 } else { 634 die "Unrecognized value >$serializer< for `serializer` parameter"; 635 } 636 } 637 638 # Compress stored values? 639 my $compressor = $Args{compressor}; 640 $compressor = ($Args{compress} ? 'zlib' : 0) if !defined $compressor; 641 642 my %known_compressors = ( 643 zlib => 'Compress::Zlib', 644 lz4 => 'Compress::LZ4', 645 snappy => 'Compress::Snappy', 646 ); 647 648 if ( $compressor ) { 649 if (ref $compressor eq 'ARRAY') { 650 $Self->{compress} = $compressor->[0]; 651 $Self->{uncompress} = $compressor->[1]; 652 } elsif (my $compressor_module = $known_compressors{$compressor}) { 653 eval "require $compressor_module;" 654 || die "Could not load compression package: $compressor_module : $@"; 655 656 # LZ4 and Snappy use same API 657 if ($compressor_module eq 'Compress::LZ4' || $compressor_module eq 'Compress::Snappy') { 658 $Self->{compress} = $compressor_module->can("compress"); 659 $Self->{uncompress} = $compressor_module->can("uncompress"); 660 } elsif ($compressor_module eq 'Compress::Zlib') { 661 $Self->{compress} = $compressor_module->can("memGzip"); 662 # (gunzip from tmp var: https://rt.cpan.org/Ticket/Display.html?id=72945) 663 my $uncompress = $compressor_module->can("memGunzip"); 664 $Self->{uncompress} = sub { &$uncompress(my $Tmp = shift) }; 665 } 666 } else { 667 die "Unrecognized value >$compressor< for `compressor` parameter"; 668 } 669 } 670 671 # If using empty_on_exit, need to track used caches 672 my $empty_on_exit = $Self->{empty_on_exit} = int($Args{empty_on_exit} || 0); 673 674 # Need Scalar::Util::weaken to track open caches 675 if ($empty_on_exit) { 676 eval "use Scalar::Util qw(weaken); 1;" 677 || die "Could not load Scalar::Util module: $@"; 678 } 679 680 # Work out expiry time in seconds 681 my $expire_time = $Self->{expire_time} = parse_expire_time($Args{expire_time}); 682 683 # Function rounds to the nearest power of 2 684 sub RoundPow2 { return int(2 ** int(log($_[0])/log(2)) + 0.1); } 685 686 # Work out cache size 687 my ($cache_size, $num_pages, $page_size); 688 689 my %Sizes = (k => 1024, m => 1024*1024); 690 if ($cache_size = $Args{cache_size}) { 691 $cache_size *= $Sizes{lc($1)} if $cache_size =~ s/([km])$//i; 692 693 if ($num_pages = $Args{num_pages}) { 694 $page_size = RoundPow2($cache_size / $num_pages); 695 $page_size = 4096 if $page_size < 4096; 696 697 } else { 698 $page_size = $Args{page_size} || 65536; 699 $page_size *= $Sizes{lc($1)} if $page_size =~ s/([km])$//i; 700 $page_size = 4096 if $page_size < 4096; 701 702 # Increase num_pages till we exceed 703 $num_pages = 89; 704 if ($num_pages * $page_size <= $cache_size) { 705 while ($num_pages * $page_size <= $cache_size) { 706 $num_pages = $num_pages * 2 + 1; 707 } 708 } else { 709 while ($num_pages * $page_size > $cache_size) { 710 $num_pages = int(($num_pages-1) / 2); 711 } 712 $num_pages = $num_pages * 2 + 1; 713 } 714 715 } 716 717 } else { 718 ($num_pages, $page_size) = @Args{qw(num_pages page_size)}; 719 $num_pages ||= 89; 720 $page_size ||= 65536; 721 $page_size *= $Sizes{lc($1)} if $page_size =~ s/([km])$//i; 722 $page_size = RoundPow2($page_size); 723 } 724 725 $cache_size = $num_pages * $page_size; 726 @$Self{qw(cache_size num_pages page_size)} 727 = ($cache_size, $num_pages, $page_size); 728 729 # Number of slots to start in each page 730 my $start_slots = int($Args{start_slots} || 0) || 89; 731 732 # Save read through/write back/write through details 733 my $write_back = ($Args{write_action} || 'write_through') eq 'write_back'; 734 @$Self{qw(context read_cb write_cb delete_cb)} 735 = @Args{qw(context read_cb write_cb delete_cb)}; 736 @$Self{qw(cache_not_found allow_recursive write_back)} 737 = (@Args{qw(cache_not_found allow_recursive)}, $write_back); 738 @$Self{qw(unlink_on_exit enable_stats)} 739 = (@Args{qw(unlink_on_exit)}, $enable_stats); 740 741 # Save pid 742 $Self->{pid} = $$; 743 744 # Initialise C cache code 745 my $Cache = fc_new(); 746 747 $Self->{Cache} = $Cache; 748 749 # Setup cache parameters 750 fc_set_param($Cache, 'init_file', $init_file); 751 fc_set_param($Cache, 'test_file', $test_file); 752 fc_set_param($Cache, 'page_size', $page_size); 753 fc_set_param($Cache, 'num_pages', $num_pages); 754 fc_set_param($Cache, 'expire_time', $expire_time); 755 fc_set_param($Cache, 'share_file', $share_file); 756 fc_set_param($Cache, 'permissions', $permissions) if defined $permissions; 757 fc_set_param($Cache, 'start_slots', $start_slots); 758 fc_set_param($Cache, 'catch_deadlocks', $catch_deadlocks); 759 fc_set_param($Cache, 'enable_stats', $enable_stats); 760 761 # And initialise it 762 fc_init($Cache); 763 764 # Track cache if need to empty on exit 765 weaken($LiveCaches{ref($Self)} = $Self) 766 if $empty_on_exit; 767 768 # All done, return PERL hash ref as class 769 return $Self; 770} 771 772=item I<get($Key, [ \%Options ])> 773 774Search cache for given Key. Returns undef if not found. If 775I<read_cb> specified and not found, calls the callback to try 776and find the value for the key, and if found (or 'cache_not_found' 777is set), stores it into the cache and returns the found value. 778 779I<%Options> is optional, and is used by get_and_set() to control 780the locking behaviour. For now, you should probably ignore it 781unless you read the code to understand how it works 782 783=cut 784sub get { 785 my ($Self, $Cache) = ($_[0], $_[0]->{Cache}); 786 787 # Hash value, lock page, read result 788 my ($HashPage, $HashSlot) = fc_hash($Cache, $_[1]); 789 my $Unlock = $Self->_lock_page($HashPage); 790 my ($Val, $Flags, $Found, $ExpireOn) = fc_read($Cache, $HashSlot, $_[1]); 791 792 # Value not found, check underlying data store 793 if (!$Found && (my $read_cb = $Self->{read_cb})) { 794 795 # Callback to read from underlying data store 796 # (unlock page first if we allow recursive calls 797 $Unlock = undef if $Self->{allow_recursive}; 798 $Val = eval { $read_cb->($Self->{context}, $_[1]); }; 799 my $Err = $@; 800 $Unlock = $Self->_lock_page($HashPage) if $Self->{allow_recursive}; 801 802 # Pass on any error 803 die $Err if $Err; 804 805 # If we found it, or want to cache not-found, store back into our cache 806 if (defined $Val || $Self->{cache_not_found}) { 807 808 # Are we doing writeback's? If so, need to mark as dirty in cache 809 my $write_back = $Self->{write_back}; 810 811 $Val = $Self->{serialize}(\$Val) if $Self->{serialize}; 812 $Val = $Self->{compress}($Val) if $Self->{compress}; 813 814 # Get key/value len (we've got 'use bytes'), and do expunge check to 815 # create space if needed 816 my $KVLen = length($_[1]) + (defined($Val) ? length($Val) : 0); 817 $Self->_expunge_page(2, 1, $KVLen); 818 819 fc_write($Cache, $HashSlot, $_[1], $Val, -1, 0); 820 } 821 } 822 823 # Unlock page and return any found value 824 # Unlock is done only if we're not in the middle of a get_set() operation. 825 my $SkipUnlock = $_[2] && $_[2]->{skip_unlock}; 826 $Unlock = undef unless $SkipUnlock; 827 828 # If not using raw values, use thaw() to turn data back into object 829 $Val = $Self->{uncompress}($Val) if defined($Val) && $Self->{compress}; 830 $Val = ${$Self->{deserialize}($Val)} if defined($Val) && $Self->{deserialize}; 831 832 # If explicitly asked to skip unlocking, we return the reference to the unlocker 833 return ($Val, $Unlock, { $Found ? (expire_on => $ExpireOn) : () }) if $SkipUnlock; 834 835 return $Val; 836} 837 838=item I<set($Key, $Value, [ \%Options ])> 839 840Store specified key/value pair into cache 841 842I<%Options> is optional. If it's not a hash reference, it's 843assumed to be an explicit expiry time for the key being set, 844this is to make set() compatible with the Cache::Cache interface 845 846If a hash is passed, the only useful entries right now are expire_on to 847set an explicit expiry time for this entry (epoch seconds), or expire_time 848to set an explicit relative future expiry time for this entry in 849seconds/minutes/days in the same format as passed to the new constructor. 850 851Some other options are used internally, such as by get_and_set() 852to control the locking behaviour. For now, you should probably ignore 853it unless you read the code to understand how it works 854 855This method returns true if the value was stored in the cache, 856false otherwise. See the PAGE SIZE AND KEY/VALUE LIMITS section 857for more details. 858 859=cut 860sub set { 861 my ($Self, $Cache) = ($_[0], $_[0]->{Cache}); 862 863 my $Val = $Self->{serialize} ? $Self->{serialize}(\$_[2]) : $_[2]; 864 $Val = $Self->{compress}($Val) if $Self->{compress}; 865 866 # Get opts, make compatible with Cache::Cache interface 867 my $Opts = defined($_[3]) ? (ref($_[3]) ? $_[3] : { expire_time => $_[3] }) : undef; 868 # expire_on takes precedence, otherwise use expire_time if present 869 my $expire_on = defined($Opts) ? ( 870 defined $Opts->{expire_on} ? $Opts->{expire_on} : 871 (defined $Opts->{expire_time} ? parse_expire_time($Opts->{expire_time}, _time()): -1) 872 ) : -1; 873 874 # Hash value, lock page 875 my ($HashPage, $HashSlot) = fc_hash($Cache, $_[1]); 876 877 # If skip_lock is passed, it's a *reference* to an existing lock we 878 # have to take and delete so we can cleanup below before calling 879 # the callback 880 my $Unlock = $Opts && $Opts->{skip_lock}; 881 if ($Unlock) { 882 ($Unlock, $$Unlock) = ($$Unlock, undef); 883 } else { 884 $Unlock = $Self->_lock_page($HashPage); 885 } 886 887 # Are we doing writeback's? If so, need to mark as dirty in cache 888 my $write_back = $Self->{write_back}; 889 890 # Get key/value len (we've got 'use bytes'), and do expunge check to 891 # create space if needed 892 my $KVLen = length($_[1]) + (defined($Val) ? length($Val) : 0); 893 $Self->_expunge_page(2, 1, $KVLen); 894 895 # Now store into cache 896 my $DidStore = fc_write($Cache, $HashSlot, $_[1], $Val, $expire_on, $write_back ? FC_ISDIRTY : 0); 897 898 # Unlock page 899 $Unlock = undef; 900 901 # If we're doing write-through, or write-back and didn't get into cache, 902 # write back to the underlying store 903 if ((!$write_back || !$DidStore) && (my $write_cb = $Self->{write_cb})) { 904 eval { $write_cb->($Self->{context}, $_[1], $_[2]); }; 905 } 906 907 return $DidStore; 908} 909 910=item I<get_and_set($Key, $AtomicSub)> 911 912Atomically retrieve and set the value of a Key. 913 914The page is locked while retrieving the $Key and is unlocked only after 915the value is set, thus guaranteeing the value does not change between 916the get and set operations. 917 918$AtomicSub is a reference to a subroutine that is called to calculate the 919new value to store. $AtomicSub gets $Key, the current value from the 920cache, and an options hash as paramaters. Currently the only option 921passed is the expire_on of the item. 922 923It should return the new value to set in the cache for the given $Key, 924and an optional hash of arguments in the same format as would be passed 925to a C<set()> call. 926 927If $AtomicSub returns an empty list, no value is stored back 928in the cache. This avoids updating the expiry time on an entry 929if you want to do a "get if in cache, store if not present" type 930callback. 931 932For example: 933 934=over 4 935 936=item * 937 938To atomically increment a value in the cache 939 940 $Cache->get_and_set($Key, sub { return $_[1]+1; }); 941 942=item * 943 944To add an item to a cached list and set the expiry time 945depending on the size of the list 946 947 $Cache->get_and_set($Key, sub ($, $v) { 948 push @$v, $item; 949 return ($v, { expire_time => @$v > 2 ? '10s' : '2m' }); 950 }); 951 952=item * 953 954To update a counter, but maintain the original expiry time 955 956 $Cache->get_and_set($Key, sub { 957 return ($_[1]+1, { expire_on => $_[2]->{expire_on} ); 958 }); 959 960 961=back 962 963In scalar context the return value from C<get_and_set()>, is the 964*new* value stored back into the cache. 965 966In list context, a two item array is returned; the new value stored 967back into the cache and a boolean that's true if the value was stored 968in the cache, false otherwise. See the PAGE SIZE AND KEY/VALUE LIMITS 969section for more details. 970 971Notes: 972 973=over 4 974 975=item * 976 977Do not perform any get/set operations from the callback sub, as these 978operations lock the page and you may end up with a dead lock! 979 980=item * 981 982If your sub does a die/throws an exception, the page will correctly 983be unlocked (1.15 onwards) 984 985=back 986 987=cut 988sub get_and_set { 989 my ($Self, $Cache) = ($_[0], $_[0]->{Cache}); 990 991 my ($Value, $Unlock, $Opts) = $Self->get($_[1], { skip_unlock => 1 }); 992 993 # If this throws an error, $Unlock ref will still unlock page 994 my @NewValue = $_[2]->($_[1], $Value, $Opts); 995 996 my $DidStore = 0; 997 if (@NewValue) { 998 ($Value, my $Opts) = @NewValue; 999 $DidStore = $Self->set($_[1], $Value, { skip_lock => \$Unlock, %{$Opts || {}} }); 1000 } 1001 1002 return wantarray ? ($Value, $DidStore) : $Value; 1003} 1004 1005=item I<remove($Key, [ \%Options ])> 1006 1007Delete the given key from the cache 1008 1009I<%Options> is optional, and is used by get_and_remove() to control 1010the locking behaviour. For now, you should probably ignore it 1011unless you read the code to understand how it works 1012 1013=cut 1014sub remove { 1015 my ($Self, $Cache) = ($_[0], $_[0]->{Cache}); 1016 1017 # Hash value, lock page, read result 1018 my ($HashPage, $HashSlot) = fc_hash($Cache, $_[1]); 1019 1020 # If skip_lock is passed, it's a *reference* to an existing lock we 1021 # have to take and delete so we can cleanup below before calling 1022 # the callback 1023 my $Unlock = $_[2] && $_[2]->{skip_lock}; 1024 if ($Unlock) { 1025 ($Unlock, $$Unlock) = ($$Unlock, undef); 1026 } else { 1027 $Unlock = $Self->_lock_page($HashPage); 1028 } 1029 1030 my ($DidDel, $Flags) = fc_delete($Cache, $HashSlot, $_[1]); 1031 $Unlock = undef; 1032 1033 # If we deleted from the cache, and it's not dirty, also delete 1034 # from underlying store 1035 if ((!$DidDel || ($DidDel && !($Flags & FC_ISDIRTY))) 1036 && (my $delete_cb = $Self->{delete_cb})) { 1037 eval { $delete_cb->($Self->{context}, $_[1]); }; 1038 } 1039 1040 return $DidDel; 1041} 1042 1043=item I<get_and_remove($Key)> 1044 1045Atomically retrieve value of a Key while removing it from the cache. 1046 1047The page is locked while retrieving the $Key and is unlocked only after 1048the value is removed, thus guaranteeing the value stored by someone else 1049isn't removed by us. 1050 1051=cut 1052sub get_and_remove { 1053 my ($Self, $Cache) = ($_[0], $_[0]->{Cache}); 1054 1055 my ($Value, $Unlock) = $Self->get($_[1], { skip_unlock => 1 }); 1056 my $DidDel = $Self->remove($_[1], { skip_lock => \$Unlock }); 1057 return wantarray ? ($Value, $DidDel) : $Value; 1058} 1059 1060=item I<expire($Key)> 1061 1062Explicitly expire the given $Key. For a cache in write-back mode, this 1063will cause the item to be written back to the underlying store if dirty, 1064otherwise it's the same as removing the item. 1065 1066=cut 1067sub expire { 1068 my ($Self, $Cache) = ($_[0], $_[0]->{Cache}); 1069 1070 # Hash value, lock page, read result 1071 my ($HashPage, $HashSlot) = fc_hash($Cache, $_[1]); 1072 my $Unlock = $Self->_lock_page($HashPage); 1073 my ($Val, $Flags, $Found) = fc_read($Cache, $HashSlot, $_[1]); 1074 1075 # If we found it, remove it 1076 if ($Found) { 1077 (undef, $Flags) = fc_delete($Cache, $HashSlot, $_[1]); 1078 } 1079 $Unlock = undef; 1080 1081 # If it's dirty, write it back 1082 if (($Flags & FC_ISDIRTY) && (my $write_cb = $Self->{write_cb})) { 1083 eval { $write_cb->($Self->{context}, $_[1], $Val); }; 1084 } 1085 1086 return $Found; 1087} 1088 1089=item I<clear()> 1090 1091Clear all items from the cache 1092 1093Note: If you're using callbacks, this has no effect 1094on items in the underlying data store. No delete 1095callbacks are made 1096 1097=cut 1098sub clear { 1099 my $Self = shift; 1100 $Self->_expunge_all(1, 0); 1101} 1102 1103=item I<purge()> 1104 1105Clear all expired items from the cache 1106 1107Note: If you're using callbacks, this has no effect 1108on items in the underlying data store. No delete 1109callbacks are made, and no write callbacks are made 1110for the expired data 1111 1112=cut 1113sub purge { 1114 my $Self = shift; 1115 $Self->_expunge_all(0, 0); 1116} 1117 1118=item I<empty($OnlyExpired)> 1119 1120Empty all items from the cache, or if $OnlyExpired is 1121true, only expired items. 1122 1123Note: If 'write_back' mode is enabled, any changed items 1124are written back to the underlying store. Expired items are 1125written back to the underlying store as well. 1126 1127=cut 1128sub empty { 1129 my $Self = shift; 1130 $Self->_expunge_all($_[0] ? 0 : 1, 1); 1131} 1132 1133=item I<get_keys($Mode)> 1134 1135Get a list of keys/values held in the cache. May immediately be out of 1136date because of the shared access nature of the cache 1137 1138If $Mode == 0, an array of keys is returned 1139 1140If $Mode == 1, then an array of hashrefs, with 'key', 1141'last_access', 'expire_on' and 'flags' keys is returned 1142 1143If $Mode == 2, then hashrefs also contain 'value' key 1144 1145=cut 1146sub get_keys { 1147 my ($Self, $Cache) = ($_[0], $_[0]->{Cache}); 1148 1149 my $Mode = $_[1] || 0; 1150 my ($Uncompress, $Deserialize) = @$Self{qw(uncompress deserialize)}; 1151 1152 return fc_get_keys($Cache, $Mode) 1153 if $Mode <= 1 || ($Mode == 2 && !$Uncompress && !$Deserialize); 1154 1155 # If we're getting values as well, and they're not raw, unfreeze them 1156 my @Details = fc_get_keys($Cache, 2); 1157 1158 for (@Details) { 1159 my $Val = $_->{value}; 1160 if (defined $Val) { 1161 $Val = $Uncompress->($Val) if $Uncompress; 1162 $Val = ${$Deserialize->($Val)} if $Deserialize; 1163 $_->{value} = $Val; 1164 } 1165 } 1166 return @Details; 1167} 1168 1169=item I<get_statistics($Clear)> 1170 1171Returns a two value list of (nreads, nreadhits). This 1172only works if you passed enable_stats in the constructor 1173 1174nreads is the total number of read attempts done on the 1175cache since it was created 1176 1177nreadhits is the total number of read attempts done on 1178the cache since it was created that found the key/value 1179in the cache 1180 1181If $Clear is true, the values are reset immediately after 1182they are retrieved 1183 1184=cut 1185sub get_statistics { 1186 my ($Self, $Cache) = ($_[0], $_[0]->{Cache}); 1187 my $Clear = $_[1]; 1188 1189 my ($NReads, $NReadHits) = (0, 0); 1190 for (0 .. $Self->{num_pages}-1) { 1191 my $Unlock = $Self->_lock_page($_); 1192 my ($PNReads, $PNReadHits) = fc_get_page_details($Cache); 1193 $NReads += $PNReads; 1194 $NReadHits += $PNReadHits; 1195 fc_reset_page_details($Cache) if $Clear; 1196 $Unlock = undef; 1197 } 1198 return ($NReads, $NReadHits); 1199} 1200 1201=item I<multi_get($PageKey, [ $Key1, $Key2, ... ])> 1202 1203The two multi_xxx routines act a bit differently to the 1204other routines. With the multi_get, you pass a separate 1205PageKey value and then multiple keys. The PageKey value 1206is hashed, and that page locked. Then that page is 1207searched for each key. It returns a hash ref of 1208Key => Value items found in that page in the cache. 1209 1210The main advantage of this is just a speed one, if you 1211happen to need to search for a lot of items on each call. 1212 1213For instance, say you have users and a bunch of pieces 1214of separate information for each user. On a particular 1215run, you need to retrieve a sub-set of that information 1216for a user. You could do lots of get() calls, or you 1217could use the 'username' as the page key, and just 1218use one multi_get() and multi_set() call instead. 1219 1220A couple of things to note: 1221 1222=over 4 1223 1224=item 1. 1225 1226This makes multi_get()/multi_set() and get()/set() 1227incompatible. Don't mix calls to the two, because 1228you won't find the data you're expecting 1229 1230=item 2. 1231 1232The writeback and callback modes of operation do 1233not work with multi_get()/multi_set(). Don't attempt 1234to use them together. 1235 1236=back 1237 1238=cut 1239sub multi_get { 1240 my ($Self, $Cache) = ($_[0], $_[0]->{Cache}); 1241 1242 # Hash value page key, lock page 1243 my ($HashPage, $HashSlot) = fc_hash($Cache, $_[1]); 1244 my $Unlock = $Self->_lock_page($HashPage); 1245 1246 # For each key to find 1247 my ($Keys, %KVs) = ($_[2]); 1248 for (@$Keys) { 1249 1250 # Hash key to get slot in this page and read 1251 my $FinalKey = "$_[1]-$_"; 1252 (undef, $HashSlot) = fc_hash($Cache, $FinalKey); 1253 my ($Val, $Flags, $Found, $ExpireOn) = fc_read($Cache, $HashSlot, $FinalKey); 1254 next unless $Found; 1255 1256 # If not using raw values, use thaw() to turn data back into object 1257 $Val = $Self->{uncompress}($Val) if defined($Val) && $Self->{compress}; 1258 $Val = ${$Self->{deserialize}($Val)} if defined($Val) && $Self->{deserialize}; 1259 1260 # Save to return 1261 $KVs{$_} = $Val; 1262 } 1263 1264 # Unlock page and return any found value 1265 $Unlock = undef; 1266 1267 return \%KVs; 1268} 1269 1270=item I<multi_set($PageKey, { $Key1 => $Value1, $Key2 => $Value2, ... }, [ \%Options ])> 1271 1272Store specified key/value pair into cache 1273 1274=cut 1275sub multi_set { 1276 my ($Self, $Cache) = ($_[0], $_[0]->{Cache}); 1277 1278 # Get opts, make compatible with Cache::Cache interface 1279 my $Opts = defined($_[3]) ? (ref($_[3]) ? $_[3] : { expire_time => $_[3] }) : undef; 1280 # expire_on takes precedence, otherwise use expire_time if present 1281 my $expire_on = defined($Opts) ? ( 1282 defined $Opts->{expire_on} ? $Opts->{expire_on} : 1283 (defined $Opts->{expire_time} ? parse_expire_time($Opts->{expire_time}, _time()): -1) 1284 ) : -1; 1285 1286 # Hash page key value, lock page 1287 my ($HashPage, $HashSlot) = fc_hash($Cache, $_[1]); 1288 my $Unlock = $Self->_lock_page($HashPage); 1289 1290 # Loop over each key/value storing into this page 1291 my $KVs = $_[2]; 1292 while (my ($Key, $Val) = each %$KVs) { 1293 1294 $Val = $Self->{serialize}(\$Val) if $Self->{serialize}; 1295 $Val = $Self->{compress}($Val) if $Self->{compress}; 1296 1297 # Get key/value len (we've got 'use bytes'), and do expunge check to 1298 # create space if needed 1299 my $FinalKey = "$_[1]-$Key"; 1300 my $KVLen = length($FinalKey) + length($Val); 1301 $Self->_expunge_page(2, 1, $KVLen); 1302 1303 # Now hash key and store into page 1304 (undef, $HashSlot) = fc_hash($Cache, $FinalKey); 1305 my $DidStore = fc_write($Cache, $HashSlot, $FinalKey, $Val, $expire_on, 0); 1306 } 1307 1308 # Unlock page 1309 $Unlock = undef; 1310 1311 return 1; 1312} 1313 1314=back 1315 1316=cut 1317 1318=head1 INTERNAL METHODS 1319 1320=over 4 1321 1322=cut 1323 1324=item I<_expunge_all($Mode, $WB)> 1325 1326Expunge all items from the cache 1327 1328Expunged items (that have not expired) are written 1329back to the underlying store if write_back is enabled 1330 1331=cut 1332sub _expunge_all { 1333 my ($Self, $Cache, $Mode, $WB) = ($_[0], $_[0]->{Cache}, $_[1], $_[2]); 1334 1335 # Repeat expunge for each page 1336 for (0 .. $Self->{num_pages}-1) { 1337 my $Unlock = $Self->_lock_page($_); 1338 $Self->_expunge_page($Mode, $WB, -1); 1339 $Unlock = undef; 1340 } 1341 1342} 1343 1344=item I<_expunge_page($Mode, $WB, $Len)> 1345 1346Expunge items from the current page to make space for 1347$Len bytes key/value items 1348 1349Expunged items (that have not expired) are written 1350back to the underlying store if write_back is enabled 1351 1352=cut 1353sub _expunge_page { 1354 my ($Self, $Cache, $Mode, $WB, $Len) = ($_[0], $_[0]->{Cache}, @_[1 .. 3]); 1355 1356 # If writeback mode, need to get expunged items to write back 1357 my $write_cb = $Self->{write_back} && $WB ? $Self->{write_cb} : undef; 1358 1359 my @WBItems = fc_expunge($Cache, $Mode, $write_cb ? 1 : 0, $Len); 1360 1361 my ($Uncompress, $Deserialize) = @$Self{qw(uncompress deserialize)}; 1362 1363 for (@WBItems) { 1364 next if !($_->{flags} & FC_ISDIRTY); 1365 1366 my $Val = $_->{value}; 1367 if (defined $Val) { 1368 $Val = $Uncompress->($Val) if $Uncompress; 1369 $Val = ${$Deserialize->($Val)} if $Deserialize; 1370 } 1371 eval { $write_cb->($Self->{context}, $_->{key}, $Val, $_->{expire_on}); }; 1372 } 1373} 1374 1375=item I<_lock_page($Page)> 1376 1377Lock a given page in the cache, and return an object 1378reference that when DESTROYed, unlocks the page 1379 1380=cut 1381sub _lock_page { 1382 my ($Self, $Cache) = ($_[0], $_[0]->{Cache}); 1383 my $Unlock = Cache::FastMmap::OnLeave->new(sub { 1384 fc_unlock($Cache) if fc_is_locked($Cache); 1385 }); 1386 fc_lock($Cache, $_[1]); 1387 return $Unlock; 1388} 1389 1390sub _time { 1391 $time_override ? $time_override : time; 1392} 1393 1394sub _set_time_override { 1395 my $Time = shift; 1396 $time_override = $Time; 1397 fc_set_time_override($Time || 0); 1398} 1399 1400my %Times = ('' => 1, s => 1, m => 60, h => 60*60, d => 24*60*60, w => 7*24*60*60); 1401 1402sub parse_expire_time { 1403 my $expire_time = shift || ''; 1404 return 0 if $expire_time eq 'never'; 1405 return @_ ? shift : 1 if $expire_time eq 'now'; 1406 my $offset = $expire_time =~ /^(\d+)\s*([mhdws]?)/i ? $1 * $Times{lc($2)} : 0; 1407 return $offset + (@_ ? shift : 0); 1408} 1409 1410sub cleanup { 1411 my ($Self, $Cache) = ($_[0], $_[0]->{Cache}); 1412 1413 # Avoid potential double cleanup 1414 return if $Self->{cleaned}; 1415 $Self->{cleaned} = 1; 1416 1417 # Expunge all entries on exit if requested and in parent process 1418 if ($Self->{empty_on_exit} && $Cache && $Self->{pid} == $$) { 1419 $Self->empty(); 1420 } 1421 1422 if ($Cache) { 1423 fc_close($Cache); 1424 $Cache = undef; 1425 delete $Self->{Cache}; 1426 } 1427 1428 unlink($Self->{share_file}) 1429 if $Self->{unlink_on_exit} && $Self->{pid} == $$; 1430 1431} 1432 1433sub DESTROY { 1434 my $Self = shift; 1435 $Self->cleanup(); 1436 delete $LiveCaches{ref($Self)} if $Self->{empty_on_exit}; 1437} 1438 1439sub END { 1440 while (my (undef, $Self) = each %LiveCaches) { 1441 # Weak reference, might be undef already 1442 $Self->cleanup() if $Self; 1443 } 1444 %LiveCaches = (); 1445} 1446 1447sub CLONE { 1448 die "Cache::FastMmap does not support threads sorry"; 1449} 1450 14511; 1452 1453package Cache::FastMmap::OnLeave; 1454use strict; 1455 1456sub new { 1457 my $Class = shift; 1458 my $Ref = \$_[0]; 1459 bless $Ref, $Class; 1460 return $Ref; 1461} 1462 1463sub disable { 1464 ${$_[0]} = undef; 1465} 1466 1467sub DESTROY { 1468 my $e = $@; # Save errors from code calling us 1469 eval { 1470 1471 my $Ref = shift; 1472 $$Ref->() if $$Ref; 1473 1474 }; 1475 # $e .= " (in cleanup) $@" if $@; 1476 $@ = $e; 1477} 1478 14791; 1480 1481__END__ 1482 1483=back 1484 1485=cut 1486 1487=head1 INCOMPATIBLE CHANGES 1488 1489=over 4 1490 1491=item * From 1.15 1492 1493=over 4 1494 1495=item * 1496 1497Default share_file name is no-longer /tmp/sharefile, but /tmp/sharefile-$pid-$time. 1498This ensures that different runs/processes don't interfere with each other, but 1499means you may not connect up to the file you expect. You should be choosing an 1500explicit name in most cases. 1501 1502On Unix systems, you can pass in the environment variable TMPDIR to 1503override the default directory of /tmp 1504 1505=item * 1506 1507The new option unlink_on_exit defaults to true if you pass a filename for the 1508share_file which doesn't already exist. This means if you have one process that 1509creates the file, and another that expects the file to be there, by default it 1510won't be. 1511 1512Otherwise the defaults seem sensible to cleanup unneeded share files rather than 1513leaving them around to accumulate. 1514 1515=back 1516 1517=item * From 1.29 1518 1519=over 4 1520 1521=item * 1522 1523Default share_file name is no longer /tmp/sharefile-$pid-$time 1524but /tmp/sharefile-$pid-$time-$random. 1525 1526=back 1527 1528=item * From 1.31 1529 1530=over 4 1531 1532=item * 1533 1534Before 1.31, if you were using raw_values => 0 mode, then the write_cb 1535would be called with raw frozen data, rather than the thawed object. 1536From 1.31 onwards, it correctly calls write_cb with the thawed object 1537value (eg what was passed to the ->set() call in the first place) 1538 1539=back 1540 1541=item * From 1.36 1542 1543=over 4 1544 1545=item * 1546 1547Before 1.36, an alarm(10) would be set before each attempt to lock 1548a page. The only purpose of this was to detect deadlocks, which 1549should only happen if the Cache::FastMmap code was buggy, or a 1550callback function in get_and_set() made another call into 1551Cache::FastMmap. 1552 1553However this added unnecessary extra system calls for every lookup, 1554and for users using Time::HiRes, it could clobber any existing 1555alarms that had been set with sub-second resolution. 1556 1557So this has now been made an optional feature via the catch_deadlocks 1558option passed to new. 1559 1560=back 1561 1562=item * From 1.52 1563 1564=over 4 1565 1566=item * 1567 1568The term expire_time was overloaded in the code to sometimes mean 1569a relative future time (e.g. as passed to new constructor) or an 1570absolute unix epoch (e.g. as returned from get_keys(2)). 1571 1572To avoid this confusion, the code now uses expire_time to always 1573means a relative future time, and expire_on to mean an absolute 1574epoch time. You can use either as an optional argument to a 1575set() call. 1576 1577Since expire_time was used in the constructor and is likely more 1578commonly used, I changed the result of get_keys(2) so it now 1579returns expire_on rather than expire_time. 1580 1581=back 1582 1583=back 1584 1585=cut 1586 1587=head1 SEE ALSO 1588 1589L<MLDBM::Sync>, L<IPC::MM>, L<Cache::FileCache>, L<Cache::SharedMemoryCache>, 1590L<DBI>, L<Cache::Mmap>, L<BerkeleyDB> 1591 1592Latest news/details can also be found at: 1593 1594L<http://cpan.robm.fastmail.fm/cachefastmmap/> 1595 1596Available on github at: 1597 1598L<https://github.com/robmueller/cache-fastmmap/> 1599 1600=cut 1601 1602=head1 AUTHOR 1603 1604Rob Mueller L<mailto:cpan@robm.fastmail.fm> 1605 1606=cut 1607 1608=head1 COPYRIGHT AND LICENSE 1609 1610Copyright (C) 2003-2017 by FastMail Pty Ltd 1611 1612This library is free software; you can redistribute it and/or modify 1613it under the same terms as Perl itself. 1614 1615=cut 1616 1617