From: Rafael Garcia-Suarez <rgarciasuarez@gmail.com>
Date: Mon, 4 Sep 2006 15:50:17 +0000 (+0000)
Subject: Upgrade to Sys::Syslog 0.18
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=07b7e4bc0b0de0ebe3e12073f5809d73b6646970;p=p5sagit%2Fp5-mst-13.2.git

Upgrade to Sys::Syslog 0.18

p4raw-id: //depot/perl@28782
---

diff --git a/ext/Sys/Syslog/Changes b/ext/Sys/Syslog/Changes
index 585eca4..27b2631 100644
--- a/ext/Sys/Syslog/Changes
+++ b/ext/Sys/Syslog/Changes
@@ -1,10 +1,16 @@
 Revision history for Sys-Syslog
 
+0.18 -- 2006.08.28 -- Sebastien Aperghis-Tramoni (SAPER)
+        [BUGFIX] Rewrote the way the default identifiant is constructed.
+        [TESTS] CPAN-RT#20946: Removed the console mechanism from the main 
+        test loop because writing to the console hangs on several systems.
+        [DOC] Added a note discouraging the use of setlogsock().
+
 0.17 -- 2006.07.23 -- Sebastien Aperghis-Tramoni (SAPER)
         [BUGFIX] CPAN-RT#20622, #20164: Fixed path handling in connect_unix().
         [CODE] Renamed some variables ($that is not a valid name), and removed 
         some dead code. 
-        [CODE] Actually added the macros from Mac OS X that was announced in 
+        [CODE] Actually added the macros from Mac OS X that were announced in 
         the 0.14 version.
         [DOC] CPAN-RT#20545: Rewrote the documentation about setlogksock().
 
diff --git a/ext/Sys/Syslog/README b/ext/Sys/Syslog/README
index ae3a8b9..a6b4fc3 100644
--- a/ext/Sys/Syslog/README
+++ b/ext/Sys/Syslog/README
@@ -19,25 +19,18 @@ INSTALLATION
         $ make test
         $ make install
 
-    A ANSI-compliant compiler is required to compile the extension.
+    An ANSI-compliant compiler is required to compile the extension.
 
-    Sys::Syslog has been tested by the author on the following systems,
+    Sys::Syslog should on any Perl since 5.6.0. This module has been 
+    tested by the author on the following Perl and system versions
     but is likely to run on many more:
 
-      - Linux 2.6, gcc 3.4.1
-      - FreeBSD 6.0, gcc 3.4.4
-      - Mac OS X 10.4, gcc 4.0.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.8.7 i386-linux (custom build)
-      - Perl 5.8.8 i386-freebsd-64int (custom build)
-      - Perl 5.8.8 i386-linux (custom build)
-      - Perl 5.8.6 darwin-thread-multi-2level (PowerPC) (vendor build)
+      - Perl 5.6.2 i686-linux gcc-3.4.1 (custom build)
+      - Perl 5.8.5 i386-linux-thread-multi gcc-3.4.1 (vendor build)
+      - Perl 5.8.7 i386-linux gcc-3.4.1 (custom build)
+      - Perl 5.8.8 i386-freebsd-64int gcc-3.4.4 (custom build)
+      - Perl 5.8.8 i386-linux gcc-3.4.1 (custom build)
+      - Perl 5.8.6 darwin-thread-multi-2level gcc-4.0.1 (PowerPC) (vendor build)
 
     See also the corresponding CPAN Testers page:
         http://testers.cpan.org/show/Sys-Syslog.html
diff --git a/ext/Sys/Syslog/Syslog.pm b/ext/Sys/Syslog/Syslog.pm
index 4c771f6..2a2ddb8 100644
--- a/ext/Sys/Syslog/Syslog.pm
+++ b/ext/Sys/Syslog/Syslog.pm
@@ -2,13 +2,14 @@ package Sys::Syslog;
 use strict;
 use warnings::register;
 use Carp;
