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   822 use Moose;
  2         285576  
  2         8  
4              
5             # ABSTRACT: object to hold informations across log events
6             our $VERSION = '1.4'; # 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         35 $self->reset_data;
30 1         28 $self->reset_ring;
31 1         1 return;
32             }
33              
34             sub get {
35 5     5 0 19 my ( $self, $key ) = @_;
36 5         124 return( $self->data->{$key} );
37             }
38              
39             sub set {
40 10014     10014 0 24914 my ( $self, $key, $value ) = @_;
41              
42 10014 100       202252 if( defined $self->data->{$key} ) {
43 1         3 $self->remove( $key );
44             }
45              
46 10014         6619 push( @{$self->ring}, $key );
  10014         201241  
47 10014         201569 $self->data->{$key} = $value;
48              
49 10014         11000 $self->expire;
50              
51 10014         10280 return;
52             }
53              
54             sub remove {
55 2     2 0 4 my ( $self, $key ) = @_;
56              
57 2 50       49 if( ! defined $self->data->{$key} ) {
58 0         0 return;
59             }
60 2         43 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         5 for( my $i = 0 ; $i < scalar(@{$self->ring}) ; $i++ ) {
  10001         200945  
65 10001 100       199187 if( $self->ring->[$i] eq $key ) {
66 2         2 splice(@{$self->ring}, $i, 1);
  2         42  
67 2         4 last;
68             }
69             }
70              
71 2         3 return;
72             }
73              
74             sub is_full {
75 4     4 0 6 my $self = shift;
76 4 100       136 if( $self->size >= $self->max_entries ) {
77 2         7 return 1;
78             }
79 2         7 return 0;
80             }
81              
82             sub expire {
83 10014     10014 0 6444 my $self = shift;
84 10014 100       251135 if( $self->size <= $self->max_entries ) {
85 10005         7021 return;
86             }
87 9         227 my $num = $self->size - $self->max_entries;
88 9         14 foreach my $i ( 1..$num ) {
89 9         7 my $key = shift @{$self->ring};
  9         181  
90 9         177 delete $self->data->{$key};
91             }
92 9         7 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.4
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