summaryrefslogtreecommitdiff
path: root/t/042SyncApp.t
diff options
context:
space:
mode:
Diffstat (limited to 't/042SyncApp.t')
-rw-r--r--t/042SyncApp.t339
1 files changed, 339 insertions, 0 deletions
diff --git a/t/042SyncApp.t b/t/042SyncApp.t
new file mode 100644
index 0000000..18eb416
--- /dev/null
+++ b/t/042SyncApp.t
@@ -0,0 +1,339 @@
+#!/usr/bin/perl
+##########################################################################
+# Synchronizing appender output with Log::Log4perl::Appender::Synchronized.
+# This test uses fork and a semaphore to get two appenders to get into
+# each other/s way.
+# Mike Schilli, 2003 (m@perlmeister.com)
+##########################################################################
+
+BEGIN {
+ if($ENV{INTERNAL_DEBUG}) {
+ require Log::Log4perl::InternalDebug;
+ Log::Log4perl::InternalDebug->enable();
+ }
+}
+
+use warnings;
+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;
+
+BEGIN {
+ if(exists $ENV{"L4P_ALL_TESTS"}) {
+ plan tests => 5;
+ } else {
+ plan skip_all => "- only with L4P_ALL_TESTS";
+ }
+}
+
+use Log::Log4perl::Util::Semaphore;
+use Log::Log4perl qw(get_logger);
+use Log::Log4perl::Appender::Synchronized;
+
+my $EG_DIR = "eg";
+$EG_DIR = "../eg" unless -d $EG_DIR;
+
+my $logfile = "$EG_DIR/fork.log";
+
+our $lock;
+our $locker;
+our $locker_key = "abc";
+
+unlink $logfile;
+
+#goto SECOND;
+
+#print "tie\n";
+$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
+
+log4perl.appender.Logfile = Log::Log4perl::Appender::TestFileCreeper
+log4perl.appender.Logfile.autoflush = 1
+log4perl.appender.Logfile.filename = $logfile
+log4perl.appender.Logfile.layout = Log::Log4perl::Layout::PatternLayout
+log4perl.appender.Logfile.layout.ConversionPattern = %F{1}%L> %m%n
+
+log4perl.appender.Syncer = Log::Log4perl::Appender::Synchronized
+log4perl.appender.Syncer.appender = Logfile
+log4perl.appender.Syncer.key = blah
+);
+
+$locker->semlock();
+
+Log::Log4perl::init(\$conf);
+
+my $pid = fork();
+
+die "fork failed" unless defined $pid;
+
+my $logger = get_logger("Bar::Twix");
+if($pid) {
+ #parent
+ $locker->semlock();
+ #print "Waiting for child\n";
+ for(1..10) {
+ #print "Parent: Writing\n";
+ $logger->error("X" x 4097);
+ }
+} else {
+ #child
+ $locker->semunlock();
+ for(1..10) {
+ #print "Child: Writing\n";
+ $logger->error("Y" x 4097);
+ }
+ exit 0;
+}
+
+ # 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;
+
+open FILE, "<$logfile" or die "Cannot open $logfile";
+while(<FILE>) {
+ if(/XY/ || /YX/) {
+ $clashes_found = 1;
+ last;
+ }
+}
+close FILE;
+
+unlink $logfile;
+#print $logfile, "\n";
+#exit 0;
+
+ok(! $clashes_found, "Checking for clashes in logfile");
+
+###################################################################
+# Test the Socket appender
+###################################################################
+
+use IO::Socket::INET;
+
+SECOND:
+
+unlink $logfile;
+
+#print "tie\n";
+$locker = Log::Log4perl::Util::Semaphore->new(
+ key => $locker_key,
+);
+
+$conf = q{
+ log4perl.category = WARN, Socket
+ log4perl.appender.Socket = Log::Log4perl::Appender::Socket
+ log4perl.appender.Socket.PeerAddr = localhost
+ log4perl.appender.Socket.PeerPort = 12345
+ log4perl.appender.Socket.layout = SimpleLayout
+};
+
+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();
+
+die "fork failed" unless defined $pid;
+
+if($pid) {
+ #parent
+ #print "Waiting for child\n";
+ print "Before semlock\n" if $INTERNAL_DEBUG;
+ $locker->semlock();
+ print "Done semlock\n" if $INTERNAL_DEBUG;
+
+ {
+ my $client = IO::Socket::INET->new( PeerAddr => 'localhost',
+ PeerPort => 12345,
+ );
+
+ #print "Checking connection\n";
+
+ if(defined $client) {
+ #print "Client defined, sending test\n";
+ eval { $client->send("test\n") };
+ if($@) {
+ #print "Send failed ($!), retrying ...\n";
+ sleep(1);
+ redo;
+ }
+ } else {
+ #print "Server not responding yet ($!) ... retrying\n";
+ sleep(1);
+ redo;
+ }
+ $client->close();
+ }
+
+ Log::Log4perl::init(\$conf);
+ $logger = get_logger("Bar::Twix");
+ #print "Sending message\n";
+ $logger->error("Greetings from the client");
+} else {
+ #child
+
+ #print STDERR "child starting\n";
+ my $sock = IO::Socket::INET->new(
+ Listen => 5,
+ LocalAddr => 'localhost',
+ LocalPort => 12345,
+ ReuseAddr => 1,
+ Proto => 'tcp');
+
+ die "Cannot start server: $!" unless defined $sock;
+ # Ready to receive
+ #print "Server started\n";
+ print "Before semunlock\n" if $INTERNAL_DEBUG;
+ $locker->semunlock();
+ print "After semunlock\n" if $INTERNAL_DEBUG;
+
+ my $nof_messages = 2;
+
+ open FILE, ">$logfile" or die "Cannot open $logfile";
+ while(my $client = $sock->accept()) {
+ #print "Client connected\n";
+ while(<$client>) {
+ print FILE "$_\n";
+ last;
+ }
+ last unless --$nof_messages;
+ }
+
+ close FILE;
+ exit 0;
+}
+
+ # 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>;
+close FILE;
+
+unlink $logfile;
+
+like($data, qr/Greetings/, "Check logfile of Socket appender");
+
+###################################################################
+# Test the "silent_recover" options of the Socket appender
+###################################################################
+
+use IO::Socket::INET;
+
+our $TMP_FILE = "warnings.txt";
+END { unlink $TMP_FILE if defined $TMP_FILE; }
+
+# Capture STDERR to a temporary file and a filehandle to read from it
+open STDERR, ">$TMP_FILE";
+open IN, "<$TMP_FILE" or die "Cannot open $TMP_FILE";
+sub readwarn { return scalar <IN>; }
+
+$conf = q{
+ log4perl.category = WARN, Socket
+ log4perl.appender.Socket = Log::Log4perl::Appender::Socket
+ log4perl.appender.Socket.PeerAddr = localhost
+ log4perl.appender.Socket.PeerPort = 12345
+ log4perl.appender.Socket.layout = SimpleLayout
+ log4perl.appender.Socket.silent_recovery = 1
+};
+
+ # issues a warning
+Log::Log4perl->init(\$conf);
+
+like(readwarn(), qr/Connection refused/,
+ "Check if warning occurs on dead socket");
+
+$logger = get_logger("foobar");
+
+ # silently ignored
+$logger->warn("message lost");
+
+$locker->semunlock();
+$locker->semlock();
+
+ # Now start a server
+$pid = fork();
+
+if($pid) {
+ #parent
+
+ # wait for child
+ #print "Waiting for server to start\n";
+ $locker->semlock();
+
+ # Send another message (should be sent)
+ #print "Sending message\n";
+ $logger->warn("message sent");
+} else {
+ #child
+
+ # Start a server
+ my $sock = IO::Socket::INET->new(
+ Listen => 5,
+ LocalAddr => 'localhost',
+ LocalPort => 12345,
+ ReuseAddr => 1,
+ Proto => 'tcp');
+
+ die "Cannot start server: $!" unless defined $sock;
+ # Ready to receive
+ #print "Server started\n";
+ $locker->semunlock();
+
+ my $nof_messages = 1;
+
+ open FILE, ">$logfile" or die "Cannot open $logfile";
+ while(my $client = $sock->accept()) {
+ #print "Client connected\n";
+ while(<$client>) {
+ #print "Got message: $_\n";
+ print FILE "$_\n";
+ last;
+ }
+ last unless --$nof_messages;
+ }
+
+ close FILE;
+ exit 0;
+}
+
+ # 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>;
+close FILE;
+
+#print "data=$data\n";
+
+unlink $logfile;
+
+unlike($data, qr/message lost/, "Check logfile for lost message");
+like($data, qr/message sent/, "Check logfile for sent message");
View Lorry Controller Status