4 if( $ENV{PERL_CORE} ) {
14 # check that the module is at least available
15 plan skip_all => "Sys::Syslog was not build"
16 unless $Config{'extensions'} =~ /\bSyslog\b/;
19 plan skip_all => "Socket was not build"
20 unless $Config{'extensions'} =~ /\bSocket\b/;
27 use_ok('Sys::Syslog', ':DEFAULT', 'setlogsock');
30 # check that the documented functions are correctly provided
31 can_ok( 'Sys::Syslog' => qw(openlog syslog syslog setlogmask setlogsock closelog) );
34 # check the diagnostics
36 eval { setlogsock() };
37 like( $@, qr/^Invalid argument passed to setlogsock; must be 'stream', 'unix', 'tcp', 'udp' or 'inet'/,
38 "calling setlogsock() with no argument" );
42 like( $@, qr/^syslog: expecting argument \$priority/,
43 "calling syslog() with no argument" );
45 my $test_string = "uid $< is testing Perl $] syslog(3) capabilities";
48 # try to test using a Unix socket
50 skip "can't connect to Unix socket: _PATH_LOG unavailable", 6
51 unless -e Sys::Syslog::_PATH_LOG();
53 # The only known $^O eq 'svr4' that needs this is NCR MP-RAS,
54 # but assuming 'stream' in SVR4 is probably not that bad.
55 my $sock_type = $^O =~ /^(solaris|irix|svr4|powerux)$/ ? 'stream' : 'unix';
57 eval { setlogsock($sock_type) };
58 is( $@, '', "setlogsock() called with '$sock_type'" );
60 local $TODO = "minor bug";
61 ok( $r, "setlogsock() should return true but returned '$r'" );
65 $r = eval { openlog('perl', 'ndelay', 'local0') };
66 skip "can't connect to syslog", 4 if $@ =~ /^no connection to syslog available/;
67 is( $@, '', "openlog()" );
68 ok( $r, "openlog() should return true but returned '$r'" );
70 $r = eval { syslog('info', "$test_string by connecting to a Unix socket") };
71 is( $@, '', "syslog()" );
72 ok( $r, "syslog() should return true but returned '$r'" );
76 # try to test using a INET socket
78 skip "assuming syslog doesn't accept inet connections", 6 if 1;
80 my $sock_type = 'inet';
82 $r = eval { setlogsock('inet') };
83 is( $@, '', "setlogsock() called with '$sock_type'" );
84 ok( $r, "setlogsock() should return true but returned '$r'" );
86 $r = eval { openlog('perl', 'ndelay', 'local0') };
87 is( $@, '', "openlog()" );
88 ok( $r, " -> should return true but returned '$r'" );
90 $r = eval { syslog('info', "$test_string by connecting to a INET socket") };
91 is( $@, '', "syslog()" );
92 ok( $r, " -> should return true but returned '$r'" );