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.24";
4              
5 4     4   24 use strict;
  4         9  
  4         104  
6 4     4   21 use warnings;
  4         8  
  4         1940  
7              
8             sub new
9             {
10 11     11 0 20 my $class = shift;
11              
12 11         22 my $this = { };
13              
14 11         29 $this->{'hr'} = { };
15 11         27 $this->{'head'} = undef;
16 11         19 $this->{'tail'} = undef;
17 11         22 $this->{'ct'} = 0;
18              
19 11         22 bless $this, $class;
20              
21 11         52 return $this;
22             }
23              
24             sub find
25             {
26 62     62 0 141 my ($this, $k) = @_;
27              
28 62         147 my $data = $this->{'hr'}->{$k};
29              
30 62 100       155 if($data)
31             {
32 28         91 $this->_unlink($data->[0]);
33 28         90 $this->_head($data->[0]);
34 28         91 return $data->[1];
35             }
36              
37 34         103 return undef;
38             }
39              
40             sub put
41             {
42 34     34 0 92 my ($this, $k, $v) = @_;
43              
44 34         76 my $data = $this->{'hr'}->{$k};
45 34 50       83 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         94 my $node = [undef, undef, $k];
54 34         114 $this->_head($node);
55 34         139 $this->{'hr'}->{$k} = [$node, $v];
56             }
57              
58             sub _unlink
59             {
60 62     62   138 my ($this, $node) = @_;
61              
62 62 100       155 if($node->[0])
63             {
64 29         59 $node->[0]->[1] = $node->[1];
65             }
66             else
67             {
68 33         67 $this->{'head'} = $node->[1];
69             }
70              
71 62 100       179 if($node->[1])
72             {
73 13         32 $node->[1]->[0] = $node->[0];
74             }
75             else
76             {
77 49         93 $this->{'tail'} = $node->[0];
78             }
79              
80 62         138 --$this->{'ct'};
81             }
82              
83             sub _head
84             {
85 62     62   154 my ($this, $node) = @_;
86              
87 62         127 $node->[0] = undef;
88 62         115 $node->[1] = $this->{'head'};
89 62         119 $this->{'head'} = $node;
90 62 100       143 if($node->[1])
91             {
92 42         114 $node->[1]->[0] = $node;
93             }
94             else
95             {
96 20         37 $this->{'tail'} = $node;
97             }
98              
99 62         155 ++$this->{'ct'};
100             }
101              
102             sub purgenate
103             {
104 73     73 0 177 my ($this, $size) = @_;
105              
106 73         133 my @goners;
107 73         236 while($this->{'ct'} > $size)
108             {
109 34         103 my $node = $this->{'tail'};
110 34         109 $this->_unlink($node);
111 34         71 my $key = $node->[2];
112 34         96 my $data = delete $this->{'hr'}->{$key};
113 34         149 push @goners, $data->[1];
114             }
115              
116 73         368 return @goners;
117             }
118              
119             1;