From: Steve Peters Date: Fri, 9 Dec 2005 02:07:32 +0000 (+0000) Subject: Upgrade to Sys-Syslog-0.10 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8168e71f67cd4bdb7731fc3633d09456af393dd3;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Sys-Syslog-0.10 p4raw-id: //depot/perl@26309 --- diff --git a/MANIFEST b/MANIFEST index 2afa516..5190484 100644 --- a/MANIFEST +++ b/MANIFEST @@ -933,9 +933,20 @@ ext/Sys/Hostname/Hostname.pm Sys::Hostname extension Perl module ext/Sys/Hostname/Hostname.xs Sys::Hostname extension external subroutines ext/Sys/Hostname/Makefile.PL Sys::Hostname extension makefile writer ext/Sys/Hostname/t/Hostname.t See if Sys::Hostname works +ext/Sys/Syslog/Changes Changlog for Sys::Syslog ext/Sys/Syslog/Makefile.PL Sys::Syslog extension makefile writer +ext/Sys/Syslog/README README for Sys::Syslog ext/Sys/Syslog/Syslog.pm Sys::Syslog extension Perl module ext/Sys/Syslog/Syslog.xs Sys::Syslog extension external subroutines +ext/Sys/Syslog/fallback/const-c.inc Sys::Syslog constants fallback file +ext/Sys/Syslog/fallback/const-xs.inc Sys::Syslog constants fallback file +ext/Sys/Syslog/t/00-load.t test for Sys::Syslog +ext/Sys/Syslog/t/constants.t test for Sys::Syslog +ext/Sys/Syslog/t/distchk.t test for Sys::Syslog +ext/Sys/Syslog/t/pod.t test for Sys::Syslog +ext/Sys/Syslog/t/podcover.t test for Sys::Syslog +ext/Sys/Syslog/t/podspell.t test for Sys::Syslog +ext/Sys/Syslog/t/portfs.t test for Sys::Syslog ext/Sys/Syslog/t/syslog.t See if Sys::Syslog works ext/Thread/create.tx Test thread creation ext/Thread/die2.tx Test thread die() differently diff --git a/ext/Sys/Syslog/Changes b/ext/Sys/Syslog/Changes new file mode 100644 index 0000000..65c6cb4 --- /dev/null +++ b/ext/Sys/Syslog/Changes @@ -0,0 +1,17 @@ +Revision history for Sys-Syslog + +0.10 2005.12.08 + [DOC] Improved documentation. + [TESTS] Added -T to t/syslog.t + [TESTS] Added t/constants.t to check the macros. + [TESTS] Added t/distchk.t, t/podspell.t, t/podcover.t, t/portfs.t + +0.09 2005.12.06 + [CODE] Now setlogsock() really croak(), as documented. + [DIST] CPANized from blead@26281. + [DIST] Modified Makefile.PL so that ExtUtils::Constant is conditionaly + used, with a fallback in the case it's not available. + [DIST] Bumped version to 0.09 + [DOC] Added support and license information. + [TESTS] Rewrote and ported t/syslog.t to Test::More + diff --git a/ext/Sys/Syslog/Makefile.PL b/ext/Sys/Syslog/Makefile.PL index 3315db2..53a3a2a 100644 --- a/ext/Sys/Syslog/Makefile.PL +++ b/ext/Sys/Syslog/Makefile.PL @@ -1,38 +1,63 @@ use ExtUtils::MakeMaker; -use ExtUtils::Constant 0.11 'WriteConstants'; +eval 'use ExtUtils::MakeMaker::Coverage'; +require 5.006; WriteMakefile( - NAME => 'Sys::Syslog', - VERSION_FROM => 'Syslog.pm', - MAN3PODS => {}, # Pods will be built by installman. - XSPROTOARG => '-noprototypes', - realclean => {FILES=> 'const-c.inc const-xs.inc'}, + NAME => 'Sys::Syslog', + VERSION_FROM => 'Syslog.pm', + ABSTRACT_FROM => 'Syslog.pm', + INSTALLDIRS => 'perl', + MAN3PODS => {}, # Pods will be built by installman. + XSPROTOARG => '-noprototypes', + PREREQ_PM => { + 'Test::More' => 0, + 'XSLoader' => 0, + }, + dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, + clean => { FILES => 'Sys-Syslog-*' }, + realclean => { FILES => 'const-c.inc const-xs.inc' }, ); my $_PATH_LOG; if (-S "/dev/log" && -w "/dev/log") { - # Most unixes have a unix domain socket /dev/log. - $_PATH_LOG = "/dev/log"; + # Most unixes have a unix domain socket /dev/log. + $_PATH_LOG = "/dev/log"; } elsif (-c "/dev/conslog" && -w "/dev/conslog") { - # SunOS 5.8 has a worldwritable /dev/conslog STREAMS log driver. - # The /dev/log STREAMS log driver on this platform has permissions - # and ownership `crw-r----- root sys'. /dev/conslog has more liberal - # permissions. - $_PATH_LOG = "/dev/conslog"; + # SunOS 5.8 has a worldwritable /dev/conslog STREAMS log driver. + # The /dev/log STREAMS log driver on this platform has permissions + # and ownership `crw-r----- root sys'. /dev/conslog has more liberal + # permissions. + $_PATH_LOG = "/dev/conslog"; } else { - $_PATH_LOG = ""; + $_PATH_LOG = ""; } -WriteConstants( - NAME => 'Sys::Syslog', - NAMES => [qw(LOG_ALERT LOG_AUTH LOG_AUTHPRIV LOG_CONS LOG_CRIT LOG_CRON - LOG_DAEMON LOG_DEBUG LOG_EMERG LOG_ERR LOG_FACMASK LOG_FTP - LOG_INFO LOG_KERN LOG_LFMT LOG_LOCAL0 LOG_LOCAL1 LOG_LOCAL2 - LOG_LOCAL3 LOG_LOCAL4 LOG_LOCAL5 LOG_LOCAL6 LOG_LOCAL7 LOG_LPR - LOG_MAIL LOG_NDELAY LOG_NEWS LOG_NFACILITIES LOG_NOTICE - LOG_NOWAIT LOG_ODELAY LOG_PERROR LOG_PID LOG_PRIMASK LOG_SYSLOG - LOG_USER LOG_UUCP LOG_WARNING), - {name=>"_PATH_LOG", type=>"PV", default=>["PV",qq("$_PATH_LOG")]}, - ], -); +if(eval {require ExtUtils::Constant; 1}) { + my @names = (qw( LOG_ALERT LOG_AUTH LOG_AUTHPRIV LOG_CONS LOG_CRIT LOG_CRON + LOG_DAEMON LOG_DEBUG LOG_EMERG LOG_ERR LOG_FACMASK LOG_FTP + LOG_INFO LOG_KERN LOG_LFMT LOG_LOCAL0 LOG_LOCAL1 LOG_LOCAL2 + LOG_LOCAL3 LOG_LOCAL4 LOG_LOCAL5 LOG_LOCAL6 LOG_LOCAL7 LOG_LPR + LOG_MAIL LOG_NDELAY LOG_NEWS LOG_NFACILITIES LOG_NOTICE + LOG_NOWAIT LOG_ODELAY LOG_PERROR LOG_PID LOG_PRIMASK LOG_SYSLOG + LOG_USER LOG_UUCP LOG_WARNING), + { name => "_PATH_LOG", type => "PV", default => [ "PV", qq("$_PATH_LOG") ] }, + ); + + ExtUtils::Constant::WriteConstants( + NAME => 'Sys::Syslog', + NAMES => \@names, + ); + + open(MACROS, '>macros.all') or warn "can't write 'macros.all': $!\n"; + print MACROS join $/, grep {!ref} @names; + close(MACROS); + +} else { + use File::Copy; + use File::Spec; + foreach my $file ('const-c.inc', 'const-xs.inc') { + my $fallback = File::Spec->catfile('fallback', $file); + copy ($fallback, $file) or die "Can't copy $fallback to $ $!"; + } +} diff --git a/ext/Sys/Syslog/README b/ext/Sys/Syslog/README new file mode 100644 index 0000000..4153683 --- /dev/null +++ b/ext/Sys/Syslog/README @@ -0,0 +1,70 @@ +NAME + + Sys::Syslog - Perl interface to the UNIX syslog(3) calls + + +DESCRIPTION + + Sys::Syslog is an interface to the UNIX syslog(3) program. + Call syslog() with a string priority and a list of printf() args + just like syslog(3). + + +INSTALLATION + + To install this module, run the following commands: + + $ perl Makefile.PL + $ make + $ make test + $ make install + + A ANSI-compliant compiler is required to compile the extension. + + Sys::Syslog has been tested by the author on the following systems, + but is likely to run on many more: + + - Linux 2.6, gcc 3.4.1 + - FreeBSD 4.7, gcc 2.95.4 + - Mac OS X 10.2.6, gcc 3.1 + + Sys::Syslog should on any Perl since 5.6.0. This module has been + tested by the author to check that it works with the following + versions ot Perl: + + - Perl 5.6.2 i686-linux (custom build) + - Perl 5.8.5 i386-linux-thread-multi (vendor build) + - Perl 5.6.1 i386-freebsd (custom build) + - Perl 5.8.7 i386-freebsd (custom build) + - Perl 5.6.0 darwin (vendor build) + + See also the corresponding CPAN Testers page: + http://testers.cpan.org/show/Net-Pcap.html + + +SUPPORT AND DOCUMENTATION + + After installing, you can find documentation for this module + with the perldoc command. + + perldoc Sys::Syslog + + You can also look for information at: + + Search CPAN + http://search.cpan.org/dist/Sys-Syslog + + CPAN Request Tracker: + http://rt.cpan.org/NoAuth/Bugs.html?Dist=Sys-Syslog + + AnnoCPAN, annotated CPAN documentation: + http://annocpan.org/dist/Sys-Syslog + + CPAN Ratings: + http://cpanratings.perl.org/d/Sys-Syslog + + +COPYRIGHT AND LICENCE + + This program is free software; you can redistribute it and/or modify it + under the same terms as Perl itself. diff --git a/ext/Sys/Syslog/Syslog.pm b/ext/Sys/Syslog/Syslog.pm index 29bf04c..bb9b3ed 100644 --- a/ext/Sys/Syslog/Syslog.pm +++ b/ext/Sys/Syslog/Syslog.pm @@ -1,13 +1,13 @@ package Sys::Syslog; +use strict; +use Carp; require 5.006; require Exporter; -use Carp; -use strict; our @ISA = qw(Exporter); our @EXPORT = qw(openlog closelog setlogmask syslog); our @EXPORT_OK = qw(setlogsock); -our $VERSION = '0.08'; +our $VERSION = '0.10'; # it would be nice to try stream/unix first, since that will be # most efficient. However streams are dodgy - see _syslog_send_stream @@ -28,12 +28,16 @@ use Sys::Hostname; =head1 NAME -Sys::Syslog, openlog, closelog, setlogmask, syslog - Perl interface to the UNIX syslog(3) calls +Sys::Syslog - Perl interface to the UNIX syslog(3) calls + +=head1 VERSION + +Version 0.10 =head1 SYNOPSIS - use Sys::Syslog; # all except setlogsock, or: - use Sys::Syslog qw(:DEFAULT setlogsock); # default set, plus setlogsock + use Sys::Syslog; # all except setlogsock(), or: + use Sys::Syslog qw(:DEFAULT setlogsock); # default set, plus setlogsock() setlogsock $sock_type; openlog $ident, $logopt, $facility; # don't forget this @@ -41,87 +45,102 @@ Sys::Syslog, openlog, closelog, setlogmask, syslog - Perl interface to the UNIX $oldmask = setlogmask $mask_priority; closelog; + =head1 DESCRIPTION -Sys::Syslog is an interface to the UNIX C program. +C is an interface to the UNIX C program. Call C with a string priority and a list of C args just like C. -Syslog provides the functions: + +=head1 EXPORTS + +By default, C exports the following symbols: + + openlog closelog setlogmask syslog + +as well as the symbols corresponding to most of your C macros. +The symbol C can be exported on demand. + + +=head1 FUNCTIONS =over 4 -=item openlog $ident, $logopt, $facility +=item B Opens the syslog. -I<$ident> is prepended to every message. I<$logopt> contains zero or -more of the words I, I, I. The cons option is +C<$ident> is prepended to every message. C<$logopt> contains zero or +more of the words C, C, C. The C option is ignored, since the failover mechanism will drop down to the console -automatically if all other media fail. I<$facility> specifies the -part of the system to report about, for example LOG_USER or LOG_LOCAL0: +automatically if all other media fail. C<$facility> specifies the +part of the system to report about, for example C or C: see your C documentation for the facilities available in your system. This function will croak if it can't connect to the syslog daemon. +Note that C now takes three arguments, just like C. + B -=item syslog $priority, $message +=item B -=item syslog $priority, $format, @args +=item B -If I<$priority> permits, logs I<$message> or I -with the addition that I<%m> in $message or $format is replaced with +If C<$priority> permits, logs C<$message> or C +with the addition that C<%m> in $message or $format is replaced with C<"$!"> (the latest error message). -If you didn't use openlog() before using syslog(), syslog will try to -guess the I<$ident> by extracting the shortest prefix of I<$format> -that ends in a ":". +If you didn't use C before using C, syslog will +try to guess the C<$ident> by extracting the shortest prefix of +C<$format> that ends in a C<":">. -Note that Sys::Syslog version v0.07 and older passed the $message as -the formatting string to sprintf() even when no formatting arguments -were provided. If the code calling syslog() might execute with older +Note that C version v0.07 and older passed the C<$message> +as the formatting string to C even when no formatting arguments +were provided. If the code calling C might execute with older versions of this module, make sure to call the function as -syslog($priority, "%s", $message) instead of syslog($priority, -$message). This protects against hostile formatting sequences that +C instead of C. This protects against hostile formatting sequences that might show up if $message contains tainted data. -=item setlogmask $mask_priority +=item B -Sets log mask I<$mask_priority> and returns the old mask. +Sets log mask C<$mask_priority> and returns the old mask. -=item setlogsock $sock_type [$stream_location] (added in 5.004_02) +=item B + +=item B (added in 5.004_02) Sets the socket type to be used for the next call to -C or C and returns TRUE on success, -undef on failure. +C or C and returns true on success, +C on failure. -A value of 'unix' will connect to the UNIX domain socket (in some +A value of C<"unix"> will connect to the UNIX domain socket (in some systems a character special device) returned by the C<_PATH_LOG> macro (if your system defines it), or F or F, whatever is writable. A value of 'stream' will connect to the stream indicated by the pathname provided as the optional second parameter. -(For example Solaris and IRIX require 'stream' instead of 'unix'.) -A value of 'inet' will connect to an INET socket (either tcp or udp, -tried in that order) returned by getservbyname(). 'tcp' and 'udp' can -also be given as values. The value 'console' will send messages -directly to the console, as for the 'cons' option in the logopts in -openlog(). +(For example Solaris and IRIX require C<"stream"> instead of C<"unix">.) +A value of C<"inet"> will connect to an INET socket (either C or C, +tried in that order) returned by C. C<"tcp"> and C<"udp"> can +also be given as values. The value C<"console"> will send messages +directly to the console, as for the C<"cons"> option in the logopts in +C. A reference to an array can also be passed as the first parameter. When this calling method is used, the array should contain a list of sock_types which are attempted in order. -The default is to try tcp, udp, unix, stream, console. +The default is to try C, C, C, C, C. -Giving an invalid value for sock_type will croak. +Giving an invalid value for C<$sock_type> will croak. -=item closelog +=item B Closes the log file. =back -Note that C now takes three arguments, just like C. =head1 EXAMPLES @@ -146,10 +165,173 @@ Note that C now takes three arguments, just like C. openlog($program, 'ndelay', 'user'); syslog('info', 'something happened over here'); + +=head1 CONSTANTS + +=head2 Facilities + +=over 4 + +=item * + +C - security/authorization messages + +=item * + +C - security/authorization messages (private) + +=item * + +C - clock daemon (B and B) + +=item * + +C - system daemons without separate facility value + +=item * + +C - ftp daemon + +=item * + +C - kernel messages + +=item * + +C through C - reserved for local use + +=item * + +C - line printer subsystem + +=item * + +C - mail subsystem + +=item * + +C - USENET news subsystem + +=item * + +C - messages generated internally by B + +=item * + +C (default) - generic user-level messages + +=item * + +C - UUCP subsystem + +=back + + +=head2 Levels + +=over 4 + +=item * + +C - system is unusable + +=item * + +C - action must be taken immediately + +=item * + +C - critical conditions + +=item * + +C<-LOG_ERR> - error conditions + +=item * + +C - warning conditions + +=item * + +C - normal, but significant, condition + +=item * + +C - informational message + +=item * + +C - debug-level message + +=back + + +=head1 DIAGNOSTICS + +=over 4 + +=item Invalid argument passed to setlogsock + +B<(F)> You gave C an invalid value for C<$sock_type>. + +=item no connection to syslog available + +B<(F)> C failed to connect to the specified socket. + +=item stream passed to setlogsock, but %s is not writable + +B<(F)> You asked C to use a stream socket, but the given +path is not writable. + +=item stream passed to setlogsock, but could not find any device + +B<(F)> You asked C to use a stream socket, but didn't +provide a path, and C was unable to find an appropriate one. + +=item tcp passed to setlogsock, but tcp service unavailable + +B<(F)> You asked C to use a TCP socket, but the service +is not available on the system. + +=item syslog: expecting argument %s + +B<(F)> You forgot to give C the indicated argument. + +=item syslog: invalid level/facility: %s + +B<(F)> You specified an invalid level or facility, like C +(which is reserved to the kernel). + +=item syslog: too many levels given: %s + +B<(F)> You specified too many levels. + +=item syslog: too many facilities given: %s + +B<(F)> You specified too many facilities. + +=item syslog: level must be given + +B<(F)> You forgot to specify a level. + +=item udp passed to setlogsock, but udp service unavailable + +B<(F)> You asked C to use a UDP socket, but the service +is not available on the system. + +=item unix passed to setlogsock, but path not available + +B<(F)> You asked C to use a UNIX socket, but C +was unable to find an appropriate an appropriate device. + +=back + + =head1 SEE ALSO L + =head1 AUTHOR Tom Christiansen EFE and Larry Wall @@ -157,16 +339,63 @@ EFE. UNIX domain sockets added by Sean Robinson EFE with support from Tim Bunce -EFE and the perl5-porters mailing list. +EFE and the C mailing list. Dependency on F replaced with XS code by Tom Hughes EFE. -Code for constant()s regenerated by Nicholas Clark EFE. +Code for Cs regenerated by Nicholas Clark EFE. Failover to different communication modes by Nick Williams EFE. +Extracted from core distribution for publishing on the CPAN by +SEbastien Aperghis-Tramoni Esebastien@aperghis.netE. + + +=head1 BUGS + +Please report any bugs or feature requests to +C, or through the web interface at +L. +I will be notified, and then you'll automatically be notified of progress on +your bug as I make changes. + + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc Sys::Syslog + +You can also look for information at: + +=over 4 + +=item * AnnoCPAN: Annotated CPAN documentation + +L + +=item * CPAN Ratings + +L + +=item * RT: CPAN's request tracker + +L + +=item * Search CPAN + +L + +=back + + +=head1 LICENSE + +This program is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + =cut sub AUTOLOAD { @@ -232,11 +461,11 @@ sub setlogsock { last; } } - carp "stream passed to setlogsock, but could not find any device" + croak "stream passed to setlogsock, but could not find any device" unless defined $syslog_path; } unless (-w $syslog_path) { - carp "stream passed to setlogsock, but $syslog_path is not writable"; + croak "stream passed to setlogsock, but $syslog_path is not writable"; return undef; } else { @connectMethods = ( 'stream' ); @@ -246,21 +475,21 @@ sub setlogsock { $syslog_path = _PATH_LOG(); @connectMethods = ( 'unix' ); } else { - carp 'unix passed to setlogsock, but path not available'; + croak 'unix passed to setlogsock, but path not available'; return undef; } } elsif (lc($setsock) eq 'tcp') { if (getservbyname('syslog', 'tcp') || getservbyname('syslogng', 'tcp')) { @connectMethods = ( 'tcp' ); } else { - carp "tcp passed to setlogsock, but tcp service unavailable"; + croak "tcp passed to setlogsock, but tcp service unavailable"; return undef; } } elsif (lc($setsock) eq 'udp') { if (getservbyname('syslog', 'udp')) { @connectMethods = ( 'udp' ); } else { - carp "udp passed to setlogsock, but udp service unavailable"; + croak "udp passed to setlogsock, but udp service unavailable"; return undef; } } elsif (lc($setsock) eq 'inet') { @@ -268,7 +497,7 @@ sub setlogsock { } elsif (lc($setsock) eq 'console') { @connectMethods = ( 'console' ); } else { - carp "Invalid argument passed to setlogsock; must be 'stream', 'unix', 'tcp', 'udp' or 'inet'"; + croak "Invalid argument passed to setlogsock; must be 'stream', 'unix', 'tcp', 'udp' or 'inet'"; } return 1; } @@ -415,6 +644,7 @@ sub _syslog_send_stream { # To be correct, it should use a STREAMS API, but perl doesn't have one. return syswrite(SYSLOG, $buf, length($buf)); } + sub _syslog_send_socket { my ($buf) = @_; return syswrite(SYSLOG, $buf, length($buf)); diff --git a/ext/Sys/Syslog/fallback/const-c.inc b/ext/Sys/Syslog/fallback/const-c.inc new file mode 100644 index 0000000..b0a08bd --- /dev/null +++ b/ext/Sys/Syslog/fallback/const-c.inc @@ -0,0 +1,559 @@ +#define PERL_constant_NOTFOUND 1 +#define PERL_constant_NOTDEF 2 +#define PERL_constant_ISIV 3 +#define PERL_constant_ISNO 4 +#define PERL_constant_ISNV 5 +#define PERL_constant_ISPV 6 +#define PERL_constant_ISPVN 7 +#define PERL_constant_ISSV 8 +#define PERL_constant_ISUNDEF 9 +#define PERL_constant_ISUV 10 +#define PERL_constant_ISYES 11 + +#ifndef NVTYPE +typedef double NV; /* 5.6 and later define NVTYPE, and typedef NV to it. */ +#endif +#ifndef aTHX_ +#define aTHX_ /* 5.6 or later define this for threading support. */ +#endif +#ifndef pTHX_ +#define pTHX_ /* 5.6 or later define this for threading support. */ +#endif + +static int +constant_7 (pTHX_ const char *name, IV *iv_return) { + /* When generated this function returned values for the list of names given + here. However, subsequent manual editing may have added or removed some. + LOG_ERR LOG_FTP LOG_LPR LOG_PID */ + /* Offset 4 gives the best switch position. */ + switch (name[4]) { + case 'E': + if (memEQ(name, "LOG_ERR", 7)) { + /* ^ */ +#ifdef LOG_ERR + *iv_return = LOG_ERR; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'F': + if (memEQ(name, "LOG_FTP", 7)) { + /* ^ */ +#ifdef LOG_FTP + *iv_return = LOG_FTP; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'L': + if (memEQ(name, "LOG_LPR", 7)) { + /* ^ */ +#ifdef LOG_LPR + *iv_return = LOG_LPR; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'P': + if (memEQ(name, "LOG_PID", 7)) { + /* ^ */ +#ifdef LOG_PID + *iv_return = LOG_PID; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + } + return PERL_constant_NOTFOUND; +} + +static int +constant_8 (pTHX_ const char *name, IV *iv_return) { + /* When generated this function returned values for the list of names given + here. However, subsequent manual editing may have added or removed some. + LOG_AUTH LOG_CONS LOG_CRIT LOG_CRON LOG_INFO LOG_KERN LOG_LFMT LOG_MAIL + LOG_NEWS LOG_USER LOG_UUCP */ + /* Offset 6 gives the best switch position. */ + switch (name[6]) { + case 'C': + if (memEQ(name, "LOG_UUCP", 8)) { + /* ^ */ +#ifdef LOG_UUCP + *iv_return = LOG_UUCP; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'E': + if (memEQ(name, "LOG_USER", 8)) { + /* ^ */ +#ifdef LOG_USER + *iv_return = LOG_USER; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'F': + if (memEQ(name, "LOG_INFO", 8)) { + /* ^ */ +#ifdef LOG_INFO + *iv_return = LOG_INFO; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'I': + if (memEQ(name, "LOG_CRIT", 8)) { + /* ^ */ +#ifdef LOG_CRIT + *iv_return = LOG_CRIT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "LOG_MAIL", 8)) { + /* ^ */ +#ifdef LOG_MAIL + *iv_return = LOG_MAIL; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'M': + if (memEQ(name, "LOG_LFMT", 8)) { + /* ^ */ +#ifdef LOG_LFMT + *iv_return = LOG_LFMT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'N': + if (memEQ(name, "LOG_CONS", 8)) { + /* ^ */ +#ifdef LOG_CONS + *iv_return = LOG_CONS; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'O': + if (memEQ(name, "LOG_CRON", 8)) { + /* ^ */ +#ifdef LOG_CRON + *iv_return = LOG_CRON; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'R': + if (memEQ(name, "LOG_KERN", 8)) { + /* ^ */ +#ifdef LOG_KERN + *iv_return = LOG_KERN; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'T': + if (memEQ(name, "LOG_AUTH", 8)) { + /* ^ */ +#ifdef LOG_AUTH + *iv_return = LOG_AUTH; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'W': + if (memEQ(name, "LOG_NEWS", 8)) { + /* ^ */ +#ifdef LOG_NEWS + *iv_return = LOG_NEWS; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + } + return PERL_constant_NOTFOUND; +} + +static int +constant_9 (pTHX_ const char *name, IV *iv_return, const char **pv_return) { + /* When generated this function returned values for the list of names given + here. However, subsequent manual editing may have added or removed some. + LOG_ALERT LOG_DEBUG LOG_EMERG _PATH_LOG */ + /* Offset 4 gives the best switch position. */ + switch (name[4]) { + case 'A': + if (memEQ(name, "LOG_ALERT", 9)) { + /* ^ */ +#ifdef LOG_ALERT + *iv_return = LOG_ALERT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'D': + if (memEQ(name, "LOG_DEBUG", 9)) { + /* ^ */ +#ifdef LOG_DEBUG + *iv_return = LOG_DEBUG; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'E': + if (memEQ(name, "LOG_EMERG", 9)) { + /* ^ */ +#ifdef LOG_EMERG + *iv_return = LOG_EMERG; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'H': + if (memEQ(name, "_PATH_LOG", 9)) { + /* ^ */ +#ifdef _PATH_LOG + *pv_return = _PATH_LOG; + return PERL_constant_ISPV; +#else + *pv_return = "/dev/log"; + return PERL_constant_ISPV; +#endif + } + break; + } + return PERL_constant_NOTFOUND; +} + +static int +constant_10 (pTHX_ const char *name, IV *iv_return) { + /* When generated this function returned values for the list of names given + here. However, subsequent manual editing may have added or removed some. + LOG_DAEMON LOG_LOCAL0 LOG_LOCAL1 LOG_LOCAL2 LOG_LOCAL3 LOG_LOCAL4 + LOG_LOCAL5 LOG_LOCAL6 LOG_LOCAL7 LOG_NDELAY LOG_NOTICE LOG_NOWAIT + LOG_ODELAY LOG_PERROR LOG_SYSLOG */ + /* Offset 9 gives the best switch position. */ + switch (name[9]) { + case '0': + if (memEQ(name, "LOG_LOCAL", 9)) { + /* 0 */ +#ifdef LOG_LOCAL0 + *iv_return = LOG_LOCAL0; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case '1': + if (memEQ(name, "LOG_LOCAL", 9)) { + /* 1 */ +#ifdef LOG_LOCAL1 + *iv_return = LOG_LOCAL1; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case '2': + if (memEQ(name, "LOG_LOCAL", 9)) { + /* 2 */ +#ifdef LOG_LOCAL2 + *iv_return = LOG_LOCAL2; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case '3': + if (memEQ(name, "LOG_LOCAL", 9)) { + /* 3 */ +#ifdef LOG_LOCAL3 + *iv_return = LOG_LOCAL3; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case '4': + if (memEQ(name, "LOG_LOCAL", 9)) { + /* 4 */ +#ifdef LOG_LOCAL4 + *iv_return = LOG_LOCAL4; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case '5': + if (memEQ(name, "LOG_LOCAL", 9)) { + /* 5 */ +#ifdef LOG_LOCAL5 + *iv_return = LOG_LOCAL5; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case '6': + if (memEQ(name, "LOG_LOCAL", 9)) { + /* 6 */ +#ifdef LOG_LOCAL6 + *iv_return = LOG_LOCAL6; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case '7': + if (memEQ(name, "LOG_LOCAL", 9)) { + /* 7 */ +#ifdef LOG_LOCAL7 + *iv_return = LOG_LOCAL7; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'E': + if (memEQ(name, "LOG_NOTIC", 9)) { + /* E */ +#ifdef LOG_NOTICE + *iv_return = LOG_NOTICE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'G': + if (memEQ(name, "LOG_SYSLO", 9)) { + /* G */ +#ifdef LOG_SYSLOG + *iv_return = LOG_SYSLOG; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'N': + if (memEQ(name, "LOG_DAEMO", 9)) { + /* N */ +#ifdef LOG_DAEMON + *iv_return = LOG_DAEMON; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'R': + if (memEQ(name, "LOG_PERRO", 9)) { + /* R */ +#ifdef LOG_PERROR + *iv_return = LOG_PERROR; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'T': + if (memEQ(name, "LOG_NOWAI", 9)) { + /* T */ +#ifdef LOG_NOWAIT + *iv_return = LOG_NOWAIT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'Y': + if (memEQ(name, "LOG_NDELA", 9)) { + /* Y */ +#ifdef LOG_NDELAY + *iv_return = LOG_NDELAY; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "LOG_ODELA", 9)) { + /* Y */ +#ifdef LOG_ODELAY + *iv_return = LOG_ODELAY; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + } + return PERL_constant_NOTFOUND; +} + +static int +constant_11 (pTHX_ const char *name, IV *iv_return) { + /* When generated this function returned values for the list of names given + here. However, subsequent manual editing may have added or removed some. + LOG_FACMASK LOG_PRIMASK LOG_WARNING */ + /* Offset 6 gives the best switch position. */ + switch (name[6]) { + case 'C': + if (memEQ(name, "LOG_FACMASK", 11)) { + /* ^ */ +#ifdef LOG_FACMASK + *iv_return = LOG_FACMASK; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'I': + if (memEQ(name, "LOG_PRIMASK", 11)) { + /* ^ */ +#ifdef LOG_PRIMASK + *iv_return = LOG_PRIMASK; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'R': + if (memEQ(name, "LOG_WARNING", 11)) { + /* ^ */ +#ifdef LOG_WARNING + *iv_return = LOG_WARNING; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + } + return PERL_constant_NOTFOUND; +} + +static int +constant (pTHX_ const char *name, STRLEN len, IV *iv_return, const char **pv_return) { + /* Initially switch on the length of the name. */ + /* When generated this function returned values for the list of names given + in this section of perl code. Rather than manually editing these functions + to add or remove constants, which would result in this comment and section + of code becoming inaccurate, we recommend that you edit this section of + code, and use it to regenerate a new set of constant functions which you + then use to replace the originals. + + Regenerate these constant functions by feeding this entire source file to + perl -x + +#!/usr/bin/perl5.8.5 -w +use ExtUtils::Constant qw (constant_types C_constant XS_constant); + +my $types = {map {($_, 1)} qw(IV PV)}; +my @names = (qw(LOG_ALERT LOG_AUTH LOG_AUTHPRIV LOG_CONS LOG_CRIT LOG_CRON + LOG_DAEMON LOG_DEBUG LOG_EMERG LOG_ERR LOG_FACMASK LOG_FTP + LOG_INFO LOG_KERN LOG_LFMT LOG_LOCAL0 LOG_LOCAL1 LOG_LOCAL2 + LOG_LOCAL3 LOG_LOCAL4 LOG_LOCAL5 LOG_LOCAL6 LOG_LOCAL7 LOG_LPR + LOG_MAIL LOG_NDELAY LOG_NEWS LOG_NFACILITIES LOG_NOTICE + LOG_NOWAIT LOG_ODELAY LOG_PERROR LOG_PID LOG_PRIMASK LOG_SYSLOG + LOG_USER LOG_UUCP LOG_WARNING), + {name=>"_PATH_LOG", type=>"PV", default=>["PV", "\"/dev/log\""]}); + +print constant_types(); # macro defs +foreach (C_constant ("Sys::Syslog", 'constant', 'IV', $types, undef, 3, @names) ) { + print $_, "\n"; # C constant subs +} +print "#### XS Section:\n"; +print XS_constant ("Sys::Syslog", $types); +__END__ + */ + + switch (len) { + case 7: + return constant_7 (aTHX_ name, iv_return); + break; + case 8: + return constant_8 (aTHX_ name, iv_return); + break; + case 9: + return constant_9 (aTHX_ name, iv_return, pv_return); + break; + case 10: + return constant_10 (aTHX_ name, iv_return); + break; + case 11: + return constant_11 (aTHX_ name, iv_return); + break; + case 12: + if (memEQ(name, "LOG_AUTHPRIV", 12)) { +#ifdef LOG_AUTHPRIV + *iv_return = LOG_AUTHPRIV; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 15: + if (memEQ(name, "LOG_NFACILITIES", 15)) { +#ifdef LOG_NFACILITIES + *iv_return = LOG_NFACILITIES; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + } + return PERL_constant_NOTFOUND; +} + diff --git a/ext/Sys/Syslog/fallback/const-xs.inc b/ext/Sys/Syslog/fallback/const-xs.inc new file mode 100644 index 0000000..4da6b66 --- /dev/null +++ b/ext/Sys/Syslog/fallback/const-xs.inc @@ -0,0 +1,87 @@ +void +constant(sv) + PREINIT: +#ifdef dXSTARG + dXSTARG; /* Faster if we have it. */ +#else + dTARGET; +#endif + STRLEN len; + int type; + IV iv; + /* NV nv; Uncomment this if you need to return NVs */ + const char *pv; + INPUT: + SV * sv; + const char * s = SvPV(sv, len); + PPCODE: + /* Change this to constant(aTHX_ s, len, &iv, &nv); + if you need to return both NVs and IVs */ + type = constant(aTHX_ s, len, &iv, &pv); + /* Return 1 or 2 items. First is error message, or undef if no error. + Second, if present, is found value */ + switch (type) { + case PERL_constant_NOTFOUND: + sv = sv_2mortal(newSVpvf("%s is not a valid Sys::Syslog macro", s)); + PUSHs(sv); + break; + case PERL_constant_NOTDEF: + sv = sv_2mortal(newSVpvf( + "Your vendor has not defined Sys::Syslog macro %s, used", s)); + PUSHs(sv); + break; + case PERL_constant_ISIV: + EXTEND(SP, 1); + PUSHs(&PL_sv_undef); + PUSHi(iv); + break; + /* Uncomment this if you need to return NOs + case PERL_constant_ISNO: + EXTEND(SP, 1); + PUSHs(&PL_sv_undef); + PUSHs(&PL_sv_no); + break; */ + /* Uncomment this if you need to return NVs + case PERL_constant_ISNV: + EXTEND(SP, 1); + PUSHs(&PL_sv_undef); + PUSHn(nv); + break; */ + case PERL_constant_ISPV: + EXTEND(SP, 1); + PUSHs(&PL_sv_undef); + PUSHp(pv, strlen(pv)); + break; + /* Uncomment this if you need to return PVNs + case PERL_constant_ISPVN: + EXTEND(SP, 1); + PUSHs(&PL_sv_undef); + PUSHp(pv, iv); + break; */ + /* Uncomment this if you need to return SVs + case PERL_constant_ISSV: + EXTEND(SP, 1); + PUSHs(&PL_sv_undef); + PUSHs(sv); + break; */ + /* Uncomment this if you need to return UNDEFs + case PERL_constant_ISUNDEF: + break; */ + /* Uncomment this if you need to return UVs + case PERL_constant_ISUV: + EXTEND(SP, 1); + PUSHs(&PL_sv_undef); + PUSHu((UV)iv); + break; */ + /* Uncomment this if you need to return YESs + case PERL_constant_ISYES: + EXTEND(SP, 1); + PUSHs(&PL_sv_undef); + PUSHs(&PL_sv_yes); + break; */ + default: + sv = sv_2mortal(newSVpvf( + "Unexpected return type %d while processing Sys::Syslog macro %s, used", + type, s)); + PUSHs(sv); + } diff --git a/ext/Sys/Syslog/t/00-load.t b/ext/Sys/Syslog/t/00-load.t new file mode 100644 index 0000000..d832b70 --- /dev/null +++ b/ext/Sys/Syslog/t/00-load.t @@ -0,0 +1,9 @@ +#!perl -T + +use Test::More tests => 1; + +BEGIN { + use_ok( 'Sys::Syslog' ); +} + +diag( "Testing Sys::Syslog $Sys::Syslog::VERSION, Perl $], $^X" ); diff --git a/ext/Sys/Syslog/t/constants.t b/ext/Sys/Syslog/t/constants.t new file mode 100644 index 0000000..061d018 --- /dev/null +++ b/ext/Sys/Syslog/t/constants.t @@ -0,0 +1,46 @@ +#!/usr/bin/perl -T +use strict; +use Test::More; +my @names; +BEGIN { + if(open(MACROS, 'macros.all')) { + @names = map {chomp;$_} ; + close(MACROS); + plan tests => @names + 3; + } else { + plan skip_all => "can't read 'macros.all': $!" + } +} +use Sys::Syslog; + +eval "use Test::Exception"; my $has_test_exception = !$@; + +# Testing error messages +SKIP: { + skip "Test::Exception not available", 1 unless $has_test_exception; + + # constant() errors + throws_ok(sub { + Sys::Syslog::constant() + }, '/^Usage: Sys::Syslog::constant\(sv\)/', + "calling constant() with no argument"); +} + +# Testing constant() +like( Sys::Syslog::constant('This'), + '/^This is not a valid Sys::Syslog macro/', + "calling constant() with a non existing name" ); + +like( Sys::Syslog::constant('NOSUCHNAME'), + '/^NOSUCHNAME is not a valid Sys::Syslog macro/', + "calling constant() with a non existing name" ); + +# Testing all macros +if(@names) { + for my $name (@names) { + like( Sys::Syslog::constant($name), + '/^(?:\d+|Your vendor has not defined Sys::Syslog macro '.$name.', used)$/', + "checking that $name is a number (".Sys::Syslog::constant($name).")" ); + } +} + diff --git a/ext/Sys/Syslog/t/distchk.t b/ext/Sys/Syslog/t/distchk.t new file mode 100644 index 0000000..2db740b --- /dev/null +++ b/ext/Sys/Syslog/t/distchk.t @@ -0,0 +1,4 @@ +use strict; +use Test::More; +eval "use Test::Distribution not => [qw(versions podcover use)]"; +plan skip_all => "Test::Distribution required for checking distribution" if $@; diff --git a/ext/Sys/Syslog/t/pod.t b/ext/Sys/Syslog/t/pod.t new file mode 100644 index 0000000..976d7cd --- /dev/null +++ b/ext/Sys/Syslog/t/pod.t @@ -0,0 +1,6 @@ +#!perl -T + +use Test::More; +eval "use Test::Pod 1.14"; +plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; +all_pod_files_ok(); diff --git a/ext/Sys/Syslog/t/podcover.t b/ext/Sys/Syslog/t/podcover.t new file mode 100644 index 0000000..a33cb85 --- /dev/null +++ b/ext/Sys/Syslog/t/podcover.t @@ -0,0 +1,6 @@ +#!/usr/bin/perl -T +use strict; +use Test::More; +eval "use Test::Pod::Coverage 1.06"; +plan skip_all => "Test::Pod::Coverage 1.06 required for testing POD coverage" if $@; +all_pod_coverage_ok({also_private => [qw(^constant$ ^connect ^disconnect$ ^xlate$ ^LOG_)]}); diff --git a/ext/Sys/Syslog/t/podspell.t b/ext/Sys/Syslog/t/podspell.t new file mode 100644 index 0000000..2120d41 --- /dev/null +++ b/ext/Sys/Syslog/t/podspell.t @@ -0,0 +1,55 @@ +#!/usr/bin/perl +use strict; +use Test::More; +eval "use Test::Spelling"; +plan skip_all => "Test::Spelling required for testing POD spell" if $@; +set_spell_cmd('aspell -l --lang=en'); +add_stopwords(); +all_pod_files_spelling_ok(); + +__END__ + +SAPER +Sébastien +Aperghis +Tramoni +Christiansen +AnnoCPAN +CPAN +README +TODO +AUTOLOADER +API +arrayref +arrayrefs +hashref +hashrefs +lookup +hostname +loopback +netmask +timestamp +INET +BPF +IP +TCP +tcp +UDP +udp +UUCP +FDDI +Firewire +HDLC +IEEE +IrDA +LocalTalk +PPP +unix +Solaris +IRIX +endianness +failover +Failover +logopts +pathname +syslogd diff --git a/ext/Sys/Syslog/t/portfs.t b/ext/Sys/Syslog/t/portfs.t new file mode 100644 index 0000000..80d57b0 --- /dev/null +++ b/ext/Sys/Syslog/t/portfs.t @@ -0,0 +1,8 @@ +#!/usr/bin/perl -T +use strict; +use Test::More; +eval "use Test::Portability::Files"; +plan skip_all => "Test::Portability::Files required for testing filenames portability" if $@; + +# run the selected tests +run_tests(); diff --git a/ext/Sys/Syslog/t/syslog.t b/ext/Sys/Syslog/t/syslog.t index 8f038d3..4f9ef8e 100755 --- a/ext/Sys/Syslog/t/syslog.t +++ b/ext/Sys/Syslog/t/syslog.t @@ -1,94 +1,94 @@ -#!./perl +#!/usr/bin/perl -T BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; - require Config; import Config; - if ($Config{'extensions'} !~ /\bSyslog\b/) { - print "1..0 # Skip: Sys::Syslog was not built\n"; - exit 0; - } - if ($Config{'extensions'} !~ /\bSocket\b/) { - print "1..0 # Skip: Socket was not built\n"; - exit 0; + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; } +} - require Socket; +use strict; +use Test::More; +use Config; - # This code inspired by Sys::Syslog::connect(): - require Sys::Hostname; - my ($host_uniq) = Sys::Hostname::hostname(); - my ($host) = $host_uniq =~ /([A-Za-z0-9_.-]+)/; +# check that the module is at least available +plan skip_all => "Sys::Syslog was not build" + unless $Config{'extensions'} =~ /\bSyslog\b/; - if (! defined Socket::inet_aton($host)) { - print "1..0 # Skip: Can't lookup $host\n"; - exit 0; - } -} +# we also need Socket +plan skip_all => "Socket was not build" + unless $Config{'extensions'} =~ /\bSocket\b/; BEGIN { - eval {require Sys::Syslog} or do { - if ($@ =~ /Your vendor has not/) { - print "1..0 # Skip: missing macros\n"; - exit 0; - } - } + plan tests => 16; + + # ok, now loads them + eval 'use Socket'; + use_ok('Sys::Syslog', ':DEFAULT', 'setlogsock'); } -use Sys::Syslog qw(:DEFAULT setlogsock); - -# Test this to 1 if your syslog accepts udp connections. -# Most don't (or at least shouldn't) -my $Test_Syslog_INET = 0; - -my $test_string = "uid $< is testing perl $] syslog capabilities"; - -print "1..6\n"; - -if (Sys::Syslog::_PATH_LOG()) { - if (-e Sys::Syslog::_PATH_LOG()) { - # The only known $^O eq 'svr4' that needs this is NCR MP-RAS, - # but assuming 'stream' in SVR4 is probably not that bad. - if ($^O =~ /^(solaris|irix|svr4|powerux)$/) { - # we should check for stream support here, not for solaris/irix - print defined(eval { setlogsock('stream') }) ? "ok 1\n" : "not ok 1 # $!\n"; - } else { - print defined(eval { setlogsock('unix') }) ? "ok 1\n" : "not ok 1 # $!\n"; - } - if (defined(eval { openlog('perl', 'ndelay', 'local0') })) { - print "ok 2\n"; - print defined(eval { syslog('info', $test_string ) }) - ? "ok 3\n" : "not ok 3 # $!\n"; - } else { - if ($@ =~ /no connection to syslog available/) { - print "ok 2 # Skip: syslogd not running\n"; - } else { - print "not ok 2 # $@\n"; - } - print "ok 3 # Skip: openlog failed\n"; - } - } else { - for (1..3) { - print - "ok $_ # Skip: file ", - Sys::Syslog::_PATH_LOG(), - " does not exist\n"; - } +# check that the documented functions are correctly provided +can_ok( 'Sys::Syslog' => qw(openlog syslog syslog setlogmask setlogsock closelog) ); + + +# check the diagnostics +# setlogsock() +eval { setlogsock() }; +like( $@, qr/^Invalid argument passed to setlogsock; must be 'stream', 'unix', 'tcp', 'udp' or 'inet'/, + "calling setlogsock() with no argument" ); + +# syslog() +eval { syslog() }; +like( $@, qr/^syslog: expecting argument \$priority/, + "calling syslog() with no argument" ); + +my $test_string = "uid $< is testing Perl $] syslog(3) capabilities"; +my $r = 0; + +# try to test using a Unix socket +SKIP: { + skip "can't connect to Unix socket: _PATH_LOG unavailable", 6 + unless -e Sys::Syslog::_PATH_LOG(); + + # The only known $^O eq 'svr4' that needs this is NCR MP-RAS, + # but assuming 'stream' in SVR4 is probably not that bad. + my $sock_type = $^O =~ /^(solaris|irix|svr4|powerux)$/ ? 'stream' : 'unix'; + + eval { setlogsock($sock_type) }; + is( $@, '', "setlogsock() called with '$sock_type'" ); + TODO: { + local $TODO = "minor bug"; + ok( $r, "setlogsock() should return true but returned '$r'" ); } -} -else { - for (1..3) { print "ok $_ # Skip: _PATH_LOG unavailable\n" } -} -if( $Test_Syslog_INET ) { - print defined(eval { setlogsock('inet') }) ? "ok 4\n" - : "not ok 4\n"; - print defined(eval { openlog('perl', 'ndelay', 'local0') }) ? "ok 5\n" - : "not ok 5 # $!\n"; - print defined(eval { syslog('info', $test_string ) }) ? "ok 6\n" - : "not ok 6 # $!\n"; + SKIP: { + $r = eval { openlog('perl', 'ndelay', 'local0') }; + skip "can't connect to syslog", 4 if $@ =~ /^no connection to syslog available/; + is( $@, '', "openlog()" ); + ok( $r, "openlog() should return true but returned '$r'" ); + + $r = eval { syslog('info', "$test_string by connecting to a Unix socket") }; + is( $@, '', "syslog()" ); + ok( $r, "syslog() should return true but returned '$r'" ); + } } -else { - print "ok $_ # Skip: assuming syslog doesn't accept inet connections\n" - foreach (4..6); + +# try to test using a INET socket +SKIP: { + skip "assuming syslog doesn't accept inet connections", 6 if 1; + + my $sock_type = 'inet'; + + $r = eval { setlogsock('inet') }; + is( $@, '', "setlogsock() called with '$sock_type'" ); + ok( $r, "setlogsock() should return true but returned '$r'" ); + + $r = eval { openlog('perl', 'ndelay', 'local0') }; + is( $@, '', "openlog()" ); + ok( $r, " -> should return true but returned '$r'" ); + + $r = eval { syslog('info', "$test_string by connecting to a INET socket") }; + is( $@, '', "syslog()" ); + ok( $r, " -> should return true but returned '$r'" ); } +