5.005_03-MAINT_TRIAL_5 utils/h2xs fixing -A & more

[p5sagit/p5-mst-13.2.git] / lib / Sys / Syslog.pm

diff --git a/lib/Sys/Syslog.pm b/lib/Sys/Syslog.pm
index 9ba4ed5..f0cbb71 100644 (file)
--- a/lib/Sys/Syslog.pm
+++ b/lib/Sys/Syslog.pm
@@ -4,7 +4,8 @@ require Exporter;
 use Carp;
 
 @ISA = qw(Exporter);
-@EXPORT = qw(openlog closelog setlogmask setlogsock syslog);
+@EXPORT = qw(openlog closelog setlogmask syslog);
+@EXPORT_OK = qw(setlogsock);
 
 use Socket;
 use Sys::Hostname;
@@ -17,15 +18,18 @@ use Sys::Hostname;
 # Modified to add UNIX domain sockets by Sean Robinson <robinson_s@sc.maricopa.edu>
 #  with support from Tim Bunce <Tim.Bunce@ig.co.uk> and the perl5-porters mailing list
 
+# Todo: enable connect to try all three types before failing (auto setlogsock)?
+
 =head1 NAME
 
-Sys::Syslog, openlog, closelog, setlogmask, setlogsock, syslog - Perl interface to the UNIX syslog(3) calls
+Sys::Syslog, openlog, closelog, setlogmask, syslog - Perl interface to the UNIX syslog(3) calls
 
 =head1 SYNOPSIS
 
-    use Sys::Syslog;
+    use Sys::Syslog;                          # all except setlogsock, or:
+    use Sys::Syslog qw(:DEFAULT setlogsock);  # default set, plus setlogsock
 
-    setlogsock $sock_unix;
+    setlogsock $sock_type;
     openlog $ident, $logopt, $facility;
     syslog $priority, $format, @args;
     $oldmask = setlogmask $mask_priority;
@@ -44,7 +48,7 @@ Syslog provides the functions:
 =item openlog $ident, $logopt, $facility
 
 I<$ident> is prepended to every message.
-I<$logopt> contains one or more of the words I<pid>, I<ndelay>, I<cons>, I<nowait>.
+I<$logopt> contains zero or more of the words I<pid>, I<ndelay>, I<cons>, I<nowait>.
 I<$facility> specifies the part of the system
 
 =item syslog $priority, $format, @args
@@ -57,17 +61,15 @@ is replaced with C<"$!"> (the latest error message).
 
 Sets log mask I<$mask_priority> and returns the old mask.
 
-=item setlogsock $sock_unix
+=item setlogsock $sock_type (added in 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,
+undef on failure.
 
-Defines or undefines the boolean I<$sock_unix>;
-a value equalling C<unix> defines I<$sock_unix>, a value
-equalling C<inet >undefines I<$sock_unix>, and any other 
-value croaks.
-The I<$sock_unix> boolean determines whether the next
-call to C<openlog()> or C<syslog()> will connect to the 
-UNIX domain socket returned by C<_PATH_LOG> in 
-I<syslog.ph> or to the INET socket returned by 
-getservbyname().
+A value of 'unix' will connect to the UNIX domain socket returned by
+C<_PATH_LOG> in F<syslog.ph>.  A value of 'inet' will connect to an
+INET socket returned by getservbyname().  Any other value croaks.
 
 The default is for the INET socket to be used.
 
@@ -122,7 +124,8 @@ sub openlog {
     $lo_ndelay = $logopt =~ /\bndelay\b/;
     $lo_cons = $logopt =~ /\bcons\b/;
     $lo_nowait = $logopt =~ /\bnowait\b/;
-    &connect if $lo_ndelay;
+    return 1 unless $lo_ndelay;
+    &connect;
 } 
 
 sub closelog {
@@ -138,13 +141,23 @@ sub setlogmask {
  
 sub setlogsock {
     local($setsock) = shift;
+    &disconnect if $connected;
     if (lc($setsock) eq 'unix') {
-        $sock_unix = 1;
+        if (defined &_PATH_LOG) {
+            $sock_type = 1;
+        } else {
+            return undef;
+        }
     } elsif (lc($setsock) eq 'inet') {
-        undef($sock_unix);
+        if (getservbyname('syslog','udp')) {
+            undef($sock_type);
+        } else {
+            return undef;
+        }
     } else {
         croak "Invalid argument passed to setlogsock; must be 'unix' or 'inet'";
     }
+    return 1;
 }
 
 sub syslog {
@@ -236,7 +249,7 @@ sub connect {
        my($host_uniq) = Sys::Hostname::hostname();
        ($host) = $host_uniq =~ /([A-Za-z0-9_.-]+)/; # allow FQDN (inc _)
     }
-    unless ( $sock_unix ) {
+    unless ( $sock_type ) {
         my $udp = getprotobyname('udp');
         my $syslog = getservbyname('syslog','udp');
         my $this = sockaddr_in($syslog, INADDR_ANY);
@@ -246,8 +259,11 @@ sub connect {
     } else {
         my $syslog = &_PATH_LOG                          || croak "_PATH_LOG not found in syslog.ph";
         my $that = sockaddr_un($syslog)                  || croak "Can't locate $syslog";
-        socket(SYSLOG,AF_UNIX,SOCK_STREAM,0)             || croak "open: $!";
-        connect(SYSLOG,$that)                            || croak "connect: $!";
+        socket(SYSLOG,AF_UNIX,SOCK_STREAM,0)             || croak "socket: $!";
+        if (!connect(SYSLOG,$that)) {
+            socket(SYSLOG,AF_UNIX,SOCK_DGRAM,0)          || croak "socket: $!";
+            connect(SYSLOG,$that) || croak "connect: $! (SOCK_DGRAM after trying SOCK_STREAM)";
+        }
     }
     local($old) = select(SYSLOG); $| = 1; select($old);
     $connected = 1;