File Coverage

lib/Net/SyslogNg.pm
Criterion Covered Total %
statement 52 52 100.0
branch 2 4 50.0
condition 16 39 41.0
subroutine 10 10 100.0
pod 2 2 100.0
total 82 107 76.6


line stmt bran cond sub pod time code
1             package Net::SyslogNg;
2              
3 1     1   81746 use 5.14.2;
  1         3  
4 1     1   3 use strict;
  1         2  
  1         15  
5 1     1   3 use warnings;
  1         1  
  1         17  
6 1     1   502 use utf8;
  1         12  
  1         4  
7 1     1   29 use Carp qw/croak carp/;
  1         1  
  1         38  
8 1     1   400 use IO::Socket::INET;
  1         17397  
  1         5  
9 1     1   735 use Sys::Hostname;
  1         854  
  1         44  
10 1     1   750 use DateTime;
  1         406216  
  1         490  
11              
12             our $VERSION = '0.01';
13              
14             my %SYSLOG_PRIORITIES = (
15             'emerg' => 0,
16             'emergency' => 0,
17             'alert' => 1,
18             'crit' => 2,
19             'critical' => 2,
20             'err' => 3,
21             'error' => 3,
22             'warning' => 4,
23             'notice' => 5,
24             'info' => 6,
25             'informational' => 6,
26             'debug' => 7
27             );
28              
29             my %SYSLOG_FACILITIES = (
30             'kern' => 0,
31             'kernel' => 0,
32             'user' => 1,
33             'mail' => 2,
34             'daemon' => 3,
35             'system' => 3,
36             'auth' => 4,
37             'syslog' => 5,
38             'internal' => 5,
39             'lpr' => 6,
40             'printer' => 6,
41             'news' => 7,
42             'uucp' => 8,
43             'cron' => 9,
44             'clock' => 9,
45             'authpriv' => 10,
46             'security2' => 10,
47             'ftp' => 11,
48             'FTP' => 11,
49             'NTP' => 11,
50             'audit' => 13,
51             'alert' => 14,
52             'clock2' => 15,
53             'local0' => 16,
54             'local1' => 17,
55             'local2' => 18,
56             'local3' => 19,
57             'local4' => 20,
58             'local5' => 21,
59             'local6' => 22,
60             'local7' => 23,
61             );
62              
63             sub new {
64 1     1 1 523 my ($class, %opt) = @_;
65 1         2 my $self = {};
66              
67             #Params
68 1   50     7 $self->{'facility'} = $opt{'-facility'} // 'local5';
69 1   50     5 $self->{'priority'} = $opt{'-priority'} // 'error';
70 1   50     4 $self->{'syslog_port'} = $opt{'-syslog_port'} // 514;
71 1   50     4 $self->{'syslog_host'} = $opt{'-syslog_host'} // '127.0.0.1';
72 1         2 $self->{'debug'} = $opt{'-debug'};
73              
74 1         3 return bless $self, $class;
75             }
76              
77             sub send {
78 1     1 1 5 my ($self, %opt) = @_;
79              
80 1   33     5 my $pid = $opt{'-pid'} // $$;
81 1   50     4 my $msg = $opt{'-msg'} // '';
82 1   50     4 my $version = $opt{'-version'} // 1;
83 1   33     7 my $timestamp = $opt{'-timestamp'} // DateTime->now()->iso8601 . '.000Z';
84 1   33     447 my $hostname = $opt{'-hostname'} // inet_ntoa( ( gethostbyname(hostname) )[4] );
85 1   50     408 my $message_id = $opt{'-message_id'} // '-';
86 1   50     4 my $structured_data = $opt{'-structured_data'} // '-';
87 1   50     4 my $application = $opt{'-application'} // '-';
88 1   33     7 my $facility = $opt{'-facility'} // $self->{'facility'};
89 1   33     9 my $priority = $opt{'-priority'} // $self->{'priority'};
90              
91 1   33     3 my $facility_i = $SYSLOG_FACILITIES{$facility} // croak "Wrong facility: '$facility'";
92 1   33     3 my $priority_i = $SYSLOG_PRIORITIES{$priority} // croak "Wrong priority: '$priority'";
93              
94 1         3 my $priority_raw = ( ( $facility_i << 3 ) | ($priority_i) );
95 1         6 my $msg_raw = "<$priority_raw>" . join(' ', $version, $timestamp, $hostname, $application, $pid, $message_id, $structured_data, $msg);
96              
97             my $sock = IO::Socket::INET->new(
98             'PeerAddr' => $self->{'syslog_host'},
99 1 50       8 'PeerPort' => $self->{'syslog_port'},
100             'Proto' => 'udp',
101             ) or croak "Can't connect to $self->{'syslog_host'}:$self->{'syslog_port'} $@";
102              
103 1         464 print $sock $msg_raw;
104 1         16 close $sock;
105              
106 1 50       5 if ($self->{'debug'}) {
107 1         43 print STDOUT 'Syslog raw message: ' . $msg_raw, "\n";
108             }
109              
110 1         126 return 1;
111             }
112              
113              
114              
115             =pod
116              
117             =encoding UTF-8
118              
119             =head1 NAME
120              
121             B<Net::SyslogNg> - client module for writing to syslog server (rfc5424)
122              
123             =head1 VERSION
124              
125             version 0.01
126              
127             =head1 SYNOPSYS
128              
129             use Net::SyslogNg;
130              
131             # Create Net::SyslogNg object
132             my $syslog = Net::SyslogNg->new(
133             '-syslog_host' => '127.0.0.1',
134             '-syslog_port' => 514,
135             );
136              
137             # Send message to syslog
138             $syslog->send(
139             '-facility' => 'daemon',
140             '-priority' => 'error',
141             '-msg' => 'Syslog error message',
142             );
143              
144             =head1 METHODS
145              
146             =head2 new(%opt)
147              
148             Create Net::SyslogNg object
149              
150             Options:
151             -syslog_host => Syslog host address
152             -syslog_port => Syslog port number
153             -facility => Facility name
154             -priority => Priority name
155             -debug => Enable printing debug messages (default: 0)
156              
157             =head2 send(%opt)
158              
159             Send message to syslog daemon
160              
161             Options:
162             -facility => Facility name
163             -priority => Priority name
164             -pid => Process id number (default: current process id)
165             -msg => String of message
166             -version => Version number (default: 1)
167             -timestamp => Timestamp of message (default: current time in UTC)
168             -hostname => Hostname of syslog client (default: current hostname)
169             -message_id => Message id
170             -structured_data => Structured data field
171             -application => Application name
172              
173             =head1 DEPENDENCE
174              
175             L<Sys::hostname>, L<IO::Socket::INET>, L<DateTime>
176              
177             =head1 AUTHORS
178              
179             =over 4
180              
181             =item *
182              
183             Pavel Andryushin <vrag867@gmail.com>
184              
185             =back
186              
187             =head1 COPYRIGHT AND LICENSE
188              
189             This software is copyright (c) 2020 by Pavel Andryushin.
190              
191             This is free software; you can redistribute it and/or modify it under
192             the same terms as the Perl 5 programming language system itself.
193              
194             =cut
195              
196             1;