Hello community,
here is the log from the commit of package perl-Log-Log4perl
checked in at Sun Apr 6 07:42:47 CEST 2008.
--------
--- perl-Log-Log4perl/perl-Log-Log4perl.changes 2007-07-16 12:02:29.000000000 +0200
+++ perl-Log-Log4perl/perl-Log-Log4perl.changes 2008-04-04 11:23:04.079398000 +0200
@@ -1,0 +2,25 @@
+Fri Apr 4 11:20:41 CEST 2008 - ug@suse.de
+
+- version update from 1.12 to 1.15
+- appender_thresholds_adjust() with a parameter of 0 now
+ does nothing (requested by Oliver Koch).
+- Added 'defer_connection' to Socket appender so it's more useful
+ under Apache.
+- [rt.cpan.org #32738] fixed caller_depth for error_warn()
+ (reported by Felix Antonius Wilhelm Ostmann)
+- [rt.cpan.org #32942] fixed get_logger() for subclassed Log4perl
+ (reported by Felix Antonius Wilhelm Ostmann)
+- Fixed test suite bug which surfaced in Darwin because temporary
+ files contain '++' which freaked out the sloppy regex match.
+- Better handling of empty config files (reported by Robert Raisch)
+- Rewrote the Synchronized appender to use semaphores exclusivly
+ (got rid of IPC::Shareable).
+- Added Log::Log4perl::Util::Semaphore for easy semop handling
+ Fixed t/026FileApp.t to work on MSWin32.
+- Another doc fix by Craig
+- Applied Fedora 7 patches
+- Added create_at_logtime option to file appender
+- Added trace level color (yellow) in ScreenColoredLevels
+ appender as suggested by Arvind Jayaprakash in
+
+-------------------------------------------------------------------
Old:
----
Log-Log4perl-1.12.tar.gz
New:
----
Log-Log4perl-1.15.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ perl-Log-Log4perl.spec ++++++
--- /var/tmp/diff_new_pack.L10693/_old 2008-04-06 07:40:50.000000000 +0200
+++ /var/tmp/diff_new_pack.L10693/_new 2008-04-06 07:40:50.000000000 +0200
@@ -1,7 +1,7 @@
#
-# spec file for package perl-Log-Log4perl (Version 1.12)
+# spec file for package perl-Log-Log4perl (Version 1.15)
#
-# Copyright (c) 2007 SUSE LINUX Products GmbH, Nuernberg, Germany.
+# Copyright (c) 2008 SUSE LINUX Products GmbH, Nuernberg, Germany.
# This file and all modifications and additions to the pristine
# package are under the same license as the package itself.
#
@@ -10,13 +10,14 @@
# norootforbuild
+
Name: perl-Log-Log4perl
License: Artistic License
Group: Development/Libraries/Perl
#Requires:
-Autoreqprov: on
+AutoReqProv: on
Summary: Log4j implementation for Perl
-Version: 1.12
+Version: 1.15
Release: 1
Source: Log-Log4perl-%{version}.tar.gz
BuildRoot: %{_tmppath}/%{name}-%{version}-build
@@ -77,7 +78,29 @@
%doc %{_mandir}/man3/*
%changelog
-* Mon Jul 16 2007 - ug@suse.de
+* Fri Apr 04 2008 ug@suse.de
+- version update from 1.12 to 1.15
+- appender_thresholds_adjust() with a parameter of 0 now
+ does nothing (requested by Oliver Koch).
+- Added 'defer_connection' to Socket appender so it's more useful
+ under Apache.
+- [rt.cpan.org #32738] fixed caller_depth for error_warn()
+ (reported by Felix Antonius Wilhelm Ostmann)
+- [rt.cpan.org #32942] fixed get_logger() for subclassed Log4perl
+ (reported by Felix Antonius Wilhelm Ostmann)
+- Fixed test suite bug which surfaced in Darwin because temporary
+ files contain '++' which freaked out the sloppy regex match.
+- Better handling of empty config files (reported by Robert Raisch)
+- Rewrote the Synchronized appender to use semaphores exclusivly
+ (got rid of IPC::Shareable).
+- Added Log::Log4perl::Util::Semaphore for easy semop handling
+ Fixed t/026FileApp.t to work on MSWin32.
+- Another doc fix by Craig
+- Applied Fedora 7 patches
+- Added create_at_logtime option to file appender
+- Added trace level color (yellow) in ScreenColoredLevels
+ appender as suggested by Arvind Jayaprakash in
+* Mon Jul 16 2007 ug@suse.de
- version update from 1.07 to 1.12
- Added Log::Log4perl::Resurrector to resurrect commented-out
Log4perl statements in all subsequently loaded modules (allows
@@ -122,25 +145,25 @@
left over from previous init_and_watch() calls. Reported
by Andreas Koenig who saw sporadic errors in the test suite,
thanks!
-* Wed Oct 25 2006 - ug@suse.de
+* Wed Oct 25 2006 ug@suse.de
- version update from 1.02 to 1.07
- minor bugfixes
- documentation enhanced
-* Wed Jan 25 2006 - mls@suse.de
+* Wed Jan 25 2006 mls@suse.de
- converted neededforbuild to BuildRequires
-* Tue Jan 03 2006 - ug@suse.de
+* Tue Jan 03 2006 ug@suse.de
- version update from 1.01 to 1.02
-* Mon Dec 12 2005 - ug@suse.de
+* Mon Dec 12 2005 ug@suse.de
- version update from 0.52 to 1.01
-* Wed Sep 28 2005 - dmueller@suse.de
+* Thu Sep 29 2005 dmueller@suse.de
- add norootforbuild
-* Wed Jul 13 2005 - ug@suse.de
+* Wed Jul 13 2005 ug@suse.de
- version update from 0.51 to 0.52
- DateFormat.pm fix for 3-letter month abbreviations
- shortcut to simulate Apache's log format
- better error message when a logger is defined
twice in a config.
-* Fri Jan 21 2005 - ug@suse.de
+* Fri Jan 21 2005 ug@suse.de
- version update from 0.47 to 0.51
- Added umask option to file appender
- Added remove_appender() and eradicate_appender() method
@@ -151,7 +174,7 @@
- Added ScreenANSIColor appender to colorize messages
- New interface for custom config parsers.
- tons of fixes
-* Fri Aug 20 2004 - ug@suse.de
+* Fri Aug 20 2004 ug@suse.de
- version update from 0.42 to 0.47
- added filename() method to L4P::Appender::File
- added RRDs appender Log::Log4perl::Appender::RRDs
@@ -161,11 +184,11 @@
- added Log::Log4perl::infiltrate_lwp() to make LWP::UserAgent
play in the L4p framework upon request
- tons of fixes
-* Fri Feb 27 2004 - ug@suse.de
+* Fri Feb 27 2004 ug@suse.de
- version update from 0.36 to 0.42
-* Mon Aug 25 2003 - ro@suse.de
+* Mon Aug 25 2003 ro@suse.de
- remove man3 dir from filelist (already in filesystem.rpm)
-* Mon Aug 25 2003 - ro@suse.de
+* Mon Aug 25 2003 ro@suse.de
- removed noarch: perl modules always have arch in the path
-* Mon Aug 25 2003 - ug@suse.de
+* Mon Aug 25 2003 ug@suse.de
- initial package
++++++ Log-Log4perl-1.12.tar.gz -> Log-Log4perl-1.15.tar.gz ++++++
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Log-Log4perl-1.12/Changes new/Log-Log4perl-1.15/Changes
--- old/Log-Log4perl-1.12/Changes 2007-06-23 22:18:44.000000000 +0200
+++ new/Log-Log4perl-1.15/Changes 2008-02-10 09:04:38.000000000 +0100
@@ -2,6 +2,34 @@
Revision history for Log::Log4perl
##################################################
+1.15 (2008/02/10)
+ * (ms) appender_thresholds_adjust() with a parameter of 0 now
+ does nothing (requested by Oliver Koch).
+ * (kg) Added 'defer_connection' to Socket appender so it's more useful
+ under Apache.
+ * (ms) [rt.cpan.org #32738] fixed caller_depth for error_warn()
+ (reported by Felix Antonius Wilhelm Ostmann)
+ * (ms) [rt.cpan.org #32942] fixed get_logger() for subclassed Log4perl
+ (reported by Felix Antonius Wilhelm Ostmann)
+
+1.14 (2007/11/18)
+ * (ms) Fixed test suite bug which surfaced in Darwin because temporary
+ files contain '++' which freaked out the sloppy regex match.
+ * (ms) Better handling of empty config files (reported by Robert Raisch)
+ * (ms) Rewrote the Synchronized appender to use semaphores exclusivly
+ (got rid of IPC::Shareable).
+ * (ms) Added Log::Log4perl::Util::Semaphore for easy semop handling
+ * (ms) Fixed t/026FileApp.t to work on MSWin32.
+
+1.13 (2007/10/11)
+ * (ms) Another doc fix by Craig
+ * (ms) Applied Fedora 7 patches
+ * (ms) Added create_at_logtime option to file appender
+ * (ms) Added trace level color (yellow) in ScreenColoredLevels
+ appender as suggested by Arvind Jayaprakash in
+ https://sourceforge.net/tracker/index.php?
+ func=detail&aid=1791445&group_id=56939&atid=482388
+
1.12 (2007/06/23)
* (ms) Added Log::Log4perl::Resurrector to resurrect commented-out
Log4perl statements in all subsequently loaded modules (allows
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Log-Log4perl-1.12/lib/Log/Log4perl/Appender/File.pm new/Log-Log4perl-1.15/lib/Log/Log4perl/Appender/File.pm
--- old/Log-Log4perl-1.12/lib/Log/Log4perl/Appender/File.pm 2007-05-30 02:41:46.000000000 +0200
+++ new/Log-Log4perl-1.15/lib/Log/Log4perl/Appender/File.pm 2007-07-17 19:07:10.000000000 +0200
@@ -29,9 +29,14 @@
recreate_check_interval => 30,
recreate_check_signal => undef,
recreate_pid_write => undef,
+ create_at_logtime => 0,
@options,
};
+ if($self->{create_at_logtime}) {
+ $self->{recreate} = 1;
+ }
+
if(defined $self->{umask} and $self->{umask} =~ /^0/) {
# umask value is a string, meant to be an oct value
$self->{umask} = oct($self->{umask});
@@ -52,7 +57,7 @@
}
# This will die() if it fails
- $self->file_open();
+ $self->file_open() unless $self->{create_at_logtime};
return $self;
}
@@ -210,7 +215,8 @@
$self->file_switch($self->{filename});
}
} else {
- if($self->{watcher}->file_has_moved()) {
+ if(!$self->{watcher} or
+ $self->{watcher}->file_has_moved()) {
$self->file_switch($self->{filename});
}
}
@@ -396,6 +402,22 @@
Check the FAQ for using this option with the log rotating
utility C<newsyslog>.
+=item create_at_logtime
+
+The file appender typically creates its logfile in its constructor, i.e.
+at Log4perl C time. This is desirable for most use cases, because
+it makes sure that file permission problems get detected right away, and
+not after days/weeks/months of operation when the appender suddenly needs
+to log something and fails because of a problem that was obvious at
+startup.
+
+However, there are rare use cases where the file shouldn't be created
+at Log4perl C time, e.g. if the appender can't be used by the current
+user although it is defined in the configuration file. If you set
+C to a true value, the file appender will try to create
+the file at log time. Note that this setting lets permission problems
+sit undetected until log time, which might be undesirable.
+
=back
Design and implementation of this module has been greatly inspired by
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Log-Log4perl-1.12/lib/Log/Log4perl/Appender/ScreenColoredLevels.pm new/Log-Log4perl-1.15/lib/Log/Log4perl/Appender/ScreenColoredLevels.pm
--- old/Log-Log4perl-1.12/lib/Log/Log4perl/Appender/ScreenColoredLevels.pm 2006-02-04 21:29:08.000000000 +0100
+++ new/Log-Log4perl-1.15/lib/Log/Log4perl/Appender/ScreenColoredLevels.pm 2007-10-12 04:39:45.000000000 +0200
@@ -43,6 +43,8 @@
my($level, $message) = @_;
if(0) {
+ } elsif($level eq "TRACE") {
+ return YELLOW . $message . RESET;
} elsif($level eq "DEBUG") {
return $message;
} elsif($level eq "INFO") {
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Log-Log4perl-1.12/lib/Log/Log4perl/Appender/Socket.pm new/Log-Log4perl-1.15/lib/Log/Log4perl/Appender/Socket.pm
--- old/Log-Log4perl-1.12/lib/Log/Log4perl/Appender/Socket.pm 2006-02-04 21:29:08.000000000 +0100
+++ new/Log-Log4perl-1.15/lib/Log/Log4perl/Appender/Socket.pm 2008-01-29 07:06:16.000000000 +0100
@@ -24,15 +24,18 @@
bless $self, $class;
- unless($self->connect(@options)) {
- if($self->{silent_recovery}) {
- warn "Connect to $self->{PeerAddr}:$self->{PeerPort} failed: $!";
- return $self;
+ unless ($self->{defer_connection}){
+ unless($self->connect(@options)) {
+ if($self->{silent_recovery}) {
+ warn "Connect to $self->{PeerAddr}:$self->{PeerPort} failed: $!";
+ return $self;
+ }
+ die "Connect to $self->{PeerAddr}:$self->{PeerPort} failed: $!";
}
- die "Connect to $self->{PeerAddr}:$self->{PeerPort} failed: $!";
- }
- $self->{socket}->autoflush(1);
+ $self->{socket}->autoflush(1);
+ #autoflush has been the default behavior since 1997
+ }
return $self;
}
@@ -52,11 +55,12 @@
##################################################
my($self, %params) = @_;
+
{
# If we were never able to establish
# a connection, try to establish one
# here. If it fails, return.
- if($self->{silent_recovery} and
+ if(($self->{silent_recovery} or $self->{defer_connection}) and
!defined $self->{socket}) {
if(! $self->connect(%$self)) {
return undef;
@@ -68,7 +72,7 @@
};
if($@) {
- warn "Send to " . ref($self) . " failed ($@)";
+ warn "Send to " . ref($self) . " failed ($@), retrying once...";
if($self->connect(%$self)) {
redo;
}
@@ -134,6 +138,13 @@
Every log attempt will then try to establish the connection and
discard the message silently if it fails.
+Connecting at initialization time may not be the best option when
+running under Apache1 Apache2/prefork, because the parent process creates
+the socket and the connections are shared among the forked children--all
+the children writing to the same socket could intermingle messages. So instead
+of that, you can use C which will put off making the
+connection until the first log message is sent.
+
=head1 EXAMPLE
Write a server quickly using the IO::Socket::INET module:
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Log-Log4perl-1.12/lib/Log/Log4perl/Appender/Synchronized.pm new/Log-Log4perl-1.15/lib/Log/Log4perl/Appender/Synchronized.pm
--- old/Log-Log4perl-1.12/lib/Log/Log4perl/Appender/Synchronized.pm 2006-10-27 04:27:38.000000000 +0200
+++ new/Log-Log4perl-1.15/lib/Log/Log4perl/Appender/Synchronized.pm 2007-11-19 00:37:39.000000000 +0100
@@ -1,5 +1,5 @@
######################################################################
-# Synchronized.pm -- 2003, Mike Schilli
+# Synchronized.pm -- 2003, 2007 Mike Schilli
######################################################################
# Special appender employing a locking strategy to synchronize
# access.
@@ -11,13 +11,11 @@
use strict;
use warnings;
+use Log::Log4perl::Util::Semaphore;
our @ISA = qw(Log::Log4perl::Appender);
-use IPC::Shareable qw(:lock);
-use IPC::Semaphore;
-
-our $CVSVERSION = '$Revision: 1.9 $';
+our $CVSVERSION = '$Revision: 1.12 $';
our ($VERSION) = ($CVSVERSION =~ /(\d+\.\d+)/);
###########################################
@@ -28,27 +26,23 @@
my $self = {
appender=> undef,
key => '_l4p',
- options => { create => 1, destroy => 1 },
level => 0,
%options,
};
+ my @values = ();
+ for my $param (qw(uid gid mode destroy key)) {
+ push @values, $param, $self->{$param} if defined $self->{$param};
+ }
+
+ $self->{sem} = Log::Log4perl::Util::Semaphore->new(
+ @values
+ );
+
# Pass back the appender to be synchronized as a dependency
# to the configuration file parser
push @{$options{l4p_depends_on}}, $self->{appender};
- # Blow away lingering semaphores
- nuke_sem($self->{key});
-
- #warn "$$: IPCshareable created with $self->{key} $self->{options}\n";
-
- $self->{ipc_shareable} =
- tie $self->{ipc_shareable_var}, 'IPC::Shareable',
- $self->{key}, $self->{options} or
- die "tie failed: $!";
-
- $self->{ipc_shareable}->shunlock();
-
# Run our post_init method in the configurator after
# all appenders have been defined to make sure the
# appender we're syncronizing really exists
@@ -62,8 +56,7 @@
###########################################
my($self, %params) = @_;
- $self->{ipc_shareable}->shlock();
- #warn "pid $$ entered\n";
+ $self->{sem}->semlock();
# Relay that to the SUPER class which needs to render the
# message according to the appender's layout, first.
@@ -73,8 +66,7 @@
$params{log4p_level});
$Log::Log4perl::caller_depth -=2;
- #warn "pid $$ leaves\n";
- $self->{ipc_shareable}->shunlock();
+ $self->{sem}->semunlock();
}
###########################################
@@ -97,40 +89,6 @@
$self->{app} = $appender;
}
-###########################################
-sub DESTROY {
-###########################################
- my($self) = @_;
- no warnings;
- delete $self->{ipc_shareable};
- untie $self->{ipc_shareable_var};
-}
-
-###########################################
-sub nuke_sem {
-###########################################
-# This function nukes a semaphore previously
-# allocated by IPC::Shareable, which seems to
-# hang in its tie() function if an old semaphore
-# is still lingering around.
-###########################################
- my($key) = @_;
-
- $key = pack A4 => $key;
- $key = unpack i => $key;
-
- my $sem = IPC::Semaphore->new($key, 3, 0);
-
- # Didn't exist
- unless(defined $sem) {
- return undef;
- }
-
- $sem->remove() || die "Cannot remove semaphore $key ($!)";
-
- return 1;
-}
-
1;
__END__
@@ -168,11 +126,14 @@
for this would be a process spawning children, each of which inherits
the parent's Log::Log4perl configuration.
-Usually, you should avoid this scenario and have each child have its
-own Log::Log4perl configuration, ensuring that each e.g. writes to
-a different logfile.
+In most cases, you won't need an external synchronisation tool like
+Log::Log4perl::Appender::Synchronized at all. Log4perl's file appender,
+Log::Log4perl::Appender::File, for example, provides the C<syswrite>
+mechanism for making sure that even long log lines won't interleave.
+Short log lines won't interleave anyway, because the operating system
+makes sure the line gets written before a task switch occurs.
-In cases where you need additional synchronization, however, use
+In cases where you need additional synchronization, however, you can use
CLog::Log4perl::Appender::Synchronized as a gateway between your
loggers and your appenders. An appender itself,
CLog::Log4perl::Appender::Synchronized just takes two additional
@@ -203,7 +164,7 @@
=back
-CLog::Log4perl::Appender::Synchronized uses CIPC::Shareable
+CLog::Log4perl::Appender::Synchronized uses Log::Log4perl::Util::Semaphore
internally to perform locking with semaphores provided by the
operating system used.
@@ -249,23 +210,37 @@
=head2 Advanced configuration
-To configure the underlying IPC::Shareable module, use the I<options>
-property and hand it a reference to a hash of options.
-
-By default, the setting is equal to
-
- { create=>1, destroy=>1 }
-
-which has the appender create the semaphore at startup and remove
-it at shutdown.
-
-In order to add another option, e.g. a setting of C<0775> for
-IPC::Shareable's C<mode> parameter, add
-
- log4perl.appender.Syncer1.options = \
- sub { { create=>1, destroy=>1, mode=>0775 } }
-
-to the Log4perl configuration file.
+To configure the underlying Log::Log4perl::Util::Semaphore module in
+a different way than with the default settings provided by
+Log::Log4perl::Appender::Synchronized, use the options parameter:
+
+ log4perl.appender.Syncer1.destroy = 1
+ log4perl.appender.Syncer1.mode = sub { 0775 }
+ log4perl.appender.Syncer1.uid = hugo
+ log4perl.appender.Syncer1.gid = 100
+
+Valid keys are
+C<destroy> (Remove the semaphore on exit),
+C<mode> (permissions on the semaphore),
+C<uid> (uid or user name the semaphore is owned by),
+and
+C<gid> (group id the semaphore is owned by),
+
+Note that C<mode> is usually given in octal and therefore needs to be
+specified as a perl sub {}, unless you want to calculate what 0755 means
+in decimal.
+
+Changing ownership or group settings for a semaphore will obviously only
+work if the current user ID owns the semaphore already or if the current
+user is C<root>.
+
+=head2 Semaphore user and group IDs with mod_perl
+
+Setting user and group IDs is especially important when the Synchronized
+appender is used with mod_perl. If Log4perl gets initialized by a startup
+handler, which runs as root, and not as the user who will later use
+the semaphore, the settings for uid, gid, and mode can help establish
+matching semaphore ownership and access rights.
=head1 DEVELOPMENT NOTES
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Log-Log4perl-1.12/lib/Log/Log4perl/Config/Watch.pm new/Log-Log4perl-1.15/lib/Log/Log4perl/Config/Watch.pm
--- old/Log-Log4perl-1.12/lib/Log/Log4perl/Config/Watch.pm 2007-02-01 19:35:43.000000000 +0100
+++ new/Log-Log4perl-1.15/lib/Log/Log4perl/Config/Watch.pm 2007-07-15 21:49:19.000000000 +0200
@@ -1,8 +1,3 @@
-#!/usr/bin/perl
-###########################################
-use warnings;
-use strict;
-
package Log::Log4perl::Config::Watch;
use constant _INTERNAL_DEBUG => 0;
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Log-Log4perl-1.12/lib/Log/Log4perl/Config.pm new/Log-Log4perl-1.15/lib/Log/Log4perl/Config.pm
--- old/Log-Log4perl-1.12/lib/Log/Log4perl/Config.pm 2007-06-06 16:28:13.000000000 +0200
+++ new/Log-Log4perl-1.15/lib/Log/Log4perl/Config.pm 2007-11-10 01:39:11.000000000 +0100
@@ -625,6 +625,10 @@
print "Reading $config: [@text]\n" if _INTERNAL_DEBUG;
+ if(! grep /\S/, @text) {
+ return $data;
+ }
+
if ($text[0] =~ /^<\?xml /) {
die "XML::DOM not available" unless
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Log-Log4perl-1.12/lib/Log/Log4perl/FAQ.pm new/Log-Log4perl-1.15/lib/Log/Log4perl/FAQ.pm
--- old/Log-Log4perl-1.12/lib/Log/Log4perl/FAQ.pm 2007-05-30 02:44:55.000000000 +0200
+++ new/Log-Log4perl-1.15/lib/Log/Log4perl/FAQ.pm 2008-02-09 21:45:01.000000000 +0100
@@ -540,7 +540,7 @@
sub l4p_wrapper {
my($prio, @message) = @_;
$Log::Log4perl::caller_depth += 2;
- get_logger(caller(1))->log($prio, @message);
+ get_logger(scalar caller(1))->log($prio, @message);
$Log::Log4perl::caller_depth -= 2;
}
@@ -1447,20 +1447,41 @@
=head2 How can I synchronize access to an appender?
If you're using the same instance of an appender in multiple processes,
-each passing on messages to it in parallel, you might end up with
-overlapping log entries.
+and each process is passing on messages to the appender in parallel,
+you might end up with overlapping log entries.
-Imagine a file appender that you create in the main program, and which
-will then be shared between the parent and a forked child process. When
-it comes to logging, Log::Log4perl won't synchronize access to it.
-Depending on your operating system's flush mechanism, buffer size and the size
-of your messages, there's a small chance of an overlap.
-
-The easiest way to prevent overlapping messages in logfiles is setting the
-file appender's C<syswrite> flag. This makes sure that
+Typical scenarios include a file appender that you create in the main
+program, and which will then be shared between the parent and a
+forked child process. Or two separate processes, each initializing a
+Log4perl file appender on the same logfile.
+
+Log::Log4perl won't synchronize access to the shared logfile by
+default. Depending on your operating system's flush mechanism,
+buffer size and the size of your messages, there's a small chance of
+an overlap.
+
+The easiest way to prevent overlapping messages in logfiles written to
+by multiple processes is setting the
+file appender's C<syswrite> flag along with a file write mode of C<"append">.
+This makes sure that
CLog::Log4perl::Appender::File uses C (which is guaranteed
to run uninterrupted) instead of C which might buffer
-the message or get interrupted by the OS while it is writing.
+the message or get interrupted by the OS while it is writing. And in
+C<"append"> mode, the OS kernel ensures that multiple processes share
+one end-of-file marker, ensuring that each process writes to the I<real>
+end of the file. (The value of C<"append">
+for the C<mode> parameter is the default setting in Log4perl's file
+appender so you don't have to set it explicitely.)
+
+ # Guarantees atomic writes
+
+ log4perl.category.Bar.Twix = WARN, Logfile
+
+ log4perl.appender.Logfile = Log::Log4perl::Appender::File
+ log4perl.appender.Logfile.mode = append
+ log4perl.appender.Logfile.syswrite = 1
+ log4perl.appender.Logfile.filename = test.log
+ log4perl.appender.Logfile.layout = SimpleLayout
Another guaranteed way of having messages separated with any kind of
appender is putting a Log::Log4perl::Appender::Synchronized composite
@@ -2043,7 +2064,7 @@
log4perl.appender.ScreenApp.stderr = 0
log4perl.appender.ScreenApp.layout = SimpleLayout
### limiting output to ERROR messages
- log4perl.appender.Screenapp.Threshold = ERROR
+ log4perl.appender.ScreenApp.Threshold = ERROR
###
Note that without the second appender's C<Threshold> setting, both appenders
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Log-Log4perl-1.12/lib/Log/Log4perl/Logger.pm new/Log-Log4perl-1.15/lib/Log/Log4perl/Logger.pm
--- old/Log-Log4perl-1.12/lib/Log/Log4perl/Logger.pm 2007-06-23 22:16:12.000000000 +0200
+++ new/Log-Log4perl-1.15/lib/Log/Log4perl/Logger.pm 2008-01-29 07:00:40.000000000 +0100
@@ -992,7 +992,9 @@
##################################################
my $self = shift;
if ($self->is_error()) {
+ $Log::Log4perl::caller_depth++;
$self->error(@_);
+ $Log::Log4perl::caller_depth--;
$self->and_warn(@_);
}
}
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Log-Log4perl-1.12/lib/Log/Log4perl/Util/Semaphore.pm new/Log-Log4perl-1.15/lib/Log/Log4perl/Util/Semaphore.pm
--- old/Log-Log4perl-1.12/lib/Log/Log4perl/Util/Semaphore.pm 1970-01-01 01:00:00.000000000 +0100
+++ new/Log-Log4perl-1.15/lib/Log/Log4perl/Util/Semaphore.pm 2007-11-19 01:02:46.000000000 +0100
@@ -0,0 +1,235 @@
+#//////////////////////////////////////////
+package Log::Log4perl::Util::Semaphore;
+#//////////////////////////////////////////
+use IPC::SysV qw(IPC_RMID IPC_CREAT IPC_EXCL SEM_UNDO IPC_NOWAIT
+ IPC_SET IPC_STAT);
+use IPC::Semaphore;
+use strict;
+use warnings;
+use constant INTERNAL_DEBUG => 0;
+
+###########################################
+sub new {
+###########################################
+ my($class, %options) = @_;
+
+ my $self = {
+ key => undef,
+ mode => undef,
+ uid => undef,
+ gid => undef,
+ destroy => undef,
+ semop_wait => .1,
+ semop_retries => 1,
+ %options,
+ };
+
+ $self->{ikey} = unpack("i", pack("A4", $self->{key}));
+
+ # Accept usernames in the uid field as well
+ if(defined $self->{uid} and
+ $self->{uid} =~ /\D/) {
+ $self->{uid} = (getpwnam $self->{uid})[2];
+ }
+
+ bless $self, $class;
+ $self->init();
+
+ my @values = ();
+ for my $param (qw(mode uid gid)) {
+ push @values, $param, $self->{$param} if defined $self->{$param};
+ }
+ $self->semset(@values) if @values;
+
+ return $self;
+}
+
+###########################################
+sub init {
+###########################################
+ my($self) = @_;
+
+ print "Semaphore init '$self->{key}'/'$self->{ikey}'\n" if INTERNAL_DEBUG;
+
+ $self->{id} = semget( $self->{ikey},
+ 1,
+ &IPC_EXCL|&IPC_CREAT|($self->{mode}||0777),
+ );
+
+ if(! defined $self->{id} and
+ $! =~ /exists/) {
+ print "Semaphore '$self->{key}' already exists\n" if INTERNAL_DEBUG;
+ $self->{id} = semget( $self->{ikey}, 1, 0 )
+ or die "semget($self->{ikey}) failed: $!";
+ } elsif($!) {
+ die "Cannot create semaphore $self->{key}/$self->{ikey} ($!)";
+ }
+}
+
+###########################################
+sub status_as_string {
+###########################################
+ my($self, @values) = @_;
+
+ my $sem = IPC::Semaphore->new($self->{ikey}, 1, 0);
+
+ my $values = join('/', $sem->getall());
+ my $ncnt = $sem->getncnt(0);
+ my $pidlast = $sem->getpid(0);
+ my $zcnt = $sem->getzcnt(0);
+ my $id = $sem->id();
+
+ return <{key}
+iKey ..................................... $self->{ikey}
+Id ....................................... $id
+Values ................................... $values
+Processes waiting for counter increase ... $ncnt
+Processes waiting for counter to hit 0 ... $zcnt
+Last process to perform an operation ..... $pidlast
+EOT
+}
+
+###########################################
+sub semsetval {
+###########################################
+ my($self, %keyvalues) = @_;
+
+ my $sem = IPC::Semaphore->new($self->{ikey}, 1, 0);
+ $sem->setval(%keyvalues);
+}
+
+###########################################
+sub semset {
+###########################################
+ my($self, @values) = @_;
+
+ print "Setting values for semaphore $self->{key}/$self->{ikey}\n" if
+ INTERNAL_DEBUG;
+
+ my $sem = IPC::Semaphore->new($self->{ikey}, 1, 0);
+ $sem->set(@values);
+}
+
+###########################################
+sub semlock {
+###########################################
+ my($self) = @_;
+
+ my $operation = pack("s!*",
+ # wait until it's 0
+ 0, 0, 0,
+ # increment by 1
+ 0, 1, SEM_UNDO
+ );
+
+ print "Locking semaphore '$self->{key}'\n" if INTERNAL_DEBUG;
+ $self->semop($self->{id}, $operation);
+}
+
+###########################################
+sub semunlock {
+###########################################
+ my($self) = @_;
+
+ my $operation = pack("s!*",
+ # decrement by 1
+ 0, -1, (IPC_NOWAIT)
+ );
+
+ print "Unlocking semaphore '$self->{key}'\n" if INTERNAL_DEBUG;
+
+ # ignore errors, as they might result from trying to unlock an
+ # already unlocked semaphor.
+ semop($self->{id}, $operation);
+}
+
+###########################################
+sub remove {
+###########################################
+ my($self) = @_;
+
+ print "Removing semaphore '$self->{key}'\n" if INTERNAL_DEBUG;
+
+ semctl ($self->{id}, 0, &IPC_RMID, 0) or
+ die "Removing semaphore $self->{key} failed: $!";
+}
+
+###########################################
+sub DESTROY {
+###########################################
+ my($self) = @_;
+
+ if($self->{destroy}) {
+ $self->remove();
+ }
+}
+
+###########################################
+sub semop {
+###########################################
+ my($self, @args) = @_;
+
+ my $retries = $self->{semop_retries};
+
+ my $rc;
+
+ {
+ $rc = semop($args[0], $args[1]);
+
+ if(!$rc and
+ $! =~ /temporarily unavailable/ and
+ $retries-- > 0) {
+ $rc = 'undef' unless defined $rc;
+ print "semop failed (rc=$rc), retrying\n",
+ $self->status_as_string if INTERNAL_DEBUG;
+ select undef, undef, undef, $self->{semop_wait};
+ redo;
+ }
+ }
+
+ $rc or die "semop(@args) failed: $! ";
+ $rc;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Log::Log4perl::Util::Semaphore - Easy to use semaphores
+
+=head1 SYNOPSIS
+
+ use Log::Log4perl::Util::Semaphore;
+ my $sem = Log::Log4perl::Util::Semaphore->new( key => "abc" );
+
+ $sem->semlock();
+ # ... critical section
+ $sem->semunlock();
+
+ $sem->semset( uid => (getpwnam("hugo"))[2],
+ gid => 102,
+ mode => 0644
+ );
+
+=head1 DESCRIPTION
+
+Log::Log4perl::Util::Semaphore provides the synchronisation mechanism
+for the Synchronized.pm appender in Log4perl, but can be used independently
+of Log4perl.
+
+As a convenience, the C<uid> field accepts user names as well, which it
+translates into the corresponding uid by running C<getpwnam>.
+
+=head1 LEGALESE
+
+Copyright 2007 by Mike Schilli, all rights reserved.
+This program is free software, you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=head1 AUTHOR
+
+2007, Mike Schilli
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Log-Log4perl-1.12/lib/Log/Log4perl.pm new/Log-Log4perl-1.15/lib/Log/Log4perl.pm
--- old/Log-Log4perl-1.12/lib/Log/Log4perl.pm 2007-06-17 22:21:26.000000000 +0200
+++ new/Log-Log4perl-1.15/lib/Log/Log4perl.pm 2008-02-10 09:04:47.000000000 +0100
@@ -16,7 +16,7 @@
use constant _INTERNAL_DEBUG => 1;
-our $VERSION = '1.12';
+our $VERSION = '1.15';
# set this to '1' if you're using a wrapper
# around Log::Log4perl
@@ -337,23 +337,39 @@
##################################################
sub get_logger { # Get an instance (shortcut)
##################################################
- my($class, @args) = @_;
-
- if(!defined $class) {
- # Called as ::get_logger()
- unshift(@args, scalar caller());
- } elsif($class eq __PACKAGE__ and !defined $args[0]) {
- # Called as ->get_logger()
- unshift(@args, scalar caller());
- } elsif($class ne __PACKAGE__) {
- # Called as ::get_logger($category)
- unshift(@args, $class);
+ # get_logger() can be called in the following ways:
+ #
+ # (1) Log::Log4perl::get_logger() => ()
+ # (2) Log::Log4perl->get_logger() => ("Log::Log4perl")
+ # (3) Log::Log4perl::get_logger($cat) => ($cat)
+ #
+ # (5) Log::Log4perl->get_logger($cat) => ("Log::Log4perl", $cat)
+ # (6) L4pSubclass->get_logger($cat) => ("L4pSubclass", $cat)
+
+ # Note that (4) L4pSubclass->get_logger() => ("L4pSubclass")
+ # is indistinguishable from (3) and therefore can't be allowed.
+ # Wrapper classes always have to specify the category explicitely.
+
+ my $category;
+
+ if(@_ == 0) {
+ # 1
+ $category = scalar caller();
+ } elsif(@_ == 1) {
+ # 2, 3
+ if($_[0] eq __PACKAGE__) {
+ # 2
+ $category = scalar caller();
+ } else {
+ $category = $_[0];
+ }
} else {
- # Called as ->get_logger($category)
+ # 5, 6
+ $category = $_[1];
}
# Delegate this to the logger module
- return Log::Log4perl::Logger->get_logger(@args);
+ return Log::Log4perl::Logger->get_logger($category);
}
##################################################
@@ -369,6 +385,11 @@
shift if $_[0] eq __PACKAGE__;
my($delta, $appenders) = @_;
+ if($delta == 0) {
+ # Nothing to do, no delta given.
+ return 1;
+ }
+
if(defined $appenders) {
# Map names to objects
$appenders = [map {
@@ -433,7 +454,7 @@
my $l4p_wrapper = sub {
my($prio, @message) = @_;
$Log::Log4perl::caller_depth += 2;
- get_logger(caller(1))->log($prio, @message);
+ get_logger(scalar caller(1))->log($prio, @message);
$Log::Log4perl::caller_depth -= 2;
};
@@ -650,17 +671,18 @@
=head2 Log Levels
-There are five predefined log levels: C<FATAL>, C<ERROR>, C<WARN>, C<INFO>,
+There are six predefined log levels: C<FATAL>, C<ERROR>, C<WARN>, C<INFO>,
C<DEBUG>, and C<TRACE> (in descending priority). Your configured logging level
has to at least match the priority of the logging message.
If your configured logging level is C<WARN>, then messages logged
-with C and C message will be suppressed.
+with C, C, and C will be suppressed.
C, C and C will make their way through,
because their priority is higher or equal than the configured setting.
Instead of calling the methods
+ $logger->trace("..."); # Log a trace message
$logger->debug("..."); # Log a debug message
$logger->info("..."); # Log a info message
$logger->warn("..."); # Log a warn message
@@ -2342,6 +2364,32 @@
wrapper that's in between your application and CLog::Log4perl,
then CLog::Log4perl will compensate for the difference.
+Also, note that if you're using a subclass of Log4perl, like
+
+ package MyL4pWrapper;
+ use Log::Log4perl;
+ our @ISA = qw(Log::Log4perl);
+
+and you want to call get_logger() in your code, like
+
+ use MyL4pWrapper;
+
+ sub some_function {
+ my $logger = MyL4pWrapper->get_logger(__PACKAGE__);
+ $logger->debug("Hey, there.");
+ }
+
+you have to explicitly spell out the category, as in __PACKAGE__ above.
+You can't rely on
+
+ # Don't do that!
+ MyL4pWrapper->get_logger();
+
+and assume that Log4perl will take the class of the current package
+as the category. (Reason behind this is that Log4perl will think you're
+calling C and take "MyL4pWrapper" as the
+category.)
+
=head1 Access to Internals
The following methods are only of use if you want to peek/poke in
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Log-Log4perl-1.12/MANIFEST new/Log-Log4perl-1.15/MANIFEST
--- old/Log-Log4perl-1.12/MANIFEST 2007-06-23 22:28:33.000000000 +0200
+++ new/Log-Log4perl-1.15/MANIFEST 2008-02-10 09:07:10.000000000 +0100
@@ -62,6 +62,7 @@
lib/Log/Log4perl/NDC.pm
lib/Log/Log4perl/Resurrector.pm
lib/Log/Log4perl/Util.pm
+lib/Log/Log4perl/Util/Semaphore.pm
LICENSE
Makefile.PL
MANIFEST This list of files
@@ -122,6 +123,7 @@
t/051Extra.t
t/052Utf8.t
t/053Resurrect.t
+t/054Subclass.t
t/compare.pl
t/deeper1.expected
t/deeper6.expected
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Log-Log4perl-1.12/META.yml new/Log-Log4perl-1.15/META.yml
--- old/Log-Log4perl-1.12/META.yml 2007-06-23 22:28:37.000000000 +0200
+++ new/Log-Log4perl-1.15/META.yml 2008-02-10 09:07:15.000000000 +0100
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Log-Log4perl
-version: 1.12
+version: 1.15
abstract: Log4j implementation for Perl
license: ~
generated_by: ExtUtils::MakeMaker version 6.31
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Log-Log4perl-1.12/README new/Log-Log4perl-1.15/README
--- old/Log-Log4perl-1.12/README 2007-06-23 22:28:32.000000000 +0200
+++ new/Log-Log4perl-1.15/README 2008-02-10 09:07:10.000000000 +0100
@@ -1,5 +1,5 @@
######################################################################
- Log::Log4perl 1.12
+ Log::Log4perl 1.15
######################################################################
NAME
@@ -177,17 +177,18 @@
suppressed.
Log Levels
- There are five predefined log levels: "FATAL", "ERROR", "WARN", "INFO",
+ There are six predefined log levels: "FATAL", "ERROR", "WARN", "INFO",
"DEBUG", and "TRACE" (in descending priority). Your configured logging
level has to at least match the priority of the logging message.
If your configured logging level is "WARN", then messages logged with
- "info()" and "debug()" message will be suppressed. "fatal()", "error()"
- and "warn()" will make their way through, because their priority is
- higher or equal than the configured setting.
+ "info()", "debug()", and "trace()" will be suppressed. "fatal()",
+ "error()" and "warn()" will make their way through, because their
+ priority is higher or equal than the configured setting.
Instead of calling the methods
+ $logger->trace("..."); # Log a trace message
$logger->debug("..."); # Log a debug message
$logger->info("..."); # Log a info message
$logger->warn("..."); # Log a warn message
@@ -1771,6 +1772,32 @@
that's in between your application and "Log::Log4perl", then
"Log::Log4perl" will compensate for the difference.
+ Also, note that if you're using a subclass of Log4perl, like
+
+ package MyL4pWrapper;
+ use Log::Log4perl;
+ our @ISA = qw(Log::Log4perl);
+
+ and you want to call get_logger() in your code, like
+
+ use MyL4pWrapper;
+
+ sub some_function {
+ my $logger = MyL4pWrapper->get_logger(__PACKAGE__);
+ $logger->debug("Hey, there.");
+ }
+
+ you have to explicitly spell out the category, as in __PACKAGE__ above.
+ You can't rely on
+
+ # Don't do that!
+ MyL4pWrapper->get_logger();
+
+ and assume that Log4perl will take the class of the current package as
+ the category. (Reason behind this is that Log4perl will think you're
+ calling "get_logger("MyL4pWrapper")" and take "MyL4pWrapper" as the
+ category.)
+
Access to Internals
The following methods are only of use if you want to peek/poke in the
internals of Log::Log4perl. Be careful not to disrupt its inner
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Log-Log4perl-1.12/t/026FileApp.t new/Log-Log4perl-1.15/t/026FileApp.t
--- old/Log-Log4perl-1.12/t/026FileApp.t 2007-05-30 02:38:46.000000000 +0200
+++ new/Log-Log4perl-1.15/t/026FileApp.t 2007-11-19 01:24:57.000000000 +0100
@@ -27,11 +27,12 @@
my $testfile = File::Spec->catfile($WORK_DIR, "test26.log");
-BEGIN {plan tests => 13}
+BEGIN {plan tests => 15}
END { unlink $testfile;
unlink "${testfile}_1";
unlink "${testfile}_2";
+ unlink "${testfile}_3";
}
####################################################
@@ -250,3 +251,26 @@
close FILE;
ok($content, "INFO - File1\nINFO - File1\n");
+
+#########################################################
+# Testing create_at_logtime
+#########################################################
+$data = qq(
+log4perl.category = DEBUG, Logfile
+log4perl.appender.Logfile = Log::Log4perl::Appender::File
+log4perl.appender.Logfile.filename = ${testfile}_3
+log4perl.appender.Logfile.create_at_logtime = 1
+log4perl.appender.Logfile.layout = Log::Log4perl::Layout::SimpleLayout
+);
+
+Log::Log4perl->init(\$data);
+ok(! -f "${testfile}_3");
+
+$log = Log::Log4perl::get_logger("");
+$log->info("File1");
+
+open FILE, "<${testfile}_3" or die "Cannot open ${testfile}_3";
+$content = join '', <FILE>;
+close FILE;
+
+ok($content, "INFO - File1\n");
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Log-Log4perl-1.12/t/032JRollFile.t new/Log-Log4perl-1.15/t/032JRollFile.t
--- old/Log-Log4perl-1.12/t/032JRollFile.t 2003-06-23 19:43:22.000000000 +0200
+++ new/Log-Log4perl-1.15/t/032JRollFile.t 2007-07-15 21:46:57.000000000 +0200
@@ -2,24 +2,17 @@
use Test::More;
use File::Spec;
-#
-# We skip all tests for this module until it has stabilized.
-#
BEGIN {
- plan skip_all => "Log::Dispatch::FileRotate tests skipped";
+ eval {
+ require Log::Dispatch::FileRotate;
+ };
+ if ($@ or $Log::Dispatch::FileRotate::VERSION < 1.10) {
+ plan skip_all => "only with Log::Dispatch::FileRotate 1.10";
+ } else {
+ plan tests => 2;
+ }
}
-#BEGIN {
-# eval {
-# require Log::Dispatch::FileRotate;
-# };
-# if ($@ or $Log::Dispatch::FileRotate::VERSION < 1.10) {
-# plan skip_all => "only with Log::Dispatch::FileRotate 1.10";
-# } else {
-# plan tests => 2;
-# }
-#}
-
my $WORK_DIR = "tmp";
if(-d "t") {
$WORK_DIR = File::Spec->catfile(qw(t tmp));
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Log-Log4perl-1.12/t/034DBI.t new/Log-Log4perl-1.15/t/034DBI.t
--- old/Log-Log4perl-1.12/t/034DBI.t 2006-06-11 03:01:11.000000000 +0200
+++ new/Log-Log4perl-1.15/t/034DBI.t 2008-01-29 07:06:16.000000000 +0100
@@ -18,7 +18,7 @@
if ($@) {
plan skip_all => "DBD::CSV or SQL::Statement 1.005 not installed, skipping tests\n";
}else{
- plan tests => 15;
+ plan tests => 32;
}
}
@@ -131,12 +131,15 @@
}
-
+# setting is WARN so the debug message should not go through
$logger->debug('debug message',99,'foo','bar');
+$logger->warn('warning message missing two params',99);
+$logger->warn('another warning to kick the buffer',99);
my $sth = $dbh->prepare('select * from log4perltest');
$sth->execute;
+#first two rows are repeats from the last test
my $row = $sth->fetchrow_arrayref;
is($row->[0], 'FATAL');
is($row->[1], 'fatal message');
@@ -152,8 +155,29 @@
is($row->[3], '3456');
is($row->[4], 'groceries.beer');
is($row->[5], 'main');
+is($row->[6], 'foo');
+is($row->[7], 'bar');
-#$dbh->do('DROP TABLE log4perltest');
+#these two rows should have undef for the final two params
+$row = $sth->fetchrow_arrayref;
+is($row->[0], 'WARN');
+is($row->[1], 'warning message missing two params');
+is($row->[3], '99');
+is($row->[4], 'groceries.beer');
+is($row->[5], 'main');
+is($row->[7], undef);
+is($row->[6], undef);
+
+$row = $sth->fetchrow_arrayref;
+is($row->[0], 'WARN');
+is($row->[1], 'another warning to kick the buffer');
+is($row->[3], '99');
+is($row->[4], 'groceries.beer');
+is($row->[5], 'main');
+is($row->[7], undef);
+is($row->[6], undef);
+#that should be all
+ok(!$sth->fetchrow_arrayref);
$dbh->disconnect;
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Log-Log4perl-1.12/t/042SyncApp.t new/Log-Log4perl-1.15/t/042SyncApp.t
--- old/Log-Log4perl-1.12/t/042SyncApp.t 2004-07-11 18:20:00.000000000 +0200
+++ new/Log-Log4perl-1.15/t/042SyncApp.t 2007-11-19 01:05:32.000000000 +0100
@@ -9,6 +9,11 @@
use strict;
use Test::More;
+use Log::Log4perl qw(:easy);
+Log::Log4perl->easy_init($DEBUG);
+use constant INTERNAL_DEBUG => 0;
+
+our $INTERNAL_DEBUG = 0;
$| = 1;
@@ -20,7 +25,7 @@
}
}
-use IPC::Shareable qw(:lock);
+use Log::Log4perl::Util::Semaphore;
use Log::Log4perl qw(get_logger);
use Log::Log4perl::Appender::Synchronized;
@@ -31,21 +36,18 @@
our $lock;
our $locker;
-our $shared_name = "_l4_";
-
-#print "Nuking semaphore\n";
-Log::Log4perl::Appender::Synchronized::nuke_sem($shared_name);
-Log::Log4perl::Appender::Synchronized::nuke_sem("_l4p");
+our $locker_key = "abc";
unlink $logfile;
#goto SECOND;
#print "tie\n";
-$locker = tie $lock, 'IPC::Shareable', $shared_name,
- { create => 1,
- destroy => 1} or
- die "Cannot create shareable $shared_name";
+$locker = Log::Log4perl::Util::Semaphore->new(
+ key => $locker_key,
+);
+
+print $locker->status_as_string, "\n" if INTERNAL_DEBUG;
my $conf = qq(
log4perl.category.Bar.Twix = WARN, Syncer
@@ -61,8 +63,7 @@
log4perl.appender.Syncer.key = blah
);
-$locker->shunlock();
-$locker->shlock();
+$locker->semlock();
Log::Log4perl::init(\$conf);
@@ -73,7 +74,7 @@
my $logger = get_logger("Bar::Twix");
if($pid) {
#parent
- $locker->shlock();
+ $locker->semlock();
#print "Waiting for child\n";
for(1..10) {
#print "Parent: Writing\n";
@@ -81,7 +82,7 @@
}
} else {
#child
- $locker->shunlock();
+ $locker->semunlock();
for(1..10) {
#print "Child: Writing\n";
$logger->error("Y" x 4097);
@@ -90,7 +91,9 @@
}
# Wait for child to finish
+print "Waiting for pid $pid\n" if $INTERNAL_DEBUG;
waitpid($pid, 0);
+print "Done waiting for pid $pid\n" if $INTERNAL_DEBUG;
my $clashes_found = 0;
@@ -107,8 +110,6 @@
#print $logfile, "\n";
#exit 0;
-$locker->clean_up;
-
ok(! $clashes_found, "Checking for clashes in logfile");
###################################################################
@@ -119,17 +120,12 @@
SECOND:
-#print "Nuking semaphore\n";
-Log::Log4perl::Appender::Synchronized::nuke_sem($shared_name);
-Log::Log4perl::Appender::Synchronized::nuke_sem("_l4p");
-
unlink $logfile;
#print "tie\n";
-$locker = tie $lock, 'IPC::Shareable', $shared_name,
- { create => 1,
- destroy => 1} or
- die "Cannot create shareable $shared_name";
+$locker = Log::Log4perl::Util::Semaphore->new(
+ key => $locker_key,
+);
$conf = q{
log4perl.category = WARN, Socket
@@ -139,10 +135,15 @@
log4perl.appender.Socket.layout = SimpleLayout
};
-#print "unlock\n";
-$locker->shunlock();
-#print "lock\n";
-$locker->shlock();
+print "1 Semunlock\n" if $INTERNAL_DEBUG;
+print $locker->status_as_string, "\n" if INTERNAL_DEBUG;
+$locker->semunlock();
+print "1 Done semunlock\n" if $INTERNAL_DEBUG;
+
+print "2 Semlock\n" if $INTERNAL_DEBUG;
+print $locker->status_as_string, "\n" if INTERNAL_DEBUG;
+$locker->semlock();
+print "2 Done semlock\n" if $INTERNAL_DEBUG;
#print "forking\n";
$pid = fork();
@@ -152,7 +153,9 @@
if($pid) {
#parent
#print "Waiting for child\n";
- $locker->shlock();
+ print "Before semlock\n" if $INTERNAL_DEBUG;
+ $locker->semlock();
+ print "Done semlock\n" if $INTERNAL_DEBUG;
{
my $client = IO::Socket::INET->new( PeerAddr => 'localhost',
@@ -177,8 +180,6 @@
$client->close();
}
- #print "Done\n";
-
Log::Log4perl::init(\$conf);
$logger = get_logger("Bar::Twix");
#print "Sending message\n";
@@ -197,7 +198,9 @@
die "Cannot start server: $!" unless defined $sock;
# Ready to receive
#print "Server started\n";
- $locker->shunlock();
+ print "Before semunlock\n" if $INTERNAL_DEBUG;
+ $locker->semunlock();
+ print "After semunlock\n" if $INTERNAL_DEBUG;
my $nof_messages = 2;
@@ -216,7 +219,9 @@
}
# Wait for child to finish
+print "Waiting for pid $pid\n" if $INTERNAL_DEBUG;
waitpid($pid, 0);
+print "Done waiting for pid $pid\n" if $INTERNAL_DEBUG;
open FILE, "<$logfile" or die "Cannot open $logfile";
my $data = join '', <FILE>;
@@ -260,8 +265,8 @@
# silently ignored
$logger->warn("message lost");
-$locker->shunlock();
-$locker->shlock();
+$locker->semunlock();
+$locker->semlock();
# Now start a server
$pid = fork();
@@ -271,7 +276,7 @@
# wait for child
#print "Waiting for server to start\n";
- $locker->shlock();
+ $locker->semlock();
# Send another message (should be sent)
#print "Sending message\n";
@@ -290,7 +295,7 @@
die "Cannot start server: $!" unless defined $sock;
# Ready to receive
#print "Server started\n";
- $locker->shunlock();
+ $locker->semunlock();
my $nof_messages = 1;
@@ -310,7 +315,9 @@
}
# Wait for child to finish
+print "Waiting for pid $pid\n" if $INTERNAL_DEBUG;
waitpid($pid, 0);
+print "Done waiting for pid $pid\n" if $INTERNAL_DEBUG;
open FILE, "<$logfile" or die "Cannot open $logfile";
$data = join '', <FILE>;
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Log-Log4perl-1.12/t/048lwp.t new/Log-Log4perl-1.15/t/048lwp.t
--- old/Log-Log4perl-1.12/t/048lwp.t 2006-03-01 05:01:46.000000000 +0100
+++ new/Log-Log4perl-1.15/t/048lwp.t 2007-10-28 21:34:09.000000000 +0100
@@ -42,7 +42,7 @@
my $data = join('', <LOG>);
close LOG;
-like($data, qr#GET file:$tmpfile#);
+like($data, qr#\QGET file:$tmpfile\E#);
END { unlink "lwpout.txt" }
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Log-Log4perl-1.12/t/054Subclass.t new/Log-Log4perl-1.15/t/054Subclass.t
--- old/Log-Log4perl-1.12/t/054Subclass.t 1970-01-01 01:00:00.000000000 +0100
+++ new/Log-Log4perl-1.15/t/054Subclass.t 2008-02-09 21:29:55.000000000 +0100
@@ -0,0 +1,22 @@
+###########################################
+# Test Suite for Log::Log4perl::Level
+# Mike Schilli, 2008 (m@perlmeister.com)
+###########################################
+
+###########################################
+ # Subclass L4p
+package Mylogger;
+use strict;
+use Log::Log4perl;
+our @ISA = qw(Log::Log4perl);
+
+###########################################
+package main;
+use strict;
+
+use Test::More;
+
+plan tests => 1;
+
+my $logger = Mylogger->get_logger("Waah");
+is($logger->{category}, "Waah", "subclass category rt #32942");
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Remember to have fun...
---------------------------------------------------------------------
To unsubscribe, e-mail: opensuse-commit+unsubscribe@opensuse.org
For additional commands, e-mail: opensuse-commit+help@opensuse.org
