This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update Sys-Syslog to CPAN version 0.33
[perl5.git] / cpan / Sys-Syslog / t / facilities-routing.t
1 #!perl -w
2 # --------------------------------------------------------------------
3 # Try to send messages with all combinations of facilities and levels
4 # to a POE syslog server.
5 # --------------------------------------------------------------------
6 use strict;
7 use warnings;
8
9 use Test::More;
10 use Socket;
11 use Sys::Syslog 0.30 qw< :standard :extended :macros >;
12
13
14 # check than POE is available
15 plan skip_all => "POE is not available" unless eval "use POE; 1";
16
17 # check than POE::Component::Server::Syslog is available and recent enough
18 plan skip_all => "POE::Component::Server::Syslog is not available"
19     unless eval "use POE::Component::Server::Syslog; 1";
20 plan skip_all => "POE::Component::Server::Syslog is too old"
21     if POE::Component::Server::Syslog->VERSION < 1.14;
22
23
24 my $host    = "127.0.0.1";
25 my $port    = 5140;
26 my $proto   = "udp";
27 my $ident   = "pocosyslog";
28
29 my @levels = qw< emerg alert crit err warning notice info debug >;
30 my @facilities = qw<
31     auth cron daemon ftp kern lpr mail news syslog user uucp
32     local0 local1 local2 local3 local4 local5 local6 local7
33 >;
34
35 my %received;
36 my $parent_pid = $$;
37 my $child_pid  = fork();
38
39 if ($child_pid) {
40     # parent: setup a syslog server
41     POE::Component::Server::Syslog->spawn(
42         Alias       => 'syslog',
43         Type        => $proto, 
44         BindAddress => $host,
45         BindPort    => $port,
46
47         InputState  => \&client_input,
48         ErrorState  => \&client_error,
49     );
50
51     # signal handlers
52     POE::Kernel->sig_child($child_pid, sub { wait() });
53     $SIG{TERM} = sub {
54         POE::Kernel->post(syslog => "shutdown");
55         POE::Kernel->stop;
56     };
57
58     # run everything
59     plan tests => @facilities * @levels * 2;
60     POE::Kernel->run;
61
62     # check if some messages are missing
63     my @miss = sort grep { $received{$_} < 2 } keys %received;
64     diag "@miss" if @miss;
65 }
66 else {
67     # child: send messages to the syslog server
68     sleep 2;
69     my $delay = .01;
70     setlogsock({ host => $host, type => $proto, port => $port });
71
72     # first way, set the facility each time with openlog()
73     for my $facility (@facilities) {
74         openlog($ident, "ndelay,pid", $facility);
75
76         for my $level (@levels) {
77             eval { syslog($level => "<$facility\:$level>") }
78                 or warn "error: syslog($level => '<$facility\:$level>'): $@";
79             select undef, undef, undef, $delay;
80         }
81     }
82
83     # second way, set the facility once with openlog(), then set
84     # the message facility with syslog()
85     openlog($ident, "ndelay,pid", "user");
86
87     for my $facility (@facilities) {
88         for my $level (@levels) {
89             eval { syslog("$facility.$level" => "<$facility\:$level>") }
90                 or warn "error: syslog('$facility.$level' => '<$facility\:$level>'): $@";
91             select undef, undef, undef, $delay;
92         }
93     }
94
95     sleep 2;
96
97     # send SIGTERM to the parent
98     kill 15 => $parent_pid;
99 }
100
101
102 sub client_input {
103     my $message = $_[&ARG0];
104
105     # extract the sent facility and level from the message text
106     my ($sent_facility, $sent_level) = $message->{msg} =~ /<(\w+):(\w+)>/;
107     $received{"$sent_facility\:$sent_level"}++;
108
109     # resolve their numeric values
110     my ($sent_fac_num, $sent_lev_num);
111     {
112         no strict "refs";
113         $sent_fac_num = eval { my $n = uc "LOG_$sent_facility"; &$n } >> 3;
114         $sent_lev_num = eval { my $n = uc "LOG_$sent_level";    &$n };
115     }
116
117     is_deeply(
118         {   # received message
119             facility => $message->{facility},
120             severity => $message->{severity},
121         },
122         {   # sent message
123             facility => $sent_fac_num,
124             severity => $sent_lev_num,
125         },
126         "sent<facility=$sent_facility($sent_fac_num), level=$sent_level" .
127         "($sent_lev_num)> - rcvd<facility=$message->{facility}, " .
128         "level=$message->{severity}>"
129     );
130 }
131
132
133 sub client_error {
134     my $message = $_[&ARG0];
135
136     require Data::Dumper;
137     $Data::Dumper::Indent   = 0;    $Data::Dumper::Indent   = 0;
138     $Data::Dumper::Sortkeys = 1;    $Data::Dumper::Sortkeys = 1;
139     fail "checking syslog message";
140     diag "[client_error] message = ", Data::Dumper::Dumper($message);
141
142     kill 15 => $child_pid;
143     POE::Kernel->post(syslog => "shutdown");
144     POE::Kernel->stop;
145 }
146