1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
;#
;# Copyright (c) 1996, Ikuo Nakagawa.
;# All rights reserved.
;#
;# $Id: log.pl,v 1.3 1997/05/22 08:38:38 ikuo Exp $
;#
;# log.pl - A simple implementation of logging mechanizm.
;#
package log;
;# prototypes
;# sub level($);
;# sub label($);
;# sub mask($);
;# sub puts(@);
;# sub putl(@);
;# definitions
$maskpri = &L_INFO;
$loglabel = '';
$foundnl = 1;
@logname = qw(EMERG ALART CRIT ERR WARNING NOTICE INFO DEBUG);
@loglevel{@logname} = (0..7);
;# logging level
sub L_EMERG { 0 }
sub L_ALART { 1 }
sub L_CRIT { 2 }
sub L_ERR { 3 }
sub L_WARNING { 4 }
sub L_NOTICE { 5 }
sub L_INFO { 6 }
sub L_DEBUG { 7 }
sub L_MASKPRI { $_[$[] & 7 }
;#
sub level {
my($pri) = @_;
return $pri if $pri =~ /^\d+$/;
$pri = uc($pri);
exists($loglevel{$pri}) ? $loglevel{$pri} : 8;
}
;# set logging label
sub label {
my($label) = @_;
my $old = $loglabel;
$loglabel = $label;
$old;
}
;# set logging mask
sub mask {
my($pri) = @_;
my $old = $maskpri;
$maskpri = &L_MASKPRI(&level($pri));
$old;
}
;# put strings - a simple logging routine
sub puts {
my($pri, @msg) = @_;
local($_);
$pri = &level($pri);
return 0 if $pri > $maskpri;
my $pre = "";
$pre .= "$loglabel " if $loglabel ne '';
$pre .= "$logname[$pri] " if $pri < &L_NOTICE;
for (split(/(\n)/, join('', @msg))) {
print $pre if $foundnl;
print $_;
$foundnl = $_ eq "\n";
}
1;
}
;# put lines - call puts
sub putl {
local($l, $_);
$l = shift;
grep(&puts($l, $_."\n"), @_);
}
;# success on this package
1;
|
