File Coverage

blib/lib/Metabrik/Log/Syslog.pm
Criterion Covered Total %
statement 9 98 9.1
branch 0 50 0.0
condition 0 20 0.0
subroutine 3 15 20.0
pod 11 12 91.6
total 23 195 11.7


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # log::syslog Brik
5             #
6             package Metabrik::Log::Syslog;
7 1     1   733 use strict;
  1         2  
  1         29  
8 1     1   5 use warnings;
  1         2  
  1         27  
9              
10 1     1   4 use base qw(Metabrik::Core::Log);
  1         12  
  1         1522  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             level => [ qw(0|1|2|3) ],
20             host => [ qw(syslog_host) ],
21             port => [ qw(syslog_port) ],
22             time_prefix => [ qw(0|1) ],
23             text_prefix => [ qw(0|1) ],
24             facility => [ qw(kernel|user|mail|system|security|internal|printer|news|uucp|clock|security2|FTP|NTP|audit|alert|clock2|local0|local1|local2|local3|local4|local5|local6|local7) ],
25             name => [ qw(program) ],
26             do_rfc3164 => [ qw(0|1) ],
27             _fd => [ qw(INTERNAL) ],
28             },
29             attributes_default => {
30             level => 2,
31             time_prefix => 0,
32             text_prefix => 1,
33             host => '127.0.0.1',
34             port => 514,
35             facility => 'local5',
36             name => 'metabrik',
37             do_rfc3164 => 0,
38             },
39             commands => {
40             send => [ qw(message priority) ],
41             message => [ qw(string caller|OPTIONAL) ],
42             info => [ qw(string caller|OPTIONAL) ],
43             verbose => [ qw(string caller|OPTIONAL) ],
44             warning => [ qw(string caller|OPTIONAL) ],
45             error => [ qw(string caller|OPTIONAL) ],
46             fatal => [ qw(string caller|OPTIONAL) ],
47             debug => [ qw(string caller|OPTIONAL) ],
48             },
49             require_modules => {
50             'Net::Syslog' => [ ],
51             },
52             };
53             }
54              
55             sub brik_use_properties {
56 0     0 1   my $self = shift;
57              
58             return {
59 0           attributes_default => {
60             debug => $self->log->debug,
61             level => $self->log->level,
62             },
63             };
64             }
65              
66             sub brik_init {
67 0     0 1   my $self = shift;
68              
69 0           my $fd = Net::Syslog->new;
70 0 0         if (! defined($fd)) {
71 0           return $self->log->error("brik_init: failed to initialize Net::Syslog");
72             }
73              
74 0           $self->_fd($fd);
75              
76 0           return $self->SUPER::brik_init;
77             }
78              
79             sub message {
80 0     0 1   my $self = shift;
81 0           my ($text, $caller) = @_;
82              
83 0   0       $text ||= 'undef';
84              
85             # Convert to a string of key="value" pairs
86 0 0         if (ref($text) eq 'HASH') {
87 0           my $kv = '';
88 0           for my $k (sort { $a cmp $b } keys %$text) {
  0            
89 0 0         if ($k !~ m{\s}) { # If there is no space char, we don't put between double quotes
90 0           $kv .= "$k=\"".$text->{$k}."\" ";
91             }
92             else {
93 0           $kv .= "\"$k\"=\"".$text->{$k}."\" ";
94             }
95             }
96 0           $kv =~ s{\s*$}{};
97 0           $text = $kv;
98             }
99              
100 0           my $message = '';
101 0 0         if (defined($caller)) {
102 0           $caller =~ s/^metabrik:://i;
103 0           $caller = lc($caller);
104 0           $message .= lc($caller).': ';
105             }
106              
107 0           return $message."$text\n";
108             }
109              
110             sub send {
111 0     0 0   my $self = shift;
112 0           my ($msg, $priority) = @_;
113              
114 0 0         $self->brik_help_run_undef_arg('send', $msg) or return;
115 0 0         $self->brik_help_run_undef_arg('send', $priority) or return;
116              
117 0           my $fd = $self->_fd; # Must have been inited or Brik has already failed
118 0           my $host = $self->host;
119 0           my $port = $self->port;
120 0           my $name = $self->name;
121 0           my $facility = $self->facility;
122 0           my $rfc3164 = $self->do_rfc3164;
123              
124             # Priorities can be:
125             # emergency, alert, critical, error, warning, notice, informational, debug
126              
127 0           my $r = $fd->send(
128             $msg,
129             Name => $name,
130             Facility => $facility,
131             Priority => $priority,
132             SyslogHost => $host,
133             SyslogPort => $port,
134             rfc3164 => $rfc3164,
135             );
136 0 0         if (! defined($r)) {
137 0           return $self->log->error("send: unable to send message to [$host]:$port");
138             }
139              
140 0           return 1;
141             }
142              
143             sub warning {
144 0     0 1   my $self = shift;
145 0           my ($msg, $caller) = @_;
146              
147 0 0         my $prefix = $self->text_prefix ? 'WARN ' : '[!]';
148 0 0         my $time = $self->time_prefix ? localtime().' ' : '';
149 0   0       my $buffer = $time."$prefix ".$self->message($msg, ($caller) ||= caller());
150              
151 0           return $self->send($buffer, 'warning');
152             }
153              
154             sub error {
155 0     0 1   my $self = shift;
156 0           my ($msg, $caller) = @_;
157              
158 0 0         my $prefix = $self->text_prefix ? 'ERROR' : '[-]';
159 0 0         my $time = $self->time_prefix ? localtime().' ' : '';
160 0   0       my $buffer = $time."$prefix ".$self->message($msg, ($caller) ||= caller());
161              
162 0           return $self->send($buffer, 'error');
163             }
164              
165             sub fatal {
166 0     0 1   my $self = shift;
167 0           my ($msg, $caller) = @_;
168              
169 0 0         my $prefix = $self->text_prefix ? 'FATAL' : '[F]';
170 0 0         my $time = $self->time_prefix ? localtime().' ' : '';
171 0   0       my $buffer = $time."$prefix ".$self->message($msg, ($caller) ||= caller());
172              
173 0           $self->send($buffer, 'critical');
174              
175 0           die($buffer);
176             }
177              
178             sub info {
179 0     0 1   my $self = shift;
180 0           my ($msg, $caller) = @_;
181              
182 0 0         return 1 unless $self->level > 0;
183              
184 0 0         my $prefix = $self->text_prefix ? 'INFO ' : '[+]';
185 0 0         my $time = $self->time_prefix ? localtime().' ' : '';
186 0   0       my $buffer = $time."$prefix ".$self->message($msg, ($caller) ||= caller());
187              
188 0           return $self->send($buffer, 'informational');
189             }
190              
191             sub verbose {
192 0     0 1   my $self = shift;
193 0           my ($msg, $caller) = @_;
194              
195 0 0         return 1 unless $self->level > 1;
196              
197 0 0         my $prefix = $self->text_prefix ? 'VERB ' : '[*]';
198 0 0         my $time = $self->time_prefix ? localtime().' ' : '';
199 0   0       my $buffer = $time."$prefix ".$self->message($msg, ($caller) ||= caller());
200              
201 0           return $self->send($buffer, 'notice');
202             }
203              
204             sub debug {
205 0     0 1   my $self = shift;
206 0           my ($msg, $caller) = @_;
207              
208             # We have a conflict between the method and the accessor,
209             # we have to identify which one is accessed.
210              
211             # If no message defined, we want to access the Attribute
212 0 0         if (! defined($msg)) {
213 0           return $self->{debug};
214             }
215             else {
216             # If $msg is either 1 or 0, we want to set the Attribute
217 0 0         if ($msg =~ /^(?:1|0)$/) {
218 0           return $self->{debug} = $msg;
219             }
220             else {
221 0 0         return 1 unless $self->level > 2;
222              
223 0 0         my $prefix = $self->text_prefix ? 'DEBUG' : '[D]';
224 0 0         my $time = $self->time_prefix ? localtime().' ' : '';
225 0   0       my $buffer = $time."$prefix ".$self->message($msg, ($caller) ||= caller());
226              
227 0 0         $self->send($buffer, 'debug') or return;
228             }
229             }
230              
231 0           return 1;
232             }
233              
234             sub brik_fini {
235 0     0 1   my $self = shift;
236              
237 0           $self->_fd(undef);
238              
239 0           return 1;
240             }
241              
242             1;
243              
244             __END__