For those curious about the current status of the Corinna OOP project for Perl , Paul Evans is working on it in the feature-class branch . Today I decided to see how much of my Cache::LRU example I could get working.
Under the full proposal, Cache::LRU looks like this (it’s unclear if the
:handles modifier will be implemented for the MVP):
class Cache::LRU {
use Hash::Ordered;
field $cache :handles(exists) { Hash::Ordered->new };
field $max_size :param :reader { 20 };
method set ( $key, $value ) {
if ( $cache->exists($key) ) {
$cache->delete($key);
}
elsif ( $cache->keys >= $max_size ) {
$cache->shift;
}
$cache->set( $key, $value ); # add to front
}
method get ($key) {
if ( $cache->exists($key) ) {
my $value = $cache->get($key);
$self->set( $key, $value ); # add to front
return $value;
}
return;
}
}
This is what I currently have working:
class Cache::LRU {
use Hash::Ordered;
# Delete arguments to constructor or else they'll cause a fatal
# error when new() is called. When :param is added, this will
# no longer be needed.
field $max_size; ADJUST { $max_size = delete($_[0]->{max_size}) // 20 }
field $cache; ADJUST { $cache = Hash::Ordered->new };
method max_size { $max_size }
method set( $key, $value ) {
if ( $cache->exists($key) ) {
$cache->delete($key);
}
elsif ( $self->num_elements >= $max_size ) {
$cache->shift;
}
$cache->set( $key, $value ); # add to front
}
method get($key) {
if ( $cache->exists($key) ) {
my $value = $cache->get($key);
$cache->set( $key, $value ); # add to front
return $value;
}
return;
}
method num_elements() {
return scalar $cache->keys;
}
method exists($key) {
return $cache->exists($key);
}
}
A few things to note:
- Default initializer blocks are not yet implemented
- All unprocessed arguments in the constructor are fatal (delete them)
- Everything else works quite nicely
And here are the tests for it:
my $cache = Cache::LRU->new;
is $cache->max_size, 20, 'Value of $max_size set by ADJUST';
is $cache->num_elements, 0, '... and our cache starts out empty';
ok !defined $cache->get('foo'),
'We should not be able to fetch values we have not defined';
ok !$cache->exists('foo'), '... and our exists() method should confirm this';
ok $cache->set( foo => 42 ), 'We should be able to set cache values';
ok $cache->exists('foo'),
'... and our exists() method should show the new key exists';
is $cache->get('foo'), 42, '... and get the value back';
is $cache->num_elements, 1, '... and we should have one element in our cache';
$cache = Cache::LRU->new( max_size => 2 );
is $cache->max_size, 2,
'We should be able to set the max_size with a constructor argument';
ok !defined $cache->get('foo'),
'We should not be able to fetch values we have not defined';
ok $cache->set( foo => 42 ), 'We should be able to set cache values';
is $cache->get('foo'), 42, '... and get the value back';
ok $cache->set( bar => 'asdf' ), 'We can set a different key';
is $cache->get('bar'), 'asdf', '... and get back a different value';
is $cache->get('foo'), 42, '... and get the value back';
is $cache->num_elements, $cache->max_size,
'... and we see that our cache is now full';
ok $cache->set( new_element => 3 ), 'We can set a new item in our cache';
is $cache->num_elements, $cache->max_size,
'... and we see that our cache is still full';
ok !$cache->exists('foo'),
'... and older elements in our cache should be ejected';
The tests revealed an “off by one” error in my original code (caches would
contain up to max_size + 1 elements), along with a syntax error (both now
fixed), but as it stands, I think everyone should be pleased with the progress
Paul is making. Exciting times for Perl!