diff options
author | Chris 'BinGOs' Williams <chris@bingosnet.co.uk> | 2016-05-17 13:37:52 +0100 |
---|---|---|
committer | Chris 'BinGOs' Williams <chris@bingosnet.co.uk> | 2016-05-17 13:37:52 +0100 |
commit | e57ea7c96db404b6101973609a00a22aa8bce9c3 (patch) | |
tree | bc685d5d94ff697b23473ff25e681b217083d732 /cpan | |
parent | 05465a2f07dfa2d935435b71d3245be3c1b851dd (diff) | |
download | perl-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.PL | 3 | ||||
-rw-r--r-- | cpan/Sys-Syslog/Syslog.pm | 129 | ||||
-rw-r--r-- | cpan/Sys-Syslog/Syslog.xs | 3 |
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 |