File Coverage

blib/lib/Net/Syslog.pm
Criterion Covered Total %
statement 43 46 93.4
branch 8 16 50.0
condition 2 4 50.0
subroutine 7 7 100.0
pod 0 2 0.0
total 60 75 80.0


line stmt bran cond sub pod time code
1             package Net::Syslog;
2              
3 1     1   742 use vars qw($VERSION);
  1         2  
  1         59  
4 1     1   6 use warnings;
  1         2  
  1         35  
5 1     1   5 use strict;
  1         13  
  1         38  
6 1     1   2678 use IO::Socket;
  1         43643  
  1         5  
7 1     1   2133 use Sys::Hostname;
  1         1462  
  1         757  
8              
9             $VERSION = '0.04';
10              
11             # Preloaded methods go here.
12              
13             my %syslog_priorities = (
14             emerg => 0,
15             emergency => 0,
16             alert => 1,
17             crit => 2,
18             critical => 2,
19             err => 3,
20             error => 3,
21             warning => 4,
22             notice => 5,
23             info => 6,
24             informational => 6,
25             debug => 7
26             );
27              
28             my %syslog_facilities = (
29             kern => 0,
30             kernel => 0,
31             user => 1,
32             mail => 2,
33             daemon => 3,
34             system => 3,
35             auth => 4,
36             syslog => 5,
37             internal => 5,
38             lpr => 6,
39             printer => 6,
40             news => 7,
41             uucp => 8,
42             cron => 9,
43             clock => 9,
44             authpriv => 10,
45             security2 => 10,
46             ftp => 11,
47             FTP => 11,
48             NTP => 11,
49             audit => 13,
50             alert => 14,
51             clock2 => 15,
52             local0 => 16,
53             local1 => 17,
54             local2 => 18,
55             local3 => 19,
56             local4 => 20,
57             local5 => 21,
58             local6 => 22,
59             local7 => 23,
60             );
61              
62             my @month = qw{Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec};
63              
64             sub new {
65 1     1 0 123 my $class = shift;
66 1         4 my $name = $0;
67 1 50       6 if ( $name =~ /.+\/(.+)/ ) {
68 0         0 $name = $1;
69             }
70 1         16 my $self = {
71             Name => $name,
72             Facility => 'local5',
73             Priority => 'error',
74             Pid => $$,
75             SyslogPort => 514,
76             SyslogHost => '127.0.0.1'
77             };
78 1         3 bless $self, $class;
79 1         4 my %par = @_;
80 1         4 foreach ( keys %par ) {
81 2         10 $self->{$_} = $par{$_};
82             }
83 1         472 return $self;
84             }
85              
86             sub send {
87 1     1 0 17 my $self = shift;
88 1         2 my $msg = shift;
89 1         57 my %par = @_;
90 1         8 my %local = %$self;
91 1         6 foreach ( keys %par ) {
92 0         0 $local{$_} = $par{$_};
93             }
94              
95 1 50       13 my $pid = ( $local{Pid} =~ /^\d+$/ ) ? "\[$local{Pid}\]" : "";
96 1   50     7 my $facility_i = $syslog_facilities{ $local{Facility} } || 21;
97 1   50     5 my $priority_i = $syslog_priorities{ $local{Priority} } || 3;
98              
99 1         2 my $d = ( ( $facility_i << 3 ) | ($priority_i) );
100              
101 1         6 my $host = inet_ntoa( ( gethostbyname(hostname) )[4] );
102 1         2231 my @time = localtime();
103 1 50       57 my $ts =
    50          
    50          
    50          
104             $month[ $time[4] ] . " "
105             . ( ( $time[3] < 10 ) ? ( " " . $time[3] ) : $time[3] ) . " "
106             . ( ( $time[2] < 10 ) ? ( "0" . $time[2] ) : $time[2] ) . ":"
107             . ( ( $time[1] < 10 ) ? ( "0" . $time[1] ) : $time[1] ) . ":"
108             . ( ( $time[0] < 10 ) ? ( "0" . $time[0] ) : $time[0] );
109 1         3 my $message = '';
110              
111 1 50       4 if ( $local{rfc3164} ) {
112 0         0 $message = "<$d>$ts $host $local{Name}$pid: $msg";
113             }
114             else {
115 1         36 $message = "<$d>$local{Name}$pid: $msg";
116             }
117              
118 1         17 my $sock = new IO::Socket::INET(
119             PeerAddr => $local{SyslogHost},
120             PeerPort => $local{SyslogPort},
121             Proto => 'udp'
122             );
123 1 50       1059 die "Socket could not be created : $!\n" unless $sock;
124 1         88 print $sock $message;
125 1         253 $sock->close();
126             }
127              
128             # Autoload methods go after =cut, and are processed by the autosplit program.
129              
130             1;
131             __END__
132             # Below is the stub of documentation for your module. You better edit it!
133              
134             =head1 NAME
135              
136             Net::Syslog - Perl extension for sending syslog messages directly to a remote syslogd.
137              
138             =head1 SYNOPSIS
139              
140             use Net::Syslog;
141             my $s=new Net::Syslog(Facility=>'local4',Priority=>'debug');
142             $s->send('see this in syslog',Priority=>'info');
143              
144             =head1 DESCRIPTION
145              
146             Net::Syslog implements the intra-host syslog forwarding protocol.
147             It is not intended to replace the Sys::Syslog or
148             Unix::Syslog modules, but instead to provide a method of using syslog when a
149             local syslogd is unavailable or when you don't want to write syslog messages
150             to the local syslog.
151              
152             The new call sets up default values, any of which can be overridden in the
153             send call. Keys (listed with default values) are:
154              
155             Name <calling script name>
156             Facility local5
157             Priority error
158             Pid $$
159             SyslogPort 514
160             SyslogHost 127.0.0.1
161              
162             Valid Facilities are:
163             kernel, user, mail, system, security, internal, printer, news,
164             uucp, clock, security2, FTP, NTP, audit, alert, clock2, local0,
165             local1, local2, local3, local4, local5, local6, local7
166              
167             Valid Priorities are:
168             emergency, alert, critical, error, warning, notice, informational,
169             debug
170              
171             Set Pid to any non numeric value to disable in the output.
172              
173             Use:
174             rfc3164 => 1
175             to enable RFC 3164 messages including timestamp and hostname.
176              
177              
178              
179             =head1 AUTHOR
180              
181             Les Howard, les@lesandchris.com
182              
183             =head1 SEE ALSO
184              
185             syslog(3), Sys::Syslog(3), syslogd(8), Unix::Syslog(3), IO::Socket, perl(1)
186              
187             =cut