File Coverage

blib/lib/Log/Saftpresse/Counters.pm
Criterion Covered Total %
statement 32 56 57.1
branch 9 24 37.5
condition n/a
subroutine 6 9 66.6
pod 0 7 0.0
total 47 96 48.9


line stmt bran cond sub pod time code
1             package Log::Saftpresse::Counters;
2              
3 2     2   1215 use Moose;
  2         353374  
  2         27  
4              
5             # ABSTRACT: objects to hold and manipulate counters
6             our $VERSION = '1.6'; # VERSION
7              
8 2     2   15400 use Carp;
  2         4  
  2         1715  
9              
10             has 'counters' => (
11             is => 'ro', isa => 'HashRef', lazy => 1,
12             default => sub { {} },
13             );
14              
15             sub incr_one {
16 2     2 0 1471 my $self = shift;
17 2         5 return $self->incr(@_, 1);
18             }
19              
20             sub incr {
21 3     3 0 4 my $self = shift;
22 3         3 my $incr = pop;
23 3         4 my $key = pop;
24 3         108 my $cur_level = $self->counters;
25 3         7 while( my $cur_key = shift ) {
26 3 100       13 if( ! defined $cur_level->{ $cur_key }) {
    50          
27 1         2 $cur_level->{ $cur_key } = {};
28             } elsif( ref($cur_level->{$cur_key}) ne 'HASH' ) {
29 0         0 confess('counter sub element is not a hash!');
30             }
31 3         7 $cur_level = $cur_level->{ $cur_key };
32             }
33 3 100       5 if( ! defined $cur_level->{$key} ) {
34 1         3 $cur_level->{$key} = $incr;
35             } else {
36 2         4 $cur_level->{$key} += $incr;
37             }
38 3         5 return( $cur_level->{$key} );
39             }
40              
41             sub incr_max {
42 0     0 0 0 my $self = shift;
43 0         0 my $max = pop;
44 0         0 my $key = pop;
45 0         0 my $cur_level = $self->counters;
46 0         0 while( my $cur_key = shift ) {
47 0 0       0 if( ! defined $cur_level->{ $cur_key }) {
    0          
48 0         0 $cur_level->{ $cur_key } = {};
49             } elsif( ref($cur_level->{$cur_key}) ne 'HASH' ) {
50 0         0 die('counter sub element is not a hash!');
51             }
52 0         0 $cur_level = $cur_level->{ $cur_key };
53             }
54 0 0       0 if( ! defined $cur_level->{$key} ) {
    0          
55 0         0 $cur_level->{$key} = $max;
56             } elsif( $max > $cur_level->{$key} ) {
57 0         0 $cur_level->{$key} = $max;
58             }
59 0         0 return( $cur_level->{$key} );
60             }
61              
62             sub get_value {
63 3     3 0 4 my $self = shift;
64 3         8 my $value = $self->get_node( @_ );
65             # if the element is a reference and not a value
66 3 100       9 if( ref($value) ) {
67 1         4 return;
68             }
69 2         10 return( $value );
70             }
71             *get = \&get_value;
72              
73             sub get_key_count {
74 0     0 0 0 my $self = shift;
75 0 0       0 if( my $node = $self->get_node(@_) ) {
76 0         0 return( scalar keys %$node );
77             }
78 0         0 return 0;
79             }
80              
81             sub get_value_or_zero {
82 0     0 0 0 my $self = shift;
83 0 0       0 if( my $value = $self->get_value(@_) ) {
84 0         0 return( $value );
85             }
86 0         0 return 0;
87             }
88              
89             sub get_node {
90 5     5 0 5 my $self = shift;
91 5         7 my $key = pop;
92 5         176 my $cur_level = $self->counters;
93 5         13 while( my $cur_key = shift ) {
94 3 50       14 if( ! defined $cur_level->{ $cur_key } ) {
    50          
95 0         0 return;
96             } elsif( ref($cur_level->{$cur_key}) ne 'HASH' ) {
97 0         0 return;
98             }
99 3         7 $cur_level = $cur_level->{ $cur_key };
100             }
101 5         13 return( $cur_level->{$key} );
102             }
103              
104             1;
105              
106             __END__
107              
108             =pod
109              
110             =encoding UTF-8
111              
112             =head1 NAME
113              
114             Log::Saftpresse::Counters - objects to hold and manipulate counters
115              
116             =head1 VERSION
117              
118             version 1.6
119              
120             =head1 AUTHOR
121              
122             Markus Benning <ich@markusbenning.de>
123              
124             =head1 COPYRIGHT AND LICENSE
125              
126             This software is Copyright (c) 1998 by James S. Seymour, 2015 by Markus Benning.
127              
128             This is free software, licensed under:
129              
130             The GNU General Public License, Version 2, June 1991
131              
132             =cut