1N/A# we enable all Perl warnings, but we don't "use warnings 'all'" because 1N/A# we want to disable the warnings generated by Sys::Syslog 1N/A# if someone is using warnings::compat, the previous trick won't work, so we 1N/A# must manually disable warnings 1N/A$^W =
0 if $] <
5.006;
1N/A# if testing in core, check that the module is at least available 1N/A# we also need Socket 1N/A# any remaining warning should be severly punished 1N/Ause_ok('Sys::Syslog', ':standard', ':extended', ':macros'); 1N/A# check that the documented functions are correctly provided 1N/A# check the diagnostics 1N/A "calling setlogsock() with no argument" ); 1N/A "calling syslog() with no argument" ); 1N/A "calling syslog() with one undef argument" ); 1N/A "calling syslog() with one empty argument" ); 1N/A# try to open a syslog using a Unix or stream socket 1N/A skip "can't connect to Unix socket: _PATH_LOG unavailable", 8 1N/A # The only known $^O eq 'svr4' that needs this is NCR MP-RAS, 1N/A # but assuming 'stream' in SVR4 is probably not that bad. 1N/A ok( $r, "setlogsock() should return true: '$r'" ); 1N/A # open syslog with a "local0" facility 1N/A $r = eval { openlog('perl', 'ndelay', 'local0') } || 0; 1N/A is( $@, '', "openlog() called with facility 'local0'" ); 1N/A ok( $r, "openlog() should return true: '$r'" ); 1N/A is( $@, '', "syslog() called with level 'info'" ); 1N/A ok( $r, "syslog() should return true: '$r'" ); 1N/A is( $@, '', "closelog()" ); 1N/A ok( $r, "closelog() should return true: '$r'" ); 1N/A# try to open a syslog using all the available connection methods 1N/A skip "the 'stream' mechanism because a previous mechanism with similar interface succeeded", 22 1N/A # setlogsock() called with an arrayref 1N/A # setlogsock() called with a single argument 1N/A # openlog() without option NDELAY 1N/A is( $@, '', "[$sock_type] openlog() called with facility 'local0' and without option 'ndelay'" ); 1N/A # openlog() with the option NDELAY 1N/A $r = eval { openlog('perl', 'ndelay', 'local0') } || 0; 1N/A is( $@, '', "[$sock_type] openlog() called with facility 'local0' with option 'ndelay'" ); 1N/A # syslog() with negative level, should fail 1N/A like( $@, '/^syslog: invalid level\/facility: /', "[$sock_type] syslog() called with level -1" ); 1N/A # syslog() with invalid level, should fail 1N/A like( $@, '/^syslog: invalid level\/facility: /', "[$sock_type] syslog() called with level plonk" ); 1N/A # syslog() with levels "info" and "notice" (as a strings), should fail 1N/A like( $@, '/^syslog: too many levels given: notice/', "[$sock_type] syslog() called with level 'info,notice'" ); 1N/A # syslog() with facilities "local0" and "local1" (as a strings), should fail 1N/A like( $@, '/^syslog: too many facilities given: local1/', "[$sock_type] syslog() called with level 'local0,local1'" ); 1N/A # syslog() with level "info" (as a string), should pass 1N/A # syslog() with level "info" (as a macro), should pass 1N/A skip "the 'unix' mechanism works, so the tests will likely fail with the 'stream' mechanism", 10 1N/A skip "not testing setlogsock('stream'): _PATH_LOG unavailable", 10 1N/A # setlogsock() with "stream" and an undef path 1N/A is( $@, '', "setlogsock() called, with 'stream' and an undef path" ); 1N/A ok( $r, "setlogsock() on Cygwin with syslog-ng should return true: '$r'" ); 1N/A ok( !$r, "setlogsock() on Cygwin without syslog-ng should return false: '$r'" ); 1N/A ok( $r, "setlogsock() should return true: '$r'" ); 1N/A # setlogsock() with "stream" and an empty path 1N/A is( $@, '', "setlogsock() called, with 'stream' and an empty path" ); 1N/A ok( !$r, "setlogsock() should return false: '$r'" ); 1N/A is( $@, '', "setlogsock() called, with 'stream' and '/dev/null'" ); 1N/A ok( $r, "setlogsock() should return true: '$r'" ); 1N/A # setlogsock() with "stream" and a non-existing file 1N/A is( $@, '', "setlogsock() called, with 'stream' and 'test.log' (file does not exist)" ); 1N/A ok( !$r, "setlogsock() should return false: '$r'" ); 1N/A # setlogsock() with "stream" and a local file 1N/A is( $@, '', "setlogsock() called, with 'stream' and '$logfile' (file exists)" ); 1N/A ok( $r, "setlogsock() should return true: '$r'" ); 1N/A is( $@, '', "setlogmask() called with a null mask" ); 1N/A is( $@, '', "setlogmask() called with a null mask (second time)" ); 1N/A is( $r, $oldmask, "setlogmask() must return the same mask as previous call"); 1N/A is( $@, '', "setlogmask() called with a new mask" ); 1N/A is( $r, $oldmask, "setlogmask() must return the same mask as previous call"); 1N/A is( $@, '', "setlogmask() called with a null mask" );