File Coverage

blib/lib/Cache/Ref/Util/LRU/Array.pm
Criterion Covered Total %
statement 3 5 60.0
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 6 8 75.0


line stmt bran cond sub pod time code
1             package Cache::Ref::Util::LRU::Array;
2             BEGIN {
3 1     1   1707 $Cache::Ref::Util::LRU::Array::AUTHORITY = 'cpan:NUFFIN';
4             }
5             BEGIN {
6 1     1   17 $Cache::Ref::Util::LRU::Array::VERSION = '0.05'; # TRIAL
7             }
8 1     1   379 use Moose;
  0            
  0            
9              
10             use Scalar::Util qw(refaddr);
11             use Hash::Util::FieldHash::Compat qw(id);
12              
13             use namespace::autoclean;
14              
15             has _list => (
16             traits => [qw(Array)],
17             isa => "ArrayRef",
18             default => sub { [] },
19             is => "ro",
20             handles => {
21             #size => "length",
22             mru => [ get => 0 ],
23             lru => [ get => -1 ],
24             remove_mru => "shift",
25             remove_lru => "pop",
26             clear => "clear",
27             },
28             );
29              
30             with qw(Cache::Ref::Util::LRU::API);
31              
32             # since there's no need for metadata, insert is just like hit
33             sub insert {
34             my ( $self, @elements ) = @_;
35              
36             $self->hit(@elements);
37              
38             return ( @elements == 1 ? $elements[0] : @elements );
39             }
40              
41             sub _filter {
42             my ( $self, $l, $elements ) = @_;
43              
44             return () unless @$l;
45              
46             confess if grep { not defined } @$elements;
47             my %hash; @hash{map {id($_)} @$elements} = ();
48             grep { not exists $hash{id($_)} } @$l;
49             }
50              
51             sub hit {
52             my ( $self, @elements ) = @_;
53              
54             return unless @elements;
55              
56             my $l = $self->_list;
57             @$l = ( @elements, $self->_filter($l, \@elements) );
58              
59             return;
60             }
61              
62             sub remove {
63             my ( $self, @elements ) = @_;
64              
65             return unless @elements;
66              
67             my $l = $self->_list;
68             @$l = $self->_filter($l, \@elements);
69              
70             return;
71             }
72              
73             __PACKAGE__->meta->make_immutable;
74              
75             __PACKAGE__;
76              
77             # ex: set sw=4 et:
78              
79              
80             __END__
81             =pod
82              
83             =encoding utf-8
84              
85             =head1 NAME
86              
87             Cache::Ref::Util::LRU::Array
88              
89             =head1 AUTHOR
90              
91             Yuval Kogman
92              
93             =head1 COPYRIGHT AND LICENSE
94              
95             This software is copyright (c) 2011 by Yuval Kogman.
96              
97             This is free software; you can redistribute it and/or modify it under
98             the same terms as the Perl 5 programming language system itself.
99              
100             =cut
101