File Coverage

blib/lib/Log/Saftpresse/Notes.pm
Criterion Covered Total %
statement 40 41 97.5
branch 9 10 90.0
condition n/a
subroutine 7 7 100.0
pod 0 6 0.0
total 56 64 87.5


line stmt bran cond sub pod time code
1             package Log::Saftpresse::Notes;
2              
3 2     2   1256 use Moose;
  2         371146  
  2         19  
4              
5             # ABSTRACT: object to hold informations across log events
6             our $VERSION = '1.6'; # VERSION
7              
8             has 'data' => ( is => 'rw', isa => 'HashRef', lazy => 1,
9             traits => [ 'Hash' ],
10             default => sub { {} },
11             handles => {
12             'reset_data' => 'clear',
13             },
14             );
15              
16             has 'ring' => ( is => 'rw', isa => 'ArrayRef', lazy => 1,
17             traits => [ 'Array' ],
18             default => sub { [] },
19             handles => {
20             'size' => 'count',
21             'reset_ring' => 'clear',
22             },
23             );
24              
25             has 'max_entries' => ( is => 'rw', isa => 'Int', default => 10000 );
26              
27             sub reset {
28 1     1 0 2 my $self = shift;
29 1         42 $self->reset_data;
30 1         41 $self->reset_ring;
31 1         2 return;
32             }
33              
34             sub get {
35 5     5 0 37 my ( $self, $key ) = @_;
36 5         206 return( $self->data->{$key} );
37             }
38              
39             sub set {
40 10014     10014 0 33200 my ( $self, $key, $value ) = @_;
41              
42 10014 100       261929 if( defined $self->data->{$key} ) {
43 1         6 $self->remove( $key );
44             }
45              
46 10014         8480 push( @{$self->ring}, $key );
  10014         259857  
47 10014         260019 $self->data->{$key} = $value;
48              
49 10014         14454 $self->expire;
50              
51 10014         13394 return;
52             }
53              
54             sub remove {
55 2     2 0 5 my ( $self, $key ) = @_;
56              
57 2 50       60 if( ! defined $self->data->{$key} ) {
58 0         0 return;
59             }
60 2         52 delete $self->data->{$key};
61              
62             # search the array for the key and remove it
63             # iterating may be slow, but remove should be rare
64 2         4 for( my $i = 0 ; $i < scalar(@{$self->ring}) ; $i++ ) {
  10001         266058  
65 10001 100       264516 if( $self->ring->[$i] eq $key ) {
66 2         2 splice(@{$self->ring}, $i, 1);
  2         55  
67 2         7 last;
68             }
69             }
70              
71 2         4 return;
72             }
73              
74             sub is_full {
75 4     4 0 8 my $self = shift;
76 4 100       183 if( $self->size >= $self->max_entries ) {
77 2         9 return 1;
78             }
79 2         8 return 0;
80             }
81              
82             sub expire {
83 10014     10014 0 8645 my $self = shift;
84 10014 100       325664 if( $self->size <= $self->max_entries ) {
85 10005         9903 return;
86             }
87 9         281 my $num = $self->size - $self->max_entries;
88 9         19 foreach my $i ( 1..$num ) {
89 9         10 my $key = shift @{$self->ring};
  9         245  
90 9         250 delete $self->data->{$key};
91             }
92 9         12 return;
93             }
94              
95             1;
96              
97             __END__
98              
99             =pod
100              
101             =encoding UTF-8
102              
103             =head1 NAME
104              
105             Log::Saftpresse::Notes - object to hold informations across log events
106              
107             =head1 VERSION
108              
109             version 1.6
110              
111             =head1 AUTHOR
112              
113             Markus Benning <ich@markusbenning.de>
114              
115             =head1 COPYRIGHT AND LICENSE
116              
117             This software is Copyright (c) 1998 by James S. Seymour, 2015 by Markus Benning.
118              
119             This is free software, licensed under:
120              
121             The GNU General Public License, Version 2, June 1991
122              
123             =cut