view release on metacpan or  search on metacpan

lib/Tie/Hash/Cache/MRU.pm  view on Meta::CPAN

package Tie::Hash::Cache::MRU;

use 5.006001;
use strict;
use warnings;


our $VERSION = '0.02';

sub CURRENT(){0};
sub OLD(){1};
sub TIME(){2}
sub SIZE(){3};
sub LIFE(){4};
sub HASH(){5};
# FETCH, STORE, EXISTS, DELETE, FIRSTKEY, NEXTKEY, CLEAR. DESTROY
sub S(){6};
sub F(){7};
sub D(){8};
sub E(){9};
sub C(){10};
sub FK(){11};
sub NK(){12};
sub DE(){13};

sub TIEHASH {

	my $pack = shift;
	my %arg = @_;

	no warnings;
	my @obj = ( {}, {}, {},
	 @arg{qw/SIZE LIFE HASH
	STORE FETCH DELETE EXISTS CLEAR FIRSTKEY NEXTKEY DESTROY/});

	defined $obj[LIFE] or delete $obj[TIME];
	$obj[F] ||= sub($){$obj[HASH]->{$_[0]}};
	$obj[S] ||= sub($$){$obj[HASH]->{$_[0]} = $_[1]};
	$obj[D] ||= sub($){delete $obj[HASH]->{$_[0]}};
	$obj[E] ||= sub($){exists $obj[HASH]->{$_[0]}};
	defined $obj[C] or $obj[C] = sub(){%{$obj[HASH]} = () };


	bless \@obj, $pack;

}

my $NOTEXIST;

sub FETCH { # obj, key

	if($_[0]->[LIFE]){

	   if(exists $_[0]->[TIME]->{$_[1]}
	      and 
	      (time() - $_[0]->[TIME]->{$_[1]}) > $_[0]->[LIFE] ){

	   	$_[0]->[CURRENT]->{$_[1]} =
		&{$_[0]->[E]}($_[1])?
		&{$_[0]->[F]}($_[1]):
		\$NOTEXIST;
	   };
	   $_[0]->[TIME]->{$_[1]} = time;
	};

	if (exists $_[0]->[CURRENT]->{$_[1]}){
	      $_[0]->[CURRENT]->{$_[1]} eq \$NOTEXIST
		and return undef;
	      return $_[0]->[CURRENT]->{$_[1]}
	};
	if (exists $_[0]->[OLD]->{$_[1]}){
	      $_[0]->[OLD]->{$_[1]} eq \$NOTEXIST
	       and $_[0]->[CURRENT]->{$_[1]} = \$NOTEXIST
		and return undef;
	      return 
		   $_[0]->[CURRENT]->{$_[1]} =
		   delete $_[0]->[OLD]->{$_[1]}
	};
	no warnings;
	if (%{$_[0]->[CURRENT]} > $_[0]->[SIZE]){
		if($_[0]->[LIFE]){
			delete @{$_[0]->[TIME]}{
			   grep { ! exist $_[0]->[CURRENT]->{$_} }
			      keys %{ $_[0]->[OLD] }