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