From: Sébastien Aperghis-Tramoni Date: Sun, 4 Nov 2007 03:52:36 +0000 (+0100) Subject: Re: (perl-current of 5.9.5) patch for ext/Sys/Syslog/Makefile.PL for X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=35a209d11010ccd56ab11d21f8c2a8bdee2ea914;p=p5sagit%2Fp5-mst-13.2.git Re: (perl-current of 5.9.5) patch for ext/Sys/Syslog/Makefile.PL for Message-id: p4raw-id: //depot/perl@32221 --- diff --git a/ext/Sys/Syslog/Changes b/ext/Sys/Syslog/Changes index 870a2e9..2ad5956 100644 --- a/ext/Sys/Syslog/Changes +++ b/ext/Sys/Syslog/Changes @@ -1,8 +1,17 @@ Revision history for Sys-Syslog +0.22 -- 2007.11.xx -- Sebastien Aperghis-Tramoni (SAPER) + [FEATURE] Added support for PERROR option. + [FEATURE] Support for SYSLOG on z/OS, thanks to Chun Bing Ge. + [CODE] Prevent $@ from being visible outside the module, in trying + to address the problem reported in CPAN-RT#29875. + [DOC] CPAN-RT#29451: Add Copyright notice. Thanks to Allison Randal + for her advice. + [DOC] New speaking about Win32 API instead of Win32 operating system. + 0.21 -- 2007.09.14 -- Sebastien Aperghis-Tramoni (SAPER) [BUGFIX] setlogsock(eventlog) returned true even when it shouldn't have. - [BUGFIX] Added workaround for Mac OS X syslogd. + [BUGFIX] CPAN-RT#24431: Added workaround for Mac OS X syslogd. [FEATURE] Added "pipe" mechanism in order to support HP-UX named pipe. Thanks to H.Merijn Brand and PROCURA. [CODE] Sys::Syslog works again on Perl 5.005, thanks to Nicholas Clark. diff --git a/ext/Sys/Syslog/Makefile.PL b/ext/Sys/Syslog/Makefile.PL index 2c60688..277fff8 100644 --- a/ext/Sys/Syslog/Makefile.PL +++ b/ext/Sys/Syslog/Makefile.PL @@ -108,7 +108,7 @@ elsif (-p "/dev/log" and -w _) { # On HP-UX, /dev/log isn't a unix domain socket but a named pipe. $_PATH_LOG = "/dev/log"; } -elsif (-S "/dev/log" and -w _) { +elsif ((-S "/dev/log" or -c _) and -w _) { # Most unixes have a unix domain socket /dev/log. $_PATH_LOG = "/dev/log"; } diff --git a/ext/Sys/Syslog/Syslog.pm b/ext/Sys/Syslog/Syslog.pm index 4a5a985..2a86283 100644 --- a/ext/Sys/Syslog/Syslog.pm +++ b/ext/Sys/Syslog/Syslog.pm @@ -94,6 +94,7 @@ my %options = ( ndelay => 0, nofatal => 0, nowait => 0, + perror => 0, pid => 0, ); @@ -106,14 +107,15 @@ if ($^O =~ /^(freebsd|linux)$/) { # use EventLog on Win32 my $is_Win32 = $^O =~ /Win32/i; -eval "use Sys::Syslog::Win32"; -if (not $@) { +if (eval "use Sys::Syslog::Win32; 1") { unshift @connectMethods, 'eventlog'; } elsif ($is_Win32) { warn $@; } +$@ = ""; + my @defaultMethods = @connectMethods; my @fallbackMethods = (); @@ -233,7 +235,8 @@ sub setlogsock { if (eval "use Win32::EventLog; 1") { @connectMethods = qw(eventlog); } else { - warnings::warnif "eventlog passed to setlogsock, but operating system isn't Win32-compatible"; + warnings::warnif "eventlog passed to setlogsock, but no Win32 API available"; + $@ = ""; return undef; } @@ -326,11 +329,11 @@ sub syslog { $message = @_ ? sprintf($mask, @_) : $mask; # See CPAN-RT#24431. Opened on Apple Radar as bug #4944407 on 2007.01.21 + # Supposedly resolved on Leopard. chomp $message if $^O =~ /darwin/; if ($current_proto eq 'native') { $buf = $message; - } elsif ($current_proto eq 'eventlog') { $buf = $message; @@ -347,6 +350,15 @@ sub syslog { $buf = "<$sum>$timestamp $whoami: $message\0"; } + # handle PERROR option + # "native" mechanism already handles it by itself + if ($options{perror} and $current_proto ne 'native') { + chomp $message; + my $whoami = $ident; + $whoami .= "[$$]" if $options{pid}; + print STDERR "$whoami: $message\n"; + } + # it's possible that we'll get an error from sending # (e.g. if method is UDP and there is no UDP listener, # then we'll get ECONNREFUSED on the send). So what we @@ -454,7 +466,8 @@ sub xlate { $name = "Sys::Syslog::$name"; # Can't have just eval { &$name } || -1 because some LOG_XXX may be zero. my $value = eval { no strict 'refs'; &$name }; - defined $value ? $value : -1; + $@ = ""; + return defined $value ? $value : -1; } @@ -532,6 +545,7 @@ sub connect_tcp { # These constants don't exist in 5.005. They were added in 1999 setsockopt(SYSLOG, IPPROTO_TCP(), TCP_NODELAY(), 1); } + $@ = ""; if (!connect(SYSLOG, $addr)) { push @$errs, "tcp connect: $!"; return 0; @@ -638,7 +652,7 @@ sub connect_unix { return 0; } - if (! -S $syslog_path) { + if (not (-S $syslog_path or -c _)) { push @$errs, "$syslog_path is not a socket"; return 0; } @@ -854,6 +868,11 @@ process, so this option has no effect on Linux.) =item * +C - Write the message to standard error output as well to the +system log. + +=item * + C - Include PID with each message. =back @@ -1003,8 +1022,8 @@ When this calling method is used, the array should contain a list of mechanisms which are attempted in order. The default is to try C, C, C, C, C, C. -Under Win32 systems, C will be added as the first mechanism to try -if C is available. +Under systems with the Win32 API, C will be added as the first +mechanism to try if C is available. Giving an invalid value for C<$sock_type> will C. @@ -1247,11 +1266,11 @@ C - debug-level message B<(F)> You gave C an invalid value for C<$sock_type>. -=item C +=item C B<(W)> You asked C to use the Win32 event logger but the operating system running the program isn't Win32 or does not provides Win32 -facilities. +compatible facilities. =item C @@ -1387,7 +1406,7 @@ debug and polish C under Cygwin. Please report any bugs or feature requests to C, or through the web interface at -L. +L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. @@ -1429,6 +1448,11 @@ L =back +=head1 COPYRIGHT + +Copyright (C) 1990-2007 by Larry Wall and others. + + =head1 LICENSE This program is free software; you can redistribute it and/or modify it