summaryrefslogtreecommitdiff
path: root/cpan
diff options
context:
space:
mode:
authorChris 'BinGOs' Williams <chris@bingosnet.co.uk>2016-05-17 13:37:52 +0100
committerChris 'BinGOs' Williams <chris@bingosnet.co.uk>2016-05-17 13:37:52 +0100
commite57ea7c96db404b6101973609a00a22aa8bce9c3 (patch)
treebc685d5d94ff697b23473ff25e681b217083d732 /cpan
parent05465a2f07dfa2d935435b71d3245be3c1b851dd (diff)
downloadperl-e57ea7c96db404b6101973609a00a22aa8bce9c3.tar.gz
Update Sys-Syslog to CPAN version 0.34
[DELTA] 0.34 -- 2016.05.06 -- Sebastien Aperghis-Tramoni (SAPER) [BUGFIX] CPAN-RT#105117: use %e where available, fall back to %d and a regexp where not (Markus Laker). [BUGFIX] CPAN-RT#98446: trailing new line with perror (Alexander Bluhm). [BUGFIX] CPAN-RT#105152: the noeol option was ignored (Markus Laker). [PORT] CPAN-RT#104710: loadable library and perl binaries are mismatched, because of missing CCFLAGS (CHORNY, KMX). [PORT] No longer inheriting from Exporter doesn't work before Perl 5.8.3. [BUGFIX] CPAN-RT#90538: facility from openlog() is not used (Anton Yuzhaninov). [PORT] CPAN-RT#90212: Support non-Windows platforms where syslog.h is not defined (Brian Fraser). [PORT] CPAN-RT#90224: setlocale() is not available everywhere, for example on Android (Brian Fraser). [PORT] CPAN-RT#90218: getproto*() and getserv*() functions are not available everywhere (Brian Fraser). [DOC] CPAN-RT#102058: mention the repository in the documentation.
Diffstat (limited to 'cpan')
-rw-r--r--cpan/Sys-Syslog/Makefile.PL3
-rw-r--r--cpan/Sys-Syslog/Syslog.pm129
-rw-r--r--cpan/Sys-Syslog/Syslog.xs3
3 files changed, 86 insertions, 49 deletions
diff --git a/cpan/Sys-Syslog/Makefile.PL b/cpan/Sys-Syslog/Makefile.PL
index 347197ab44..d09ba69fc9 100644
--- a/cpan/Sys-Syslog/Makefile.PL
+++ b/cpan/Sys-Syslog/Makefile.PL
@@ -3,6 +3,7 @@ use strict;
use ExtUtils::MakeMaker;
use File::Copy;
use File::Spec;
+use Config;
# create a typemap for Perl 5.6
@@ -33,7 +34,7 @@ if ($^O =~ /Win32/) {
$virtual_path{'win32/Win32.pm' } = '$(INST_LIBDIR)/Syslog/Win32.pm';
$virtual_path{'win32/PerlLog.dll'} = '$(INST_ARCHAUTODIR)/PerlLog.dll';
- push @extra_params, CCFLAGS => "-Ifallback";
+ push @extra_params, CCFLAGS => "$Config{ccflags} -Ifallback";
# recreate the DLL from its uuencoded form if it's not here
if (! -f File::Spec->catfile("win32", "$name.dll")) {
diff --git a/cpan/Sys-Syslog/Syslog.pm b/cpan/Sys-Syslog/Syslog.pm
index 25164af320..0cfc749538 100644
--- a/cpan/Sys-Syslog/Syslog.pm
+++ b/cpan/Sys-Syslog/Syslog.pm
@@ -3,15 +3,19 @@ use strict;
use warnings;
use warnings::register;
use Carp;
-use Exporter qw< import >;
+use Config;
+use Exporter ();
use File::Basename;
use POSIX qw< strftime setlocale LC_TIME >;
use Socket qw< :all >;
require 5.005;
+*import = \&Exporter::import;
+
+
{ no strict 'vars';
- $VERSION = '0.33';
+ $VERSION = '0.34';
%EXPORT_TAGS = (
standard => [qw(openlog syslog closelog setlogmask)],
@@ -71,6 +75,29 @@ require 5.005;
}
+#
+# Constants
+#
+use constant HAVE_GETPROTOBYNAME => $Config::Config{d_getpbyname};
+use constant HAVE_GETPROTOBYNUMBER => $Config::Config{d_getpbynumber};
+use constant HAVE_SETLOCALE => $Config::Config{d_setlocale};
+use constant HAVE_IPPROTO_TCP => defined &Socket::IPPROTO_TCP ? 1 : 0;
+use constant HAVE_IPPROTO_UDP => defined &Socket::IPPROTO_UDP ? 1 : 0;
+use constant HAVE_TCP_NODELAY => defined &Socket::TCP_NODELAY ? 1 : 0;
+
+use constant SOCKET_IPPROTO_TCP =>
+ HAVE_IPPROTO_TCP ? Socket::IPPROTO_TCP
+ : HAVE_GETPROTOBYNAME ? scalar getprotobyname("tcp")
+ : 6;
+
+use constant SOCKET_IPPROTO_UDP =>
+ HAVE_IPPROTO_UDP ? Socket::IPPROTO_UDP
+ : HAVE_GETPROTOBYNAME ? scalar getprotobyname("udp")
+ : 17;
+
+use constant SOCKET_TCP_NODELAY => HAVE_TCP_NODELAY ? Socket::TCP_NODELAY : 1;
+
+
#
# Public variables
#
@@ -241,7 +268,9 @@ my %mechanism = (
check => sub {
return 1 if defined $sock_port;
- if (getservbyname('syslog', 'tcp') || getservbyname('syslogng', 'tcp')) {
+ if (eval { local $SIG{__DIE__};
+ getservbyname('syslog','tcp') || getservbyname('syslogng','tcp')
+ }) {
$host = $syslog_path;
return 1
}
@@ -255,7 +284,7 @@ my %mechanism = (
check => sub {
return 1 if defined $sock_port;
- if (getservbyname('syslog', 'udp')) {
+ if (eval { local $SIG{__DIE__}; getservbyname('syslog', 'udp') }) {
$host = $syslog_path;
return 1
}
@@ -366,6 +395,7 @@ sub syslog {
if ($priority =~ /^\d+$/) {
$numpri = LOG_PRI($priority);
$numfac = LOG_FAC($priority) << 3;
+ undef $numfac if $numfac == 0; # no facility given => use default
}
elsif ($priority =~ /^\w+/) {
# Allow "level" or "level|facility".
@@ -419,7 +449,8 @@ sub syslog {
$mask =~ s/(?<!%)((?:%%)*)%m/$1$error/g;
}
- $mask .= "\n" unless $mask =~ /\n$/;
+ # add (or not) a newline
+ $mask .= "\n" if !$options{noeol} and rindex($mask, "\n") == -1;
$message = @args ? sprintf($mask, @args) : $mask;
if ($current_proto eq 'native') {
@@ -433,17 +464,27 @@ sub syslog {
$whoami .= "[$$]" if $options{pid};
$sum = $numpri + $numfac;
- my $oldlocale = setlocale(LC_TIME);
- setlocale(LC_TIME, 'C');
- my $timestamp = strftime "%b %d %H:%M:%S", localtime;
- setlocale(LC_TIME, $oldlocale);
+
+ my $oldlocale;
+ if (HAVE_SETLOCALE) {
+ $oldlocale = setlocale(LC_TIME);
+ setlocale(LC_TIME, 'C');
+ }
+
+ # %e format isn't available on all systems (Win32, cf. CPAN RT #69310)
+ my $day = strftime "%e", localtime;
+
+ if (index($day, "%") == 0) {
+ $day = strftime "%d", localtime;
+ $day =~ s/^0/ /;
+ }
+
+ my $timestamp = strftime "%b $day %H:%M:%S", localtime;
+ setlocale(LC_TIME, $oldlocale) if HAVE_SETLOCALE;
# construct the stream that will be transmitted
$buf = "<$sum>$timestamp $whoami: $message";
- # add (or not) a newline
- $buf .= "\n" if !$options{noeol} and rindex($buf, "\n") == -1;
-
# add (or not) a NUL character
$buf .= "\0" if !$options{nonul};
}
@@ -453,7 +494,8 @@ sub syslog {
if ($options{perror} and $current_proto ne 'native') {
my $whoami = $ident;
$whoami .= "[$$]" if $options{pid};
- print STDERR "$whoami: $message\n";
+ print STDERR "$whoami: $message";
+ print STDERR "\n" if rindex($message, "\n") == -1;
}
# it's possible that we'll get an error from sending
@@ -622,14 +664,9 @@ sub connect_log {
sub connect_tcp {
my ($errs) = @_;
- my $proto = getprotobyname('tcp');
- if (!defined $proto) {
- push @$errs, "getprotobyname failed for tcp";
- return 0;
- }
-
- my $port = $sock_port || getservbyname('syslog', 'tcp');
- $port = getservbyname('syslogng', 'tcp') unless defined $port;
+ my $port = $sock_port
+ || eval { local $SIG{__DIE__}; getservbyname('syslog', 'tcp') }
+ || eval { local $SIG{__DIE__}; getservbyname('syslogng', 'tcp') };
if (!defined $port) {
push @$errs, "getservbyname failed for syslog/tcp and syslogng/tcp";
return 0;
@@ -647,16 +684,14 @@ sub connect_tcp {
}
$addr = sockaddr_in($port, $addr);
- if (!socket(SYSLOG, AF_INET, SOCK_STREAM, $proto)) {
+ if (!socket(SYSLOG, AF_INET, SOCK_STREAM, SOCKET_IPPROTO_TCP)) {
push @$errs, "tcp socket: $!";
return 0;
}
setsockopt(SYSLOG, SOL_SOCKET, SO_KEEPALIVE, 1);
- if (silent_eval { IPPROTO_TCP() }) {
- # These constants don't exist in 5.005. They were added in 1999
- setsockopt(SYSLOG, IPPROTO_TCP(), TCP_NODELAY(), 1);
- }
+ setsockopt(SYSLOG, SOCKET_IPPROTO_TCP, SOCKET_TCP_NODELAY, 1);
+
if (!connect(SYSLOG, $addr)) {
push @$errs, "tcp connect: $!";
return 0;
@@ -670,13 +705,8 @@ sub connect_tcp {
sub connect_udp {
my ($errs) = @_;
- my $proto = getprotobyname('udp');
- if (!defined $proto) {
- push @$errs, "getprotobyname failed for udp";
- return 0;
- }
-
- my $port = $sock_port || getservbyname('syslog', 'udp');
+ my $port = $sock_port
+ || eval { local $SIG{__DIE__}; getservbyname('syslog', 'udp') };
if (!defined $port) {
push @$errs, "getservbyname failed for syslog/udp";
return 0;
@@ -694,7 +724,7 @@ sub connect_udp {
}
$addr = sockaddr_in($port, $addr);
- if (!socket(SYSLOG, AF_INET, SOCK_DGRAM, $proto)) {
+ if (!socket(SYSLOG, AF_INET, SOCK_DGRAM, SOCKET_IPPROTO_UDP)) {
push @$errs, "udp socket: $!";
return 0;
}
@@ -904,7 +934,7 @@ Sys::Syslog - Perl interface to the UNIX syslog(3) calls
=head1 VERSION
-This is the documentation of version 0.33
+This is the documentation of version 0.34
=head1 SYNOPSIS
@@ -1665,34 +1695,37 @@ You can find documentation for this module with the perldoc command.
You can also look for information at:
-=over 4
-
-=item * AnnoCPAN: Annotated CPAN documentation
-
-L<http://annocpan.org/dist/Sys-Syslog>
+=over
-=item * CPAN Ratings
+=item * Perl Documentation
-L<http://cpanratings.perl.org/d/Sys-Syslog>
+L<http://perldoc.perl.org/Sys/Syslog.html>
-=item * RT: CPAN's request tracker
+=item * MetaCPAN
-L<http://rt.cpan.org/Dist/Display.html?Queue=Sys-Syslog>
+L<https://metacpan.org/module/Sys::Syslog>
=item * Search CPAN
L<http://search.cpan.org/dist/Sys-Syslog/>
-=item * MetaCPAN
+=item * AnnoCPAN: Annotated CPAN documentation
-L<https://metacpan.org/module/Sys::Syslog>
+L<http://annocpan.org/dist/Sys-Syslog>
-=item * Perl Documentation
+=item * CPAN Ratings
-L<http://perldoc.perl.org/Sys/Syslog.html>
+L<http://cpanratings.perl.org/d/Sys-Syslog>
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/Dist/Display.html?Queue=Sys-Syslog>
=back
+The source code is available on Git Hub:
+L<https://github.com/maddingue/Sys-Syslog/>
+
=head1 COPYRIGHT
diff --git a/cpan/Sys-Syslog/Syslog.xs b/cpan/Sys-Syslog/Syslog.xs
index d715b45c75..c802413ec0 100644
--- a/cpan/Sys-Syslog/Syslog.xs
+++ b/cpan/Sys-Syslog/Syslog.xs
@@ -26,6 +26,9 @@
#else
# if defined(I_SYSLOG) || PATCHLEVEL < 6
# include <syslog.h>
+# else
+# undef HAVE_SYSLOG
+# include "fallback/syslog.h"
# endif
#endif