Re: (perl-current of 5.9.5) patch for ext/Sys/Syslog/Makefile.PL for

Message-id: <EECD3531-8352-4873-A1AD-E4B8731260CB@free.fr>

p4raw-id: //depot/perl@32221

3 files changed, 46 insertions, 13 deletions

diff --git a/ext/Sys/Syslog/Changes b/ext/Sys/Syslog/Changes
index 870a2e9b0b..2ad59565b5 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 2c6068842f..277fff8411 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 4a5a985658..2a86283179 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<perror> - Write the message to standard error output as well to the
+system log.
+
+=item *
+
 C<pid> - 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<native>, C<tcp>, C<udp>, C<unix>, C<stream>, C<console>.
-Under Win32 systems, C<eventlog> will be added as the first mechanism to try 
-if C<Win32::EventLog> is available.
+Under systems with the Win32 API, C<eventlog> will be added as the first 
+mechanism to try if C<Win32::EventLog> is available.
 
 Giving an invalid value for C<$sock_type> will C<croak>.
 
@@ -1247,11 +1266,11 @@ C<LOG_DEBUG> - debug-level message
 
 B<(F)> You gave C<setlogsock()> an invalid value for C<$sock_type>. 
 
-=item C<eventlog passed to setlogsock, but operating system isn't Win32-compatible>
+=item C<eventlog passed to setlogsock, but no Win32 API available>
 
 B<(W)> You asked C<setlogsock()> 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<no connection to syslog available>
 
@@ -1387,7 +1406,7 @@ debug and polish C<Sys::Syslog> under Cygwin.
 
 Please report any bugs or feature requests to
 C<bug-sys-syslog (at) rt.cpan.org>, or through the web interface at
-L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Sys-Syslog>.
+L<http://rt.cpan.org/Public/Dist/Display.html?Name=Sys-Syslog>.
 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<http://perldoc.perl.org/Sys/Syslog.html>
 =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