Fwd: CPAN Upload: S/SA/SAPER/Sys-Syslog-0.21.tar.gz

Message-Id: <92AB5E7F-F8E1-4DEE-805C-B257A569CB62@free.fr>

p4raw-id: //depot/perl@31866

5 files changed, 102 insertions, 21 deletions

diff --git a/ext/Sys/Syslog/Changes b/ext/Sys/Syslog/Changes
index 8018b812af..870a2e9b0b 100644
--- a/ext/Sys/Syslog/Changes
+++ b/ext/Sys/Syslog/Changes
@@ -1,5 +1,12 @@
 Revision history for Sys-Syslog
 
+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.
+        [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.
+
 0.20 -- 2007.09.05 -- Sebastien Aperghis-Tramoni (SAPER)
         [DOC] Added README.win32 which was missing in MANIFEST.
 
@@ -24,6 +31,7 @@ Revision history for Sys-Syslog
         [TESTS] Merged change blead@29176: suppress taint mode from t/constants.t
         [TESTS] Added regression tests for CPAN-RT#21866 and #25488.
         [EG] Added example script eg/syslog.pl
+        [DOC] CPAN-RT#26097: man pages were not installed.
         [DOC] Added the Sys::Syslog Rules.
 
 0.18 -- 2006.08.28 -- Sebastien Aperghis-Tramoni (SAPER)
diff --git a/ext/Sys/Syslog/Makefile.PL b/ext/Sys/Syslog/Makefile.PL
index 511eba0e5d..2c6068842f 100644
--- a/ext/Sys/Syslog/Makefile.PL
+++ b/ext/Sys/Syslog/Makefile.PL
@@ -5,7 +5,7 @@ eval 'use ExtUtils::MakeMaker::Coverage';
 use File::Copy;
 use File::Path;
 use File::Spec;
-require 5.006;
+require 5.005;
 
 
 # create a typemap for Perl 5.6
@@ -16,7 +16,7 @@ if ($] < 5.008) {
 }
 
 # create a lib/ dir in order to avoid warnings in Test::Distribution
-mkdir "lib";
+mkdir "lib", 0755;
 
 # virtual paths given to EU::MM
 my %virtual_path = ( 'Syslog.pm' => '$(INST_LIBDIR)/Syslog.pm' );
@@ -104,6 +104,10 @@ elsif (-S "/var/run/syslog" and -w _) {
     # Mac OS X puts it at a different path.
     $_PATH_LOG = "/var/run/syslog";
 }
