r13864 - /trunk/liblogger-syslog-perl/lib/Logger/Syslog.pm
dmn at users.alioth.debian.org
dmn at users.alioth.debian.org
Wed Jan 30 20:34:32 UTC 2008
Author: dmn
Date: Wed Jan 30 20:34:32 2008
New Revision: 13864
URL: http://svn.debian.org/wsvn/?sc=1&rev=13864
Log:
Actually upgrade Syslog.pm to 1.1; the change seems to have been omited in 1.1-1
Modified:
trunk/liblogger-syslog-perl/lib/Logger/Syslog.pm
Modified: trunk/liblogger-syslog-perl/lib/Logger/Syslog.pm
URL: http://svn.debian.org/wsvn/trunk/liblogger-syslog-perl/lib/Logger/Syslog.pm?rev=13864&op=diff
==============================================================================
--- trunk/liblogger-syslog-perl/lib/Logger/Syslog.pm (original)
+++ trunk/liblogger-syslog-perl/lib/Logger/Syslog.pm Wed Jan 30 20:34:32 2008
@@ -1,8 +1,14 @@
package Logger::Syslog;
+use strict;
+use warnings;
+use Carp;
+use Sys::Syslog qw(:DEFAULT setlogsock);
+use File::Basename;
+
=head1 NAME
-Logger::Syslog -- an simple wrapper over Syslog for Perl
+Logger::Syslog -- an intuitive wrapper over Syslog for Perl
=head1 DESCRIPTION
@@ -26,26 +32,21 @@
use Logger::Syslog;
- info("Starting at".localtime());
-
- #...
-
- if (error) {
+ info("Starting at ".localtime());
+ ...
+ if ($error) {
error("An error occured!");
exit 1;
}
-
+ ...
notice("There something to notify");
- ...
-=head1 FUNCTIONS
-
=cut
BEGIN {
use Exporter ;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS %SIG);
- $VERSION = "1.0";
+ $VERSION = "1.1";
@ISA = ( 'Exporter' ) ;
@EXPORT = qw (
&debug
@@ -64,60 +65,67 @@
%EXPORT_TAGS = (":all"=>[],);
}
+sub __get_script_name();
+my $DEFAULT_FACILITY = "user";
+our $fullname = __get_script_name();
+our $basename = basename($fullname);
+
+=head1 FUNCTIONS
+
+=head2 logger_init
+
+Call this to explicitly open a Syslog socket. You can optionaly specify
+a Syslog facility.
+
+That function is called when you use the module, if you're not in a mod_perl
+environement.
+
+Examples:
+
+ # open a syslog socket with default facility (user)
+ logger_init();
+
+ # open a syslog socket on the 'local' facility
+ logger_init('local');
+
+=cut
+
+sub logger_init(;$)
+{
+ my ($facility) = @_;
+ $facility = $DEFAULT_FACILITY unless defined $facility;
+
+ eval {
+ setlogsock('unix');
+ $fullname = __get_script_name();
+ openlog($fullname, 'pid', $facility);
+ logger_prefix("");
+ };
+}
+
+# If we're not under mod_perl, let's open the Syslog socket.
+if (! defined $ENV{'MOD_PERL'}) {
+ logger_init();
+}
+
+=head2 logger_close
+
+Call this to close the Syslog socket.
+
+That function is called automatically when the calling program exits.
+
+=cut
+
+sub logger_close()
+{
+ eval {
+ closelog();
+ };
+}
+
END {
eval {
logger_close();
- };
-}
-
-use strict;
-use warnings;
-use Carp;
-use Sys::Syslog qw(:DEFAULT setlogsock);
-use File::Basename;
-
-sub __get_script_name();
-my $DEFAULT_FACILITY = "user";
-our $fullname = __get_script_name();
-our $basename = basename($fullname);
-
-# If we're not under mod_perl, let's open the Syslog socket.
-if (! defined $ENV{'MOD_PERL'}) {
- eval {
- setlogsock('unix');
- openlog($basename, 'pid', $DEFAULT_FACILITY);
- };
-}
-
-=head2 logger_init
-
-That function has to be called in mod_perl environment.
-It will open the Syslog socket properly.
-
-=cut
-
-sub logger_init()
-{
- return unless $ENV{'MOD_PERL'};
- eval {
- setlogsock('unix');
- $basename = basename($ENV{'SCRIPT_FILENAME'});
- $fullname = __get_script_name();
- openlog($basename, 'pid', $DEFAULT_FACILITY);
- logger_prefix("");
- };
-}
-
-=head2 logger_close
-
-Call this to close the Syslog socket.
-
-=cut
-
-sub logger_close()
-{
- eval {
- closelog();
};
}
@@ -143,16 +151,6 @@
$fullname = __get_script_name();
$g_rh_prefix->{$fullname} = $prefix;
}
-
-my $LOG_FLAGS = {
- debug => 1,
- info => 1,
- notice => 1,
- warning => 1,
- err => 1,
- crit => 1,
- alert => 1
-};
my %g_rh_label = (
info => 'info ',
@@ -167,7 +165,11 @@
=head2 logger_set_default_facility(facility)
-You can choose which facility to use, the default one is "user".
+You can choose which facility to use, the default one is "user". Use that
+function if you want to switch smoothly from a facility to another.
+
+That function will close the existing socket and will open a new one with the
+appropriate facility.
Example:
@@ -178,106 +180,56 @@
sub logger_set_default_facility($)
{
my ($facility) = @_;
- $DEFAULT_FACILITY = $facility;
-}
-
-=head2 debug(message)
-
-Send a message to syslog, of the level "debug".
-
-=cut
-
-sub debug($)
+ if ($facility ne $DEFAULT_FACILITY) {
+ logger_close();
+ logger_init($facility);
+ }
+}
+
+=head1 LOGGING
+
+Logger::Syslog provides one function per Syslog level to let you send messages.
+If you want to send a debug message, just use debug(), for a warning, use
+warning() and so on...
+
+All those function have the same signature : thay take a string as their only
+argument, which is the message to send to syslog.
+
+Examples:
+
+ debug("my program starts at ".localtime());
+ ...
+ warning("some strange stuff occured");
+ ...
+ error("should not go there !");
+ ...
+ notice("Here is my notice");
+
+=cut
+
+sub AUTOLOAD
{
my ($message) = @_;
+ our $AUTOLOAD;
+ $AUTOLOAD =~ s/^.*:://;
+ return if ($AUTOLOAD eq 'DESTROY');
+
return 0 unless defined $message and length $message;
- return log_with_syslog('debug', $message);
-}
-
-=head2 info(message)
-
-Send a message to syslog, of the level "info".
-
-=cut
-
-sub info($)
-{
- my ($message) = @_;
- return 0 unless defined $message and length $message;
- return log_with_syslog('info', $message);
-}
-
-=head2 notice(message)
-
-Send a message to syslog, of the level "notice".
-
-=cut
-
-=head2 notice(message)
-
-Envoie un message de type notice a syslog
-
-=cut
-
-sub notice($)
-{
- my ($message) = @_;
- return 0 unless defined $message and length $message;
- return log_with_syslog('notice', $message);
-}
-
-=head2 warning(message)
-
-Send a message to syslog, of the level "warning".
-
-=cut
-
-sub warning($)
-{
- my ($message) = @_;
- return 0 unless defined $message and length $message;
- return log_with_syslog('warning', $message);
-}
-
-=head2 error(message)
-
-Send a message to syslog, of the level "error".
-
-=cut
-
-sub error ($)
-{
- my ($message) = @_;
- return 0 unless defined $message and length $message;
- return log_with_syslog('err', $message);
-}
-
-=head2 critic(message)
-
-Send a message to syslog, of the level "critic".
-
-=cut
-
-sub critic ($)
-{
- my ($message) = @_;
- return 0 unless defined $message and length $message;
- return log_with_syslog('crit', $message);
-}
-
-=head2 alert(message)
-
-Send a message to syslog, of the level "alert".
-
-=cut
-
-sub alert ($)
-{
- my ($message) = @_;
- return 0 unless defined $message and length $message;
- return log_with_syslog('alert', $message);
-}
-
+ my @supported = qw(debug info warning err error notice alert crit critic);
+
+ if (grep /^$AUTOLOAD$/, @supported) {
+ my $level = $AUTOLOAD;
+
+ $level = 'err' if ($level eq 'error');
+ $level = 'crit' if ($level eq 'critic');
+
+ log_with_syslog($level, $message);
+ }
+ else {
+ croak "Unsupported function : $AUTOLOAD";
+ }
+}
+
sub log_with_syslog ($$)
{
my ($level, $message) = @_;
@@ -295,7 +247,6 @@
$fonction = $basename unless defined $fonction;
$level = lc($level);
$level = 'info' unless defined $level and length $level;
- return 0 unless $LOG_FLAGS->{$level};
unless (defined $message and length $message) {
$message = "[void]";
More information about the Pkg-perl-cvs-commits
mailing list