ext/Sys/Syslog/t/syslog.t

   1 #!/usr/bin/perl -T
   2
   3 BEGIN {
   4     if( $ENV{PERL_CORE} ) {
   5         chdir 't';
   6         @INC = '../lib';
   7     }
   8 }
   9
  10 use strict;
  11 use Config;
  12 use File::Spec;
  13 use Test::More;
  14
  15 # check that the module is at least available
  16 plan skip_all => "Sys::Syslog was not build"
  17   unless $Config{'extensions'} =~ /\bSyslog\b/;
  18
  19 # we also need Socket
  20 plan skip_all => "Socket was not build"
  21   unless $Config{'extensions'} =~ /\bSocket\b/;
  22
  23 BEGIN {
  24     plan tests => 119;
  25
  26     # ok, now loads them
  27     eval 'use Socket';
  28     use_ok('Sys::Syslog', ':standard', ':extended', ':macros');
  29 }
  30
  31 # check that the documented functions are correctly provided
  32 can_ok( 'Sys::Syslog' => qw(openlog syslog syslog setlogmask setlogsock closelog) );
  33
  34
  35 # check the diagnostics
  36 # setlogsock()
  37 eval { setlogsock() };
  38 like( $@, qr/^Invalid argument passed to setlogsock; must be 'stream', 'unix', 'tcp', 'udp' or 'inet'/,
  39     "calling setlogsock() with no argument" );
  40
  41 # syslog()
  42 eval { syslog() };
  43 like( $@, qr/^syslog: expecting argument \$priority/,
  44     "calling syslog() with no argument" );
  45
  46 my $test_string = "uid $< is testing Perl $] syslog(3) capabilities";
  47 my $r = 0;
  48
  49 # try to open a syslog using a Unix or stream socket
  50 SKIP: {
  51     skip "can't connect to Unix socket: _PATH_LOG unavailable", 8
  52       unless -e Sys::Syslog::_PATH_LOG();
  53
  54     # The only known $^O eq 'svr4' that needs this is NCR MP-RAS,
  55     # but assuming 'stream' in SVR4 is probably not that bad.
  56     my $sock_type = $^O =~ /^(solaris|irix|svr4|powerux)$/ ? 'stream' : 'unix';
  57
  58     eval { setlogsock($sock_type) };
  59     is( $@, '', "setlogsock() called with '$sock_type'" );
  60     TODO: {
  61         local $TODO = "minor bug";
  62         ok( $r, "setlogsock() should return true: '$r'" );
  63     }
  64
  65     # open syslog with a "local0" facility
  66     SKIP: {
  67         # openlog()
  68         $r = eval { openlog('perl', 'ndelay', 'local0') } || 0;
  69         skip "can't connect to syslog", 6 if $@ =~ /^no connection to syslog available/;
  70         is( $@, '', "openlog() called with facility 'local0'" );
  71         ok( $r, "openlog() should return true: '$r'" );
  72
  73         # syslog()
  74         $r = eval { syslog('info', "$test_string by connecting to a $sock_type socket") } || 0;
  75         is( $@, '', "syslog() called with level 'info'" );
  76         ok( $r, "syslog() should return true: '$r'" );
  77
  78         # closelog()
  79         $r = eval { closelog() } || 0;
  80         is( $@, '', "closelog()" );
  81         ok( $r, "closelog() should return true: '$r'" );
  82     }
  83 }
  84
  85 # try to open a syslog using all the available connection methods
  86 for my $sock_type (qw(stream unix inet tcp udp console)) {
  87     SKIP: {
  88         # setlogsock()
  89         $r = eval { setlogsock([$sock_type]) } || 0;
  90         skip "can't use '$sock_type' socket", 16 unless $r;
  91         is( $@, '', "setlogsock() called with '$sock_type'" );
  92         ok( $r, "setlogsock() should return true: '$r'" );
  93
  94         # openlog() without option NDELAY
  95         $r = eval { openlog('perl', '', 'local0') } || 0;
  96         skip "can't connect to syslog", 14 if $@ =~ /^no connection to syslog available/;
  97         is( $@, '', "openlog() called with facility 'local0' and without option 'ndelay'" );
  98         ok( $r, "openlog() should return true: '$r'" );
  99
 100         # openlog() with the option NDELAY
 101         $r = eval { openlog('perl', 'ndelay', 'local0') } || 0;
 102         skip "can't connect to syslog", 12 if $@ =~ /^no connection to syslog available/;
 103         is( $@, '', "openlog() called with facility 'local0' with option 'ndelay'" );
 104         ok( $r, "openlog() should return true: '$r'" );
 105
 106         # syslog() with level "info" (as a string), should pass
 107         $r = eval { syslog('info', "$test_string by connecting to a $sock_type socket") } || 0;
 108         is( $@, '', "syslog() called with level 'info'" );
 109         ok( $r, "syslog() should return true: '$r'" );
 110
 111         # syslog() with level "info" (as a macro), should pass
 112         $r = eval { syslog(LOG_INFO, "$test_string by connecting to a $sock_type socket") } || 0;
 113         is( $@, '', "syslog() called with level 'info'" );
 114         ok( $r, "syslog() should return true: '$r'" );
 115
 116         # syslog() with facility "kern" (as a string), should fail
 117         $r = eval { syslog('kern', "$test_string by connecting to a $sock_type socket") } || 0;
 118         like( $@, '/^syslog: invalid level/facility: kern/', "syslog() called with facility 'kern'" );
 119         ok( !$r, "syslog() should return false: '$r'" );
 120
 121         # syslog() with facility "kern" (as a macro), should fail
 122         $r = eval { syslog(LOG_KERN, "$test_string by connecting to a $sock_type socket") } || 0;
 123         like( $@, '/^syslog: invalid level/facility: 0/', "syslog() called with facility 'kern'" );
 124         ok( !$r, "syslog() should return false: '$r'" );
 125
 126         SKIP: {
 127             skip "skipping closelog() tests for 'console'", 2 if $sock_type eq 'console';
 128             # closelog()
 129             $r = eval { closelog() } || 0;
 130             is( $@, '', "closelog()" );
 131             ok( $r, "closelog() should return true: '$r'" );
 132         }
 133     }
 134 }
 135
 136 # setlogmask()
 137 {
 138     my $oldmask = 0;
 139
 140     $oldmask = eval { setlogmask(0) } || 0;
 141     is( $@, '', "setlogmask() called with a null mask" );
 142     $r = eval { setlogmask(0) } || 0;
 143     is( $@, '', "setlogmask() called with a null mask (second time)" );
 144     is( $r, $oldmask, "setlogmask() must return the same mask as previous call");
 145
 146     for my $newmask ( LOG_ERR , LOG_CRIT|LOG_ERR|LOG_WARNING ) {
 147         $r = eval { setlogmask($newmask) } || 0;
 148         is( $@, '', "setlogmask() called with a new mask" );
 149         is( $r, $oldmask, "setlogmask() must return the same mask as previous call");
 150         $r = eval { setlogmask(0) } || 0;
 151         is( $@, '', "setlogmask() called with a null mask" );
 152         is( $r, $newmask, "setlogmask() must return the new mask");
 153         setlogmask($oldmask);
 154     }
 155 }