+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 _) {
     # 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 b401d4827a..4a5a985658 100644
--- a/ext/Sys/Syslog/Syslog.pm
+++ b/ext/Sys/Syslog/Syslog.pm
@@ -6,11 +6,11 @@ use Fcntl qw(O_WRONLY);
 use File::Basename;
 use POSIX qw(strftime setlocale LC_TIME);
 use Socket ':all';
-require 5.006;
+require 5.005;
 require Exporter;
 
 {   no strict 'vars';
-    $VERSION = '0.20';
+    $VERSION = '0.21';
     @ISA = qw(Exporter);
 
     %EXPORT_TAGS = (
@@ -98,8 +98,8 @@ my %options = (
 );
 
 # Default is now to first use the native mechanism, so Perl programs 
-# behave like other normal C programs, then try other mechanisms.
-my @connectMethods = qw(native tcp udp unix stream console);
+# behave like other normal Unix programs, then try other mechanisms.
+my @connectMethods = qw(native tcp udp unix pipe stream console);
 if ($^O =~ /^(freebsd|linux)$/) {
     @connectMethods = grep { $_ ne 'udp' } @connectMethods;
 }
@@ -212,6 +212,20 @@ sub setlogsock {
 	    return undef;
         }
 
+    } elsif (lc $setsock eq 'pipe') {
+        for my $path ($syslog_path, &_PATH_LOG, "/dev/log") {
+            next unless defined $path and length $path and -w $path;
+            $syslog_path = $path;
+            last
+        }
+
+        if (not $syslog_path) {
+            warnings::warnif "pipe passed to setlogsock, but path not available";
+            return undef
+        }
+
+        @connectMethods = qw(pipe);
+
     } elsif (lc $setsock eq 'native') {
         @connectMethods = qw(native);
 
@@ -219,7 +233,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 operating system isn't Win32-compatible";
+            return undef;
         }
 
     } elsif (lc $setsock eq 'tcp') {
@@ -245,7 +260,8 @@ sub setlogsock {
 	@connectMethods = qw(console);
 
     } else {
-        croak "Invalid argument passed to setlogsock; must be 'stream', 'unix', 'native', 'eventlog', 'tcp', 'udp' or 'inet'"
+        croak "Invalid argument passed to setlogsock; must be 'stream', 'pipe', ",
+              "'unix', 'native', 'eventlog', 'tcp', 'udp' or 'inet'"
     }
 
     return 1;
@@ -309,7 +325,10 @@ sub syslog {
     $mask .= "\n" unless $mask =~ /\n$/;
     $message = @_ ? sprintf($mask, @_) : $mask;
 
-    if($current_proto eq 'native') {
+    # See CPAN-RT#24431. Opened on Apple Radar as bug #4944407 on 2007.01.21
+    chomp $message if $^O =~ /darwin/;
+
+    if ($current_proto eq 'native') {
         $buf = $message;
 
     }
@@ -405,6 +424,11 @@ sub _syslog_send_stream {
     return syswrite(SYSLOG, $buf, length($buf));
 }
 
+sub _syslog_send_pipe {
+    my ($buf) = @_;
+    return print SYSLOG $buf;
+}
+
 sub _syslog_send_socket {
     my ($buf) = @_;
     return syswrite(SYSLOG, $buf, length($buf));
@@ -504,7 +528,10 @@ sub connect_tcp {
     }
 
     setsockopt(SYSLOG, SOL_SOCKET, SO_KEEPALIVE, 1);
-    setsockopt(SYSLOG, IPPROTO_TCP, TCP_NODELAY, 1);
+    if (eval { IPPROTO_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;
@@ -581,6 +608,26 @@ sub connect_stream {
     return 1;
 }
 
+sub connect_pipe {
+    my ($errs) = @_;
+
+    $syslog_path ||= &_PATH_LOG || "/dev/log";
+
+    if (not -w $syslog_path) {
+        push @$errs, "$syslog_path is not writable";
+        return 0;
+    }
+
+    if (not open(SYSLOG, ">$syslog_path")) {
+        push @$errs, "can't write to $syslog_path: $!";
+        return 0;
+    }
+
+    $syslog_send = \&_syslog_send_pipe;
+
+    return 1;
+}
+
 sub connect_unix {
     my ($errs) = @_;
 
@@ -705,7 +752,7 @@ Sys::Syslog - Perl interface to the UNIX syslog(3) calls
 
 =head1 VERSION
 
-Version 0.20
+Version 0.21
 
 =head1 SYNOPSIS
 
@@ -907,6 +954,11 @@ C<"native"> - use the native C functions from your C<syslog(3)> library
 
 =item *
 
+C<"eventlog"> - send messages to the Win32 events logger (Win32 only; 
+added in C<Sys::Syslog> 0.19).
+
+=item *
+
 C<"tcp"> - connect to a TCP socket, on the C<syslog/tcp> or C<syslogng/tcp> 
 service. 
 
@@ -934,13 +986,15 @@ For example Solaris and IRIX system may prefer C<"stream"> instead of C<"unix">.
 
 =item *
 
-C<"console"> - send messages directly to the console, as for the C<"cons"> 
-option of C<openlog()>.
+C<"pipe"> - connect to the named pipe indicated by the pathname provided as 
+the optional second parameter, or, if omitted, to the value returned by 
+the C<_PATH_LOG> macro (if your system defines it), or F</dev/log>
+(added in C<Sys::Syslog> 0.21).
 
 =item *
 
-C<"eventlog"> - send messages to the Win32 events logger (Win32 only; 
-added in C<Sys::Syslog> 0.19).
+C<"console"> - send messages directly to the console, as for the C<"cons"> 
+option of C<openlog()>.
 
 =back
 
@@ -949,6 +1003,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.
 
 Giving an invalid value for C<$sock_type> will C<croak>.
 
@@ -1268,7 +1324,7 @@ IRIX 6.4 documentation on syslog,
 L<http://techpubs.sgi.com/library/tpl/cgi-bin/getdoc.cgi?coll=0640&db=man&fname=3c+syslog>
 
 AIX 5L 5.3 documentation on syslog, 
-L<http://publib.boulder.ibm.com/infocenter/pseries/v5r3/index.jsp?topic=/com.ibm.aix.doc/libs/basetrf2/syslog.htm>
+L<http://publib.boulder.ibm.com/infocenter/pseries/v5r3/index.jsp?topic=/com.ibm.aix.basetechref/doc/basetrf2/syslog.htm>
 
 HP-UX 11i documentation on syslog, 
 L<http://docs.hp.com/en/B9106-90010/syslog.3C.html>
@@ -1430,4 +1486,17 @@ of a bug in Sys::Syslog back then?
 
 - L<ftp://ftp.kiae.su/pub/unix/fido/>
 
+
+Links
+-----
+II12021: SYSLOGD HOWTO TCPIPINFO (z/OS, OS/390, MVS)
+- L<http://www-1.ibm.com/support/docview.wss?uid=isg1II12021>
+
+Getting the most out of the Event Viewer
+- L<http://www.codeproject.com/dotnet/evtvwr.asp?print=true>
+
+Log events to the Windows NT Event Log with JNI
+- L<http://www.javaworld.com/javaworld/jw-09-2001/jw-0928-ntmessages.html>
+
 =end comment
+
diff --git a/ext/Sys/Syslog/Syslog.xs b/ext/Sys/Syslog/Syslog.xs
index 7d72c64bdc..c9d63d573c 100644
--- a/ext/Sys/Syslog/Syslog.xs
+++ b/ext/Sys/Syslog/Syslog.xs
@@ -9,7 +9,7 @@
 #define HAVE_SYSLOG 1
 #endif
 
-#ifdef I_SYSLOG
+#if defined(I_SYSLOG) || PATCHLEVEL < 6
 #include <syslog.h>
 #endif
 
diff --git a/ext/Sys/Syslog/t/syslog.t b/ext/Sys/Syslog/t/syslog.t
index d8a4f8f923..19610f179a 100755
--- a/ext/Sys/Syslog/t/syslog.t
+++ b/ext/Sys/Syslog/t/syslog.t
@@ -111,13 +111,13 @@ SKIP: {
 }
 
 
-BEGIN { $tests += 20 * 7 }
+BEGIN { $tests += 20 * 8 }
 # try to open a syslog using all the available connection methods
 my @passed = ();
-for my $sock_type (qw(native eventlog unix stream inet tcp udp)) {
+for my $sock_type (qw(native eventlog unix pipe stream inet tcp udp)) {
     SKIP: {
-        skip "the 'unix' mechanism works, so the tests will likely fail with the 'stream' mechanism", 20 
-            if $sock_type eq 'stream' and grep {/unix/} @passed;
+        skip "the 'stream' mechanism because a previous mechanism with similar interface succeeded", 20 
+            if $sock_type eq 'stream' and grep {/pipe|unix/} @passed;
 
         # setlogsock() called with an arrayref
         $r = eval { setlogsock([$sock_type]) } || 0;