File Coverage

File:blib/lib/Log/Simple.pm
Coverage:94.9%

linestmtbrancondsubpodtimecode
1package Log::Simple;
2
12
12
416790
56
use 5.007;
3
12
12
12
76
19
456
use strict;
4
12
12
12
76
36
608
use warnings;
5
6
12
12
12
74
15
1350
use Carp qw(croak);
7
12
12
12
6054
120858
116
use POSIX qw(strftime);
8
12
12
12
28829
22919
86
use Time::HiRes qw(time);
9
10our $VERSION = '0.05';
11
12BEGIN {
13
14    sub _sub_names {
15
183
831
        my @levels = qw(
16            emergency alert critical
17            error warning notice info debug
18        );
19
183
404
        my @short = qw(emerg crit err warn);
20
183
613
        my @nums = qw(_0 _1 _2 _3 _4 _5 _6 _7);
21
22
183
186
        my @all;
23
183
1392
        push @all, @levels, @short, @nums;
24
25
183
723
        return \@all;
26    }
27
28
12
57
    my $sub_names = _sub_names();
29
30    {
31
12
12
12
12
5690
23
3849
22
        no strict 'refs';
32
33
12
38
        for (@$sub_names) {
34
240
340
            my $sub = $_;
35
36            *$_ = sub {
37
166
8171
                my ($self, $msg) = @_;
38
39
166
924
                $self->level($ENV{LS_LEVEL}) if defined $ENV{LS_LEVEL};
40
41
166
669
                if ($sub =~ /^_(\d)$/){
42
52
158
                    return if $1 > $self->level;
43                }
44
163
440
                return if $self->_level_value($sub) > $self->level;
45
46
159
2040
                my $proc = join '|', (caller(0))[1..2];
47
48
159
863
                my %log_entry = (
49                    label => $sub,
50                    proc => $proc,
51                    msg => $msg,
52                );
53
54
159
642
                $self->_generate_entry(%log_entry);
55            }
56
240
31565
        }
57    }
58}
59sub new {
60
56
0
1721584
    my ($class, %args) = @_;
61
62
56
220
    my $self = bless {}, $class;
63
64
56
270
    if (defined $args{level}) {
65
18
66
        $self->level($args{level});
66    }
67    else {
68
38
188
        my $lvl = defined $ENV{LS_LEVEL} ? $ENV{LS_LEVEL} : 4;
69
38
160
        $self->level($lvl);
70    }
71
72
56
205
    if ($args{file}){
73
5
31
        $self->file($args{file}, $args{write_mode});
74    }
75
76
56
193
    my $print = defined $args{print} ? $args{print} : 1;
77
56
244
    $self->print($print);
78
79
56
206
    $self->display(
80            time  => 1,
81            label => 1,
82            name  => 1,
83            pid   => 0,
84            proc  => 0,
85    );
86
87
56
180
    if (defined $args{display}){
88
4
17
        $self->display($args{display});
89    }
90
91
56
295
    $self->name($args{name});
92
93
56
263
    return $self;
94}
95sub level {
96
475
1
1120
    my ($self, $level) = @_;
97
98
475
1061
    my %levels = $self->levels;
99
475
3068
    my %rev = reverse %levels;
100
101
475
1895
    $self->{level} = $ENV{LS_LEVEL} if defined $ENV{LS_LEVEL};
102
475
515
    my $lvl;
103
104
475
1036
    if (defined $level) {
105
238
2190
        if ($level =~ /^\d$/ && defined $levels{$level}){
106
229
607
            $self->{level} = $level;
107        }
108        elsif ($level =~ /^\w{3}/ && defined($lvl = $self->_translate($level))){
109
8
23
            $self->{level} = $lvl;
110        }
111        else {
112
1
21
            CORE::warn
113                "invalid level $level specified, using default 'warning'/4\n";
114        }
115    }
116
475
2952
    return $self->{level};
117}
118sub file {
119
27
1
5667
    my ($self, $file, $mode) = @_;
120
121
27
100
    if (! defined $file){
122
1
5
        return $self->{file};
123    }
124
26
132
    if ($file =~ /^0$/){
125
7
131
        if (tell($self->{fh}) != -1) {
126
7
380
            close $self->{fh};
127        }
128
7
22
        delete $self->{file};
129
7
38
        delete $self->{fh};
130
7
23
        return;
131    }
132
19
184
    if (defined $file && $self->{file} && $file ne $self->{file}){
133
8
668
        close $self->{fh};
134    }
135
19
78
    $mode = 'w' if ! defined $mode;
136
19
107
    my $op = $mode =~ /^a/ ? '>>' : '>';
137
138
19
2496
    open $self->{fh}, $op, $file or die "can't open log file for writing: $!";
139
19
78
    $self->{file} = $file;
140
141
19
87
    return $self->{file};
142}
143sub name {
144
345
0
582
    my ($self, $name) = @_;
145
345
767
    $self->{name} = $name if defined $name;
146
345
1314
    return $self->{name};
147}
148sub timestamp {
149
79
0
283
        my $t = time;
150
79
3729
    my $date = strftime "%Y-%m-%d %H:%M:%S", localtime $t;
151
79
803
    $date .= sprintf ".%03d", ($t-int($t))*1000; # without rounding
152
79
329
    return $date;
153}
154sub levels {
155
731
0
6012
    my ($self, $want) = @_;
156
157
731
4071
    my %levels = (
158        0 => 'emergency',
159        1 => 'alert',
160        2 => 'critical',
161        3 => 'error',
162        4 => 'warning',
163        5 => 'notice',
164        6 => 'info',
165        7 => 'debug',
166    );
167
168
731
2211
    if (defined $want && $want eq 'names'){
169
1
3
        my @level_list;
170
1
4
        for (0..7){
171
8
15
            push @level_list, $levels{$_};
172        }
173
1
9
        return @level_list;
174    }
175
176
730
5805
    return %levels;
177}
178sub display {
179
900
0
5477
    my $self = shift;
180
900
882
    my ($tag, %tags);
181
182
900
1785
    if (@_ == 1){
183
832
1067
        $tag = shift;
184    }
185    else {
186
68
312
        %tags = @_;
187    }
188
189
900
1994
    if (defined $tag){
190
832
1934
        if ($tag =~ /^0$/){
191
5
5
9
31
            for (keys %{ $self->{display} }){
192
25
41
                $self->{display}{$_} = 0;
193            }
194
5
62
            return 0;
195        }
196
827
1520
        if ($tag =~ /^1$/){
197
4
4
8
25
            for (keys %{ $self->{display} }){
198
20
32
                $self->{display}{$_} = 1;
199            }
200
4
20
            return 1;
201        }
202
203
823
4236
        return $self->{display}{$tag};
204    }
205
206
68
395
    my %valid = (
207        name => 0,
208        time => 0,
209        label => 0,
210        pid => 0,
211        proc => 0,
212    );
213
214
68
293
    for (keys %tags) {
215
291
602
        if (! defined $valid{$_}){
216
1
28
            CORE::warn "$_ is an invalid tag...skipping\n";
217
1
9
            next;
218        }
219
290
616
        $self->{display}{$_} = $tags{$_};
220    }
221
222
223
68
68
123
311
    return %{ $self->{display} };
224}
225sub print {
226
225
0
1502
    $_[0]->{print} = $_[1] if defined $_[1];
227
225
1421
    return $_[0]->{print};
228}
229sub child {
230
24
0
209
    my ($self, $name) = @_;
231
24
240
    my $child = bless { %$self }, ref $self;
232
24
64
    $child->name($self->name .".$name");
233
24
62
    return $child;
234}
235sub _level_value {
236
283
64283
    my ($self, $level) = @_;
237
238
283
1069
    if ($level =~ /^_(\d)$/){
239
97
536
        return $1;
240    }
241    else {
242
186
472
        return $self->_translate($level);
243    }
244}
245sub _translate {
246
252
3758
    my ($self, $label) = @_;
247
248
252
589
    my %levels = $self->levels;
249
250
252
1321
    if ($label =~ /^_?(\d)$/){
251
57
317
        return $levels{$1};
252    }
253    else {
254
195
1304
        my %rev = reverse %levels;
255
195
5627
        my ($lvl) = grep /^$label/, keys %rev;
256
195
1546
        return $rev{$lvl};
257    }
258}
259sub _generate_entry {
260
164
283
    my $self = shift;
261
164
430
    my %entry = @_;
262
263
164
340
    my $label = $entry{label};
264
164
235
    my $proc = $entry{proc};
265
164
296
    my $msg = $entry{msg};
266
267
164
520
    my $subs = $self->_sub_names;
268
164
3280
342
4914
    if (! grep { $label eq $_ } @$subs){
269
1
288
        croak "_generate_entry() requires a sub/label name as its first param\n";
270    }
271
272
163
609
    if ($label =~ /^_(\d)$/){
273
49
158
        $label = $self->_translate($1);
274    }
275
276
163
522
    $msg = $msg ? "$msg\n" : "\n";
277
278
163
168
    my $log_entry;
279
163
411
    $log_entry .= "[".$self->timestamp()."]" if $self->display('time');
280
163
439
    $log_entry .= "[$label]" if $self->display('label');
281
163
397
    $log_entry .= "[".$self->name."]" if $self->display('name') && $self->name;
282
163
341
    $log_entry .= "[$$]" if $self->display('pid');
283
163
360
    $log_entry .= "[$proc]" if $self->display('proc');
284
163
462
    $log_entry .= " " if $log_entry;
285
163
237
    $log_entry .= $msg;
286
287
163
423
    return $log_entry if ! $self->print;
288
289
46
105
    if ($self->{fh}){
290
45
45
46
515
        print { $self->{fh} } $log_entry;
291    }
292    else {
293
1
9
        print $log_entry;
294    }
295}
296
2971;