r47738 - in /branches/upstream/liblog-handler-perl/current: ChangeLog META.yml lib/Log/Handler.pm lib/Log/Handler/Examples.pod lib/Log/Handler/Output/Email.pm lib/Log/Handler/Output/Sendmail.pm t/015-handler-filter-message.t t/040-output-email.t
carnil-guest at users.alioth.debian.org
carnil-guest at users.alioth.debian.org
Tue Nov 24 20:11:35 UTC 2009
Author: carnil-guest
Date: Tue Nov 24 20:11:27 2009
New Revision: 47738
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=47738
Log:
[svn-upgrade] Integrating new upstream version, liblog-handler-perl (0.63)
Modified:
branches/upstream/liblog-handler-perl/current/ChangeLog
branches/upstream/liblog-handler-perl/current/META.yml
branches/upstream/liblog-handler-perl/current/lib/Log/Handler.pm
branches/upstream/liblog-handler-perl/current/lib/Log/Handler/Examples.pod
branches/upstream/liblog-handler-perl/current/lib/Log/Handler/Output/Email.pm
branches/upstream/liblog-handler-perl/current/lib/Log/Handler/Output/Sendmail.pm
branches/upstream/liblog-handler-perl/current/t/015-handler-filter-message.t
branches/upstream/liblog-handler-perl/current/t/040-output-email.t
Modified: branches/upstream/liblog-handler-perl/current/ChangeLog
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblog-handler-perl/current/ChangeLog?rev=47738&op=diff
==============================================================================
--- branches/upstream/liblog-handler-perl/current/ChangeLog (original)
+++ branches/upstream/liblog-handler-perl/current/ChangeLog Tue Nov 24 20:11:27 2009
@@ -1,3 +1,10 @@
+0.63 Released at 2009-11-24.
+ - Fixed a typo in Email.pm (RT #51745).
+ - Added options cc and bcc to Email.pm - this was a
+ feature request.
+ - It's now possible to pass the log level to log()
+ of Sendmail.pm.
+
0.62 Released at 2009-11-06.
- Some bug fixes for reload() but it should run now :-)
Modified: branches/upstream/liblog-handler-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblog-handler-perl/current/META.yml?rev=47738&op=diff
==============================================================================
--- branches/upstream/liblog-handler-perl/current/META.yml (original)
+++ branches/upstream/liblog-handler-perl/current/META.yml Tue Nov 24 20:11:27 2009
@@ -1,6 +1,6 @@
---
name: Log-Handler
-version: 0.62
+version: 0.63
author:
- Jonny Schulz
abstract: Log messages to several outputs.
@@ -31,7 +31,7 @@
provides:
Log::Handler:
file: lib/Log/Handler.pm
- version: 0.62
+ version: 0.63
Log::Handler::Config:
file: lib/Log/Handler/Config.pm
version: 0.07
@@ -46,7 +46,7 @@
version: 0.09
Log::Handler::Output::Email:
file: lib/Log/Handler/Output/Email.pm
- version: 0.06
+ version: 0.07
Log::Handler::Output::File:
file: lib/Log/Handler/Output/File.pm
version: 0.06
@@ -58,7 +58,7 @@
version: 0.06
Log::Handler::Output::Sendmail:
file: lib/Log/Handler/Output/Sendmail.pm
- version: 0.05
+ version: 0.06
Log::Handler::Output::Socket:
file: lib/Log/Handler/Output/Socket.pm
version: 0.08
Modified: branches/upstream/liblog-handler-perl/current/lib/Log/Handler.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblog-handler-perl/current/lib/Log/Handler.pm?rev=47738&op=diff
==============================================================================
--- branches/upstream/liblog-handler-perl/current/lib/Log/Handler.pm (original)
+++ branches/upstream/liblog-handler-perl/current/lib/Log/Handler.pm Tue Nov 24 20:11:27 2009
@@ -1114,7 +1114,7 @@
use UNIVERSAL;
use base qw(Log::Handler::Levels);
-our $VERSION = "0.62";
+our $VERSION = "0.63";
our $ERRSTR = "";
# $TRACE and $CALLER_LEVEL are both used as global
@@ -1251,7 +1251,11 @@
}, $class;
if (@_) {
- $self->add(@_);
+ if ($_[0] eq "config") {
+ $self->config(@_);
+ } else {
+ $self->add(@_);
+ }
}
return $self;
@@ -1259,6 +1263,10 @@
sub add {
my $self = shift;
+
+ if ($_[0] && $_[0] eq "config") {
+ return $self->config(@_);
+ }
if (@_ > 2) {
while (@_) {
@@ -1281,7 +1289,7 @@
# Create the new output-object.
my $output = $self->_new_output($package, $h_opts, $o_opts);
- # Add the output $self.
+ # Add the output to $self.
$self->_add_output($output);
return 1;
@@ -1361,7 +1369,7 @@
# output-object is reloaded.
if (!$self->output($alias)) {
# If the alias does not exists we use
- # the alias that was generated on validate().
+ # the alias that was generated by validate().
if (!exists $n_opts->{alias}) {
$n_opts->{alias} = $h_opts->{alias};
}
@@ -1375,8 +1383,6 @@
}
};
- # Something wents wrong.
- # The error message should be in $ERRSTR.
if ($@) {
return $self->_raise_error($@);
}
Modified: branches/upstream/liblog-handler-perl/current/lib/Log/Handler/Examples.pod
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblog-handler-perl/current/lib/Log/Handler/Examples.pod?rev=47738&op=diff
==============================================================================
--- branches/upstream/liblog-handler-perl/current/lib/Log/Handler/Examples.pod (original)
+++ branches/upstream/liblog-handler-perl/current/lib/Log/Handler/Examples.pod Tue Nov 24 20:11:27 2009
@@ -191,6 +191,7 @@
buffer => 0,
maxlevel => "emergency",
minlevel => "emergency",
+ message_pattern => '%L',
}
);
@@ -207,7 +208,9 @@
from => "bar at foo.example",
to => "foo at bar.example",
subject => "your subject",
- maxlevel => "info",
+ maxlevel => "error",
+ minlevel => "error",
+ message_pattern => '%L',
}
);
@@ -431,7 +434,19 @@
=head1 CONFIG
-Examples with Config::General.
+Examples:
+
+ my $log = Log::Handler->new( config => "logger.conf" );
+
+ # or
+
+ $log->add( config => "logger.conf" );
+
+ # or
+
+ $log->config( config => "logger.conf" );
+
+Example with Config::General.
Script:
Modified: branches/upstream/liblog-handler-perl/current/lib/Log/Handler/Output/Email.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblog-handler-perl/current/lib/Log/Handler/Output/Email.pm?rev=47738&op=diff
==============================================================================
--- branches/upstream/liblog-handler-perl/current/lib/Log/Handler/Output/Email.pm (original)
+++ branches/upstream/liblog-handler-perl/current/lib/Log/Handler/Output/Email.pm Tue Nov 24 20:11:27 2009
@@ -32,7 +32,7 @@
Call C<new()> to create a new Log::Handler::Output::Email object.
-The following options are possible:
+The following opts are possible:
=over 4
@@ -63,6 +63,8 @@
The receipient address (RCPT TO).
+Additional options are B<cc> and B<bcc>.
+
=item B<subject>
The subject of the mail.
@@ -71,7 +73,7 @@
=item B<buffer>
-This options exists only for security. The thing is that it would be very bad
+This opts exists only for security. The thing is that it would be very bad
if something wents wrong in your program and hundreds of mails would be send.
For this reason you can set a buffer to take care.
@@ -101,25 +103,19 @@
$email->log(message => "this message will be mailed");
- # or
-
- $email->log(
- message => "this message will be mailed",
- subject => "your subject",
- level => "INFO",
- );
-
-If you pass C<"level => 'INFO'"> then the level is placed into the subject:
-
- INFO: your subject
-
-As example you can use message_pattern from L<Log::Handler> to pass the level:
-
- message_pattern => "%L"
-
-then the level is placed into the subject.
-
-If you use a buffer higher than 0 then the level from the last message is used.
+If you pass the level then its placed into the subject:
+
+ $email->log(message => "foo", level => "INFO");
+ $email->log(message => "bar", level => "ERROR");
+ $email->log(message => "baz", level => "DEBUG");
+
+The lowest level is used:
+
+ Subject: ERROR: ...
+
+You can pass the level with C<Log::Handler> by setting
+
+ message_pattern => '%L'
=head2 flush()
@@ -186,9 +182,21 @@
use Net::SMTP;
use Params::Validate qw();
-our $VERSION = "0.06";
+our $VERSION = "0.07";
our $ERRSTR = "";
our $TEST = 0; # is needed to disable flush() for tests
+
+my %LEVEL_BY_STRING = (
+ DEBUG => 7,
+ INFO => 6,
+ NOTICE => 5,
+ WARNING => 4,
+ ERROR => 3,
+ CRITICAL => 2,
+ ALERT => 1,
+ EMERGENCY => 0,
+ FATAL => 0,
+);
sub new {
my $class = shift;
@@ -199,16 +207,17 @@
sub log {
my $self = shift;
my $message = @_ > 1 ? {@_} : shift;
+ my $buffer = $self->{message_buffer};
if ($self->{buffer} == 0) {
return $self->sendmail($message);
}
- if (@{$self->{MESSAGE_BUFFER}} < $self->{buffer}) {
- push @{$self->{MESSAGE_BUFFER}}, $message;
- }
-
- if (@{$self->{MESSAGE_BUFFER}} == $self->{buffer}) {
+ if (@$buffer < $self->{buffer}) {
+ push @$buffer, $message;
+ }
+
+ if (@$buffer == $self->{buffer}) {
return $self->flush;
}
@@ -216,19 +225,29 @@
}
sub flush {
- my $self = shift;
- my $message = ();
- my $string = "";
-
- if ($TEST || !@{$self->{MESSAGE_BUFFER}}) {
+ my $self = shift;
+ my $string = ();
+ my $buffer = $self->{message_buffer};
+
+ if ($TEST || !@$buffer) {
return 1;
}
- # Safe the last message to use the level for the subject
- $message = pop @{$self->{MESSAGE_BUFFER}};
-
- while (my $buffer = shift @{$self->{MESSAGE_BUFFER}}) {
- $string .= $buffer->{message};
+ # Safe the last message because the newest subject is used
+ my $message = pop @$buffer;
+
+ while (my $buf = shift @$buffer) {
+ if ($buf->{level} && !$message->{level}) {
+ $message->{level} = $buf->{level};
+ } elsif ($buf->{level} && $message->{level}) {
+ my $blevel = $buf->{level};
+ my $mlevel = $message->{level};
+ if ($LEVEL_BY_STRING{$mlevel} > $LEVEL_BY_STRING{$blevel}) {
+ $message->{level} = $buf->{level};
+ }
+ }
+
+ $string .= $buf->{message};
}
$message->{message} = $string . $message->{message};
@@ -241,6 +260,8 @@
my $subject = $message->{subject} || $self->{subject};
my $date = Email::Date::format_date();
my $smtp = ();
+ my $expect = 10;
+ my $success = 0;
if ($message->{level}) {
$subject = "$message->{level}: $subject";
@@ -260,19 +281,68 @@
return $self->_raise_error("smtp error: unable to connect to ".join(", ", @{$self->{host}}));
}
- my $success = 0;
- $success++ if $smtp->mail($self->{from});
- $success++ if $smtp->to($self->{to});
- $success++ if $smtp->data();
- $success++ if $smtp->datasend("From: $self->{from}\n");
- $success++ if $smtp->datasend("To: $self->{to}\n");
- $success++ if $smtp->datasend("Subject: $subject\n");
- $success++ if $smtp->datasend("Date: $date\n");
- $success++ if $smtp->datasend($message->{message}."\n");
- $success++ if $smtp->dataend();
- $success++ if $smtp->quit();
-
- if ($success != 10) {
+ if ($smtp->mail($self->{from})) {
+ $success++;
+ }
+
+ if ($smtp->to($self->{to})) {
+ $success++;
+ }
+
+ if ($self->{cc}) {
+ if ($smtp->cc($self->{cc})) {
+ $success++;
+ }
+ $expect++;
+ }
+
+ if ($self->{bcc}) {
+ if ($smtp->bcc($self->{bcc})) {
+ $success++;
+ }
+ $expect++;
+ }
+
+ if ($smtp->data) {
+ $success++;
+ }
+
+ if ($smtp->datasend("From: $self->{from}\n")) {
+ $success++;
+ }
+
+ if ($smtp->datasend("To: $self->{to}\n")) {
+ $success++;
+ }
+
+ if ($self->{cc}) {
+ if ($smtp->datasend("Cc: $self->{cc}\n")) {
+ $success++;
+ }
+ $expect++;
+ }
+
+ if ($smtp->datasend("Subject: $subject\n")) {
+ $success++;
+ }
+
+ if ($smtp->datasend("Date: $date\n")) {
+ $success++;
+ }
+
+ if ($smtp->datasend($message->{message}."\n")) {
+ $success++;
+ }
+
+ if ($smtp->dataend) {
+ $success++;
+ }
+
+ if ($smtp->quit) {
+ $success++;
+ }
+
+ if ($success != $expect) {
return $self->_raise_error("smtp error($success): unable to send mail to $self->{to}");
}
@@ -328,7 +398,7 @@
my $progname = $0;
$progname =~ s at .*[/\\]@@;
- my %options = Params::Validate::validate(@_, {
+ my %opts = Params::Validate::validate(@_, {
host => {
type => Params::Validate::ARRAYREF | Params::Validate::SCALAR,
},
@@ -352,6 +422,14 @@
to => {
type => Params::Validate::SCALAR,
},
+ cc => {
+ type => Params::Validate::SCALAR,
+ optional => 1,
+ },
+ bcc => {
+ type => Params::Validate::SCALAR,
+ optional => 1,
+ },
subject => {
type => Params::Validate::SCALAR,
default => "Log message from $progname",
@@ -362,21 +440,22 @@
},
});
- if (!ref($options{host})) {
- $options{host} = [ $options{host} ];
- }
-
- if ($options{subject}) {
- $options{subject} =~ s/\n/ /g;
- $options{subject} =~ s/(.{78})/$1\n /;
- if (length($options{subject}) > 998) {
+ if (!ref($opts{host})) {
+ $opts{host} = [ $opts{host} ];
+ }
+
+ if ($opts{subject}) {
+ $opts{subject} =~ s/\n/ /g;
+ $opts{subject} =~ s/(.{78})/$1\n /g;
+
+ if (length($opts{subject}) > 998) {
warn "Subject to long for email!";
- $options{subject} = substr($options{subject}, 0, 998);
+ $opts{subject} = substr($opts{subject}, 0, 998);
}
}
- $options{MESSAGE_BUFFER} = [ ];
- return \%options;
+ $opts{message_buffer} = [ ];
+ return \%opts;
}
sub _raise_error {
Modified: branches/upstream/liblog-handler-perl/current/lib/Log/Handler/Output/Sendmail.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblog-handler-perl/current/lib/Log/Handler/Output/Sendmail.pm?rev=47738&op=diff
==============================================================================
--- branches/upstream/liblog-handler-perl/current/lib/Log/Handler/Output/Sendmail.pm (original)
+++ branches/upstream/liblog-handler-perl/current/lib/Log/Handler/Output/Sendmail.pm Tue Nov 24 20:11:27 2009
@@ -120,6 +120,20 @@
$email->log(message => "this message will be mailed");
+If you pass the level then its placed into the subject:
+
+ $email->log(message => "foo", level => "INFO");
+ $email->log(message => "bar", level => "ERROR");
+ $email->log(message => "baz", level => "DEBUG");
+
+The lowest level is used:
+
+ Subject: ERROR ...
+
+You can pass the level with C<Log::Handler> by setting
+
+ message_pattern => '%L'
+
=head2 flush()
Call C<flush()> if you want to flush the buffered messages.
@@ -175,9 +189,21 @@
use Carp;
use Params::Validate qw();
-our $VERSION = "0.05";
+our $VERSION = "0.06";
our $ERRSTR = "";
our $TEST = 0; # is needed to disable flush() for tests
+
+my %LEVEL_BY_STRING = (
+ DEBUG => 7,
+ INFO => 6,
+ NOTICE => 5,
+ WARNING => 4,
+ ERROR => 3,
+ CRITICAL => 2,
+ ALERT => 1,
+ EMERGENCY => 0,
+ FATAL => 0,
+);
sub new {
my $class = shift;
@@ -200,6 +226,11 @@
if ($self->{debug}) {
warn "$class: maxsize disabled, no buffering";
}
+
+ if ($message->{level}) {
+ $self->{level} = $message->{level};
+ }
+
$self->{message} = $message->{message};
return $self->_sendmail;
}
@@ -209,6 +240,17 @@
warn "$class: maxsize of $self->{maxsize} reached";
}
$self->flush;
+ }
+
+ if ($message->{level} && !$self->{level}) {
+ $self->{level} = $message->{level};
+ } elsif ($self->{level} && $message->{level}) {
+ my $slevel = $self->{level};
+ my $mlevel = $message->{level};
+
+ if ($LEVEL_BY_STRING{$slevel} > $LEVEL_BY_STRING{$mlevel}) {
+ $self->{level} = $message->{level};
+ }
}
$self->{message} .= $message->{message};
@@ -290,19 +332,24 @@
warn "$class: message $self->{length} bytes";
}
+ if ($self->{level}) {
+ $header =~ s/Subject:(.)/Subject: $self->{level}:$1/;
+ $self->{level} = "";
+ }
+
open my $fh, "|$sendmail"
or return $self->raise_error("unable to execute '$self->{sendmail}' - $!");
my $ret = print $fh $header, "\n", $self->{message};
+ close $fh;
+
$self->{message} = "";
$self->{length} = 0;
if (!$ret) {
return $self->raise_error("unable to write to stdin - $!");
}
-
- close $fh;
return 1;
}
Modified: branches/upstream/liblog-handler-perl/current/t/015-handler-filter-message.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblog-handler-perl/current/t/015-handler-filter-message.t?rev=47738&op=diff
==============================================================================
--- branches/upstream/liblog-handler-perl/current/t/015-handler-filter-message.t (original)
+++ branches/upstream/liblog-handler-perl/current/t/015-handler-filter-message.t Tue Nov 24 20:11:27 2009
@@ -1,11 +1,16 @@
use strict;
use warnings;
-use Test::More tests => 8;
+#use Test::More tests => 8;
+use Test::More tests => 7;
use Log::Handler;
+
+# Comment out "string 2" becaus ValidatePP.pm is unable to handle
+# regexes on some perl versions! That is strange, but not a problem
+# of Log::Handler.
my %STRING = (
'string 1' => 0,
- 'string 2' => 0,
+# 'string 2' => 0,
'string 3' => 0,
'string 4' => 0,
'string 5' => 0,
@@ -25,13 +30,13 @@
}
);
-$log->add(
- forward => {
- forward_to => \&check,
- maxlevel => 6,
- filter_message => qr/STRING\s2$/i,
- }
-);
+#$log->add(
+# forward => {
+# forward_to => \&check,
+# maxlevel => 6,
+# filter_message => qr/STRING\s2$/i,
+# }
+#);
$log->add(
forward => {
@@ -68,13 +73,13 @@
}
$log->info('string 1');
-$log->info('string 2');
+#$log->info('string 2');
$log->info('string 3');
$log->info('string 4');
$log->info('string 5');
$log->info('string 1 foo');
-$log->info('string 2 foo');
+#$log->info('string 2 foo');
$log->info('string 3 foo');
$log->info('string 4 foo');
$log->info('string 5 bar');
Modified: branches/upstream/liblog-handler-perl/current/t/040-output-email.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblog-handler-perl/current/t/040-output-email.t?rev=47738&op=diff
==============================================================================
--- branches/upstream/liblog-handler-perl/current/t/040-output-email.t (original)
+++ branches/upstream/liblog-handler-perl/current/t/040-output-email.t Tue Nov 24 20:11:27 2009
@@ -44,7 +44,7 @@
my $match_lines = 0;
my $all_lines = 0;
-foreach my $line ( @{$log->{MESSAGE_BUFFER}} ) {
+foreach my $line ( @{$log->{message_buffer}} ) {
++$all_lines;
next unless $line->{message} =~ /^test \d+$/;
++$match_lines;
More information about the Pkg-perl-cvs-commits
mailing list