The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
Changes 03
MANIFEST 01
META.yml 11
README 03
lib/Cache/LRU.pm 112
t/00base.t 04
t/01destroy.t 038
7 files changed (This is a version diff) 262
@@ -1,5 +1,8 @@
 Revision history for Perl extension Cache::LRU
 
+0.04
+	- implement $cache->clear() (by mla)
+
 0.03
 	- fix a bug that reversed the order of LRU that might cause a infinite loop later on
 
@@ -16,3 +16,4 @@ MANIFEST			This list of files
 META.yml
 README
 t/00base.t
+t/01destroy.t
@@ -24,4 +24,4 @@ requires:
   perl: 5.8.1
 resources:
   license: http://dev.perl.org/licenses/
-version: 0.03
+version: 0.04
@@ -34,6 +34,9 @@ FUNCTIONS
     Removes data associated to the given key and returns the old value, if
     any.
 
+  $cache->clear($key)
+    Removes all entries from the cache.
+
 AUTHOR
     Kazuho Oku
 
@@ -7,7 +7,7 @@ use 5.008_001;
 
 use Scalar::Util qw();
 
-our $VERSION = '0.03';
+our $VERSION = '0.04';
 
 sub GC_FACTOR () { 10 }
 
@@ -64,6 +64,13 @@ sub get {
     $$value_ref;
 }
 
+sub clear {
+    my $self = shift;
+
+    $self->{_entries} = {};
+    $self->{_fifo} = [];    
+}
+
 sub _update_fifo {
     # precondition: $self->{_entries} should contain given key
     my ($self, $key, $value_ref) = @_;
@@ -126,6 +133,10 @@ Stores the given key-value pair.
 
 Removes data associated to the given key and returns the old value, if any.
 
+=head2 $cache->clear($key)
+
+Removes all entries from the cache.
+
 =head1 AUTHOR
 
 Kazuho Oku
@@ -50,4 +50,8 @@ is $cache->get('c'), 3;
 ok ! defined $cache->get('d');
 is $cache->get('e'), 6;
 
+$cache->clear;
+ok ! defined $cache->get('c');
+ok ! defined $cache->get('e');
+
 done_testing;
@@ -0,0 +1,38 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+BEGIN {
+    use_ok('Cache::LRU');
+};
+
+my $cache = Cache::LRU->new(
+    size => 3,
+);
+
+$cache->set(a => Foo->new());
+is $Foo::cnt, 1;
+$cache->set(a => 2);
+is $Foo::cnt, 0;
+
+$cache->set(b => Foo->new());
+is $Foo::cnt, 1;
+$cache->remove('b');
+is $Foo::cnt, 0;
+
+done_testing;
+
+package Foo;
+
+our $cnt = 0;
+
+sub new {
+    my $klass = shift;
+    $cnt++;
+    bless {}, $klass;
+}
+
+sub DESTROY {
+    --$cnt;
+}