File Coverage

blib/lib/App/RecordStream/LRUSheriff.pm
Criterion Covered Total %
statement 52 56 92.8
branch 9 10 90.0
condition n/a
subroutine 8 8 100.0
pod 0 4 0.0
total 69 78 88.4


line stmt bran cond sub pod time code
1             package App::RecordStream::LRUSheriff;
2              
3             our $VERSION = "4.0.23";
4              
5 4     4   24 use strict;
  4         7  
  4         93  
6 4     4   17 use warnings;
  4         8  
  4         1580  
7              
8             sub new
9             {
10 11     11 0 21 my $class = shift;
11              
12 11         24 my $this = { };
13              
14 11         24 $this->{'hr'} = { };
15 11         21 $this->{'head'} = undef;
16 11         19 $this->{'tail'} = undef;
17 11         19 $this->{'ct'} = 0;
18              
19 11         24 bless $this, $class;
20              
21 11         39 return $this;
22             }
23              
24             sub find
25             {
26 62     62 0 111 my ($this, $k) = @_;
27              
28 62         111 my $data = $this->{'hr'}->{$k};
29              
30 62 100       133 if($data)
31             {
32 28         79 $this->_unlink($data->[0]);
33 28         66 $this->_head($data->[0]);
34 28         61 return $data->[1];
35             }
36              
37 34         76 return undef;
38             }
39              
40             sub put
41             {
42 34     34 0 66 my ($this, $k, $v) = @_;
43              
44 34         62 my $data = $this->{'hr'}->{$k};
45 34 50       80 if($data)
46             {
47 0         0 $data->[1] = $v;
48 0         0 $this->_unlink($data->[0]);
49 0         0 $this->_head($data->[0]);
50 0         0 return;
51             }
52              
53 34         72 my $node = [undef, undef, $k];
54 34         92 $this->_head($node);
55 34         103 $this->{'hr'}->{$k} = [$node, $v];
56             }
57              
58             sub _unlink
59             {
60 62     62   96 my ($this, $node) = @_;
61              
62 62 100       119 if($node->[0])
63             {
64 29         52 $node->[0]->[1] = $node->[1];
65             }
66             else
67             {
68 33         57 $this->{'head'} = $node->[1];
69             }
70              
71 62 100       120 if($node->[1])
72             {
73 13         21 $node->[1]->[0] = $node->[0];
74             }
75             else
76             {
77 49         77 $this->{'tail'} = $node->[0];
78             }
79              
80 62         97 --$this->{'ct'};
81             }
82              
83             sub _head
84             {
85 62     62   104 my ($this, $node) = @_;
86              
87 62         110 $node->[0] = undef;
88 62         99 $node->[1] = $this->{'head'};
89 62         97 $this->{'head'} = $node;
90 62 100       119 if($node->[1])
91             {
92 42         69 $node->[1]->[0] = $node;
93             }
94             else
95             {
96 20         31 $this->{'tail'} = $node;
97             }
98              
99 62         96 ++$this->{'ct'};
100             }
101              
102             sub purgenate
103             {
104 73     73 0 137 my ($this, $size) = @_;
105              
106 73         104 my @goners;
107 73         204 while($this->{'ct'} > $size)
108             {
109 34         57 my $node = $this->{'tail'};
110 34         86 $this->_unlink($node);
111 34         57 my $key = $node->[2];
112 34         66 my $data = delete $this->{'hr'}->{$key};
113 34         102 push @goners, $data->[1];
114             }
115              
116 73         258 return @goners;
117             }
118              
119             1;