r41166 - in /branches/upstream/liblogger-syslog-perl/current: CHANGES Makefile.PL README lib/ lib/Logger/ lib/Logger/Syslog.pm
ryan52-guest at users.alioth.debian.org
ryan52-guest at users.alioth.debian.org
Mon Aug 3 08:05:52 UTC 2009
Author: ryan52-guest
Date: Mon Aug 3 08:05:46 2009
New Revision: 41166
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=41166
Log:
Load /tmp/tmp.CuGcZhihvX/to_upload/Logger-Syslog-1.1 into
branches/upstream/liblogger-syslog-perl/current.
Added:
branches/upstream/liblogger-syslog-perl/current/CHANGES
branches/upstream/liblogger-syslog-perl/current/Makefile.PL
branches/upstream/liblogger-syslog-perl/current/README
branches/upstream/liblogger-syslog-perl/current/lib/
branches/upstream/liblogger-syslog-perl/current/lib/Logger/
branches/upstream/liblogger-syslog-perl/current/lib/Logger/Syslog.pm
Added: branches/upstream/liblogger-syslog-perl/current/CHANGES
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblogger-syslog-perl/current/CHANGES?rev=41166&op=file
==============================================================================
--- branches/upstream/liblogger-syslog-perl/current/CHANGES (added)
+++ branches/upstream/liblogger-syslog-perl/current/CHANGES Mon Aug 3 08:05:46 2009
@@ -1,0 +1,13 @@
+2006-11-27 -- 1.1
+
+ * Fixes the set_default_facility() function.
+ * Use AUTOLOAD for wrapping all the Syslog level functions.
+ * Lots of cleaning and POD fixes.
+
+-- Alexis Sukrieh <sukria at sukria.net>
+
+2006-11-20 -- 1.0
+
+ * First Release
+
+-- Alexis Sukrieh <sukria at sukria.net>
Added: branches/upstream/liblogger-syslog-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblogger-syslog-perl/current/Makefile.PL?rev=41166&op=file
==============================================================================
--- branches/upstream/liblogger-syslog-perl/current/Makefile.PL (added)
+++ branches/upstream/liblogger-syslog-perl/current/Makefile.PL Mon Aug 3 08:05:46 2009
@@ -1,0 +1,7 @@
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => 'Logger::Syslog',
+ VERSION_FROM => 'lib/Logger/Syslog.pm',
+ PREREQ_PM => { 'Sys::Syslog' => '0.13' }
+);
Added: branches/upstream/liblogger-syslog-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblogger-syslog-perl/current/README?rev=41166&op=file
==============================================================================
--- branches/upstream/liblogger-syslog-perl/current/README (added)
+++ branches/upstream/liblogger-syslog-perl/current/README Mon Aug 3 08:05:46 2009
@@ -1,0 +1,22 @@
+Logger::Syslog -- A simple wrapper over Sys::Syslog
+
+FEATURES
+
+Povides one function per syslog message level for sending message to syslog.
+
+REQUIREMENTS
+
+This module requires you to have installed the following other perl modules:
+ - Sys::Syslog
+
+NOTES
+
+Compliant with mod_perl.
+
+INSTALL
+
+Use the classic mantra:
+
+ $ perl Makefile.PL
+ $ make
+ # make install
Added: branches/upstream/liblogger-syslog-perl/current/lib/Logger/Syslog.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblogger-syslog-perl/current/lib/Logger/Syslog.pm?rev=41166&op=file
==============================================================================
--- branches/upstream/liblogger-syslog-perl/current/lib/Logger/Syslog.pm (added)
+++ branches/upstream/liblogger-syslog-perl/current/lib/Logger/Syslog.pm Mon Aug 3 08:05:46 2009
@@ -1,0 +1,297 @@
+package Logger::Syslog;
+
+use strict;
+use warnings;
+use Carp;
+use Sys::Syslog qw(:DEFAULT setlogsock);
+use File::Basename;
+
+=head1 NAME
+
+Logger::Syslog -- an intuitive wrapper over Syslog for Perl
+
+=head1 DESCRIPTION
+
+You want to deal with syslog, but you don't want to bother with Sys::Syslog,
+that module is for you.
+
+Logger::Syslog takes care of everything regarding the Syslog communication, all
+you have to do is to use the function you need to send a message to syslog.
+
+Logger::Syslog provides one function per Syslog message level: debug, info,
+warning, error, notice, critic, alert.
+
+=head1 NOTES
+
+Logger::Syslog is compliant with mod_perl, all you have to do when using it
+in such an environement is to call logger_init() at the beginning of your CGI,
+that will garantee that everything will run smoothly (otherwise, issues with
+the syslog socket can happen in mod_perl env).
+
+=head1 SYNOPSIS
+
+ use Logger::Syslog;
+
+ info("Starting at ".localtime());
+ ...
+ if ($error) {
+ error("An error occured!");
+ exit 1;
+ }
+ ...
+ notice("There something to notify");
+
+=cut
+
+BEGIN {
+ use Exporter ;
+ use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS %SIG);
+ $VERSION = "1.1";
+ @ISA = ( 'Exporter' ) ;
+ @EXPORT = qw (
+ &debug
+ &info
+ ¬ice
+ &warning
+ &error
+ &critic
+ &alert
+ &logger_prefix
+ &logger_close
+ &logger_init
+ &logger_set_default_facility
+ );
+ @EXPORT_OK=@EXPORT;
+ %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();
+ };
+}
+
+=head2 logger_prefix
+
+That function lets you set a string that will be prefixed to every
+messages sent to syslog.
+
+Example:
+
+ logger_prefix("my program");
+ info("starting");
+ ...
+ info("stopping");
+
+=cut
+
+our $g_rh_prefix = {};
+sub logger_prefix(;$)
+{
+ my ($prefix) = @_;
+ $prefix = "" unless defined $prefix;
+ $fullname = __get_script_name();
+ $g_rh_prefix->{$fullname} = $prefix;
+}
+
+my %g_rh_label = (
+ info => 'info ',
+ notice => 'note ',
+ err => 'error',
+ warning => 'warn ',
+ debug => 'debug',
+ crit => 'crit ',
+ alert => 'alert'
+);
+
+
+=head2 logger_set_default_facility(facility)
+
+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:
+
+ logger_set_default_facility("cron");
+
+=cut
+
+sub logger_set_default_facility($)
+{
+ my ($facility) = @_;
+ 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;
+ 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) = @_;
+ return 0 unless defined $level and defined $message;
+
+ my $caller = 2;
+ if ($ENV{MOD_PERL}) {
+ $caller = 1;
+ }
+ my ($package, $filename, $line, $fonction) = caller ($caller);
+
+ $package = "" unless defined $package;
+ $filename = "" unless defined $filename;
+ $line = 0 unless defined $line;
+ $fonction = $basename unless defined $fonction;
+ $level = lc($level);
+ $level = 'info' unless defined $level and length $level;
+
+ unless (defined $message and length $message) {
+ $message = "[void]";
+ }
+
+ my $level_str = $g_rh_label{$level};
+ $message = $level_str . " * $message";
+ $message .= " - $fonction ($filename l. $line)" if $line;
+
+ $message =~ s/%/%%/g; # we have to escape % to avoid a bug related to sprintf()
+ $message = $g_rh_prefix->{$fullname} . " > " . $message if
+ (defined $g_rh_prefix->{$fullname} and length $g_rh_prefix->{$fullname});
+
+ my $sig = $SIG{__WARN__};
+ $SIG{__WARN__} = sub {};
+ eval {
+ syslog($level, $message);
+ };
+ $SIG{__WARN__} = $sig;
+}
+
+# returns the appropriate filename
+sub __get_script_name()
+{
+ # si on est en mod perl, il faut utiliser $ENV{'SCRIPT_FILENAME'}
+ return $ENV{'SCRIPT_FILENAME'} if $ENV{'MOD_PERL'} and $ENV{'SCRIPT_FILENAME'};
+ return $0;
+}
+
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=head1 COPYRIGHT
+
+This program is copyright © 2004-2006 Alexis Sukrieh
+
+=head1 AUTHOR
+
+Alexis Sukrieh <sukria at sukria.net>
+
+Very first versions were made at Cegetel (2004-2005) ; Thomas Parmelan gave a
+hand for the mod_perl support.
+
+=cut
+
+1;
More information about the Pkg-perl-cvs-commits
mailing list