+use File::Basename;
 use POSIX qw(strftime setlocale LC_TIME);
 use Socket ':all';
 require 5.006;
 require Exporter;
 
 {   no strict 'vars';
-    $VERSION = '0.17';
+    $VERSION = '0.18';
     @ISA = qw(Exporter);
 
     %EXPORT_TAGS = (
@@ -44,12 +45,12 @@ require Exporter;
     );
 
     @EXPORT = (
-    @{$EXPORT_TAGS{standard}}, 
+        @{$EXPORT_TAGS{standard}}, 
     );
 
     @EXPORT_OK = (
-    @{$EXPORT_TAGS{extended}}, 
-    @{$EXPORT_TAGS{macros}}, 
+        @{$EXPORT_TAGS{extended}}, 
+        @{$EXPORT_TAGS{macros}}, 
     );
 
     eval {
@@ -138,7 +139,7 @@ sub setlogmask {
     $maskpri = shift unless $_[0] == 0;
     $oldmask;
 }
-
+ 
 sub setlogsock {
     my $setsock = shift;
     $syslog_path = shift;
@@ -166,7 +167,7 @@ sub setlogsock {
 		unless defined $syslog_path
         }
 	unless (-w $syslog_path) {
-        warnings::warnif "stream passed to setlogsock, but $syslog_path is not writable";
+            warnings::warnif "stream passed to setlogsock, but $syslog_path is not writable";
 	    return undef;
 	} else {
 	    @connectMethods = ( 'stream' );
@@ -255,10 +256,13 @@ sub syslog {
 	$numfac = xlate($facility);
     }
 
+    # if no identifiant, set up a default one
+    $ident ||= basename($0) || getlogin() || getpwuid($<) || 'syslog';
+
     connect_log() unless $connected;
 
     if ($mask =~ /%m/) {
-	# escape percent signs if sprintf will be called
+        # escape percent signs for sprintf()
         $error =~ s/%/%%/g if @_;
 	# replace %m with $err, if preceded by an even number of percent signs
         $mask =~ s/(?<!%)((?:%%)*)%m/$1$error/g;
@@ -272,16 +276,6 @@ sub syslog {
 
     } else {
         my $whoami = $ident;
-
-        if (!$whoami && $mask =~ /^(\S.*?):\s?(.*)/) {
-            $whoami = $1;
-            $mask = $2;
-        }
-
-        unless ($whoami) {
-            $whoami = getlogin() || getpwuid($<) || 'syslog';
-        }
-
         $whoami .= "[$$]" if $options{pid};
 
         $sum = $numpri + $numfac;
@@ -406,13 +400,16 @@ sub xlate {
 # 
 sub connect_log {
     @fallbackMethods = @connectMethods unless scalar @fallbackMethods;
+
     if ($transmit_ok && $current_proto) {
         # Retry what we were on, because it has worked in the past.
 	unshift(@fallbackMethods, $current_proto);
     }
+
     $connected = 0;
     my @errs = ();
     my $proto = undef;
+
     while ($proto = shift @fallbackMethods) {
 	no strict 'refs';
 	my $fn = "connect_$proto";
@@ -649,7 +646,7 @@ Sys::Syslog - Perl interface to the UNIX syslog(3) calls
 
 =head1 VERSION
 
-Version 0.17
+Version 0.18
 
 =head1 SYNOPSIS
 
@@ -831,7 +828,7 @@ Log all messages up to debug:
 
 =item B<setlogsock($sock_type)>
 
-=item B<setlogsock($sock_type, $stream_location)> (added in 5.004_02)
+=item B<setlogsock($sock_type, $stream_location)> (added in Perl 5.004_02)
 
 Sets the socket type to be used for the next call to
 C<openlog()> or C<syslog()> and returns true on success,
@@ -841,7 +838,8 @@ C<undef> on failure. The available mechanisms are:
 
 =item *
 
-C<"native"> - use the native C functions from your C<syslog(3)> library.
+C<"native"> - use the native C functions from your C<syslog(3)> library
+(added in C<Sys::Syslog> 0.15).
 
 =item *
 
@@ -883,7 +881,7 @@ mechanisms which are attempted in order.
 
 The default is to try C<native>, C<tcp>, C<udp>, C<unix>, C<stream>, C<console>.
 
-Giving an invalid value for C<$sock_type> will croak.
+Giving an invalid value for C<$sock_type> will C<croak>.
 
 B<Examples>
 
@@ -895,6 +893,19 @@ Select the native, UDP socket then UNIX domain socket mechanisms:
 
     setlogsock(["native", "udp", "unix"]);
 
+=over
+
+=item B<Note>
+
+Now that the "native" mechanism is supported by C<Sys::Syslog> and selected 
+by default, the use of the C<setlogsock()> function is discouraged because 
+other mechanisms are less portable across operating systems.  Authors of 
+modules and programs that use this function, especially its cargo-cult form 
+C<setlogsock("unix")>, are advised to remove any occurence of it unless they 
+specifically want to use a given mechanism (like TCP or UDP to connect to 
+a remote host).
+
+=back
 
 =item B<closelog()>
 
diff --git a/ext/Sys/Syslog/t/syslog.t b/ext/Sys/Syslog/t/syslog.t
index 6eae2b6..7e9e2ad 100755
--- a/ext/Sys/Syslog/t/syslog.t
+++ b/ext/Sys/Syslog/t/syslog.t
@@ -103,9 +103,9 @@ SKIP: {
 }
 
 
-BEGIN { $tests += 20 * 7 }
+BEGIN { $tests += 20 * 6 }
 # try to open a syslog using all the available connection methods
-for my $sock_type (qw(stream unix native inet tcp udp console)) {
+for my $sock_type (qw(native stream unix inet tcp udp)) {
     SKIP: {
         # setlogsock() called with an arrayref
         $r = eval { setlogsock([$sock_type]) } || 0;