From 4b555c3e4d56376ad6e7d5cb445a37cbc2377513 Mon Sep 17 00:00:00 2001 From: Mario Fetka Date: Mon, 16 Jan 2017 14:36:11 +0100 Subject: [PATCH] Imported Upstream version 1.09 --- Changes | 52 +++++ MANIFEST | 16 ++ META.json | 42 ++++ META.yml | 23 +++ Makefile.PL | 25 +++ README | 79 ++++++++ lib/Log/Dispatch/File/Rolling.pm | 328 +++++++++++++++++++++++++++++++ t/1.t | 17 ++ t/2.t | 18 ++ t/3.t | 70 +++++++ t/4.t | 70 +++++++ t/5.t | 70 +++++++ t/6.t | 74 +++++++ t/7testpod.t | 5 + t/8coverage.t | 5 + t/9reopenfh.t | 75 +++++++ 16 files changed, 969 insertions(+) create mode 100644 Changes create mode 100755 MANIFEST create mode 100644 META.json create mode 100644 META.yml create mode 100755 Makefile.PL create mode 100755 README create mode 100755 lib/Log/Dispatch/File/Rolling.pm create mode 100755 t/1.t create mode 100755 t/2.t create mode 100755 t/3.t create mode 100755 t/4.t create mode 100755 t/5.t create mode 100755 t/6.t create mode 100755 t/7testpod.t create mode 100755 t/8coverage.t create mode 100755 t/9reopenfh.t diff --git a/Changes b/Changes new file mode 100644 index 0000000..902a83b --- /dev/null +++ b/Changes @@ -0,0 +1,52 @@ +HISTORY + 0.99 Original version; created by h2xs 1.22 with options + + -A + -C + -X + -b5.6.1 + -nLog::Dispatch::File::Rolling + --skip-exporter + -v0.99 + + 1.00 Initial coding + + 1.01 Someone once said "Never feed them after midnight!"---Ok, let's + append: "Never submit any code after midnight..." + + Now it is working, I also included 4 tests. + + 1.02 No code change, just updated Makefile.PL to include correct + author information and prerequisites. + + 1.03 Changed the syntax of the '$' format character because I noticed + some problems while making Log::Dispatch::File::Alerts. You need + to change your configuration! + + 1.04 Got a bug report where the file handle got closed in + mid-execution somehow. Added a additional check to re-open it + instead of writing to a closed handle. + + 1.05 Updated packaging for newer standards. No changes to the coding. + + 1.06 Fixed a subtle bug that prevented us from locking the logfile + after a fork if no PID was used in the filename. + + Also disabled forced double opening of the logfile at startup. + It was in place because I didn't trust Log::Dispatch::File to + really open the file at the right moment. + + Thanks to Peter Lobsinger for the patch. Please always wrap + non-standard Test::* modules in eval and make your testfile + clean up after itself... ;) + + 1.07 Fixed rt.cpan.org bug #89001. Seems Log::Dispatch::File changed + its initialization procedure---and we are inheriting from it. + + 1.08 Fixed dependency on Log::Dispatch::File. The change in 1.07 only + works with 2.37 or later. For older versions of + Log::Dispatch::File use 1.06. + + 1.09 Dependency change of 1.08 was missing from the Makefile.PL. + Oops. + diff --git a/MANIFEST b/MANIFEST new file mode 100755 index 0000000..0a08aa4 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,16 @@ +Makefile.PL +MANIFEST +README +Changes +lib/Log/Dispatch/File/Rolling.pm +t/1.t +t/2.t +t/3.t +t/4.t +t/5.t +t/6.t +META.yml +t/7testpod.t +t/8coverage.t +t/9reopenfh.t +META.json Module JSON meta-data (added by MakeMaker) diff --git a/META.json b/META.json new file mode 100644 index 0000000..c17c800 --- /dev/null +++ b/META.json @@ -0,0 +1,42 @@ +{ + "abstract" : "Object for logging to date/time/pid stamped files", + "author" : [ + "M. Jacob " + ], + "dynamic_config" : 1, + "generated_by" : "ExtUtils::MakeMaker version 6.86, CPAN::Meta::Converter version 2.120351", + "license" : [ + "perl_5" + ], + "meta-spec" : { + "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", + "version" : "2" + }, + "name" : "Log-Dispatch-File-Rolling", + "no_index" : { + "directory" : [ + "t", + "inc" + ] + }, + "prereqs" : { + "build" : { + "requires" : { + "ExtUtils::MakeMaker" : "0" + } + }, + "configure" : { + "requires" : { + "ExtUtils::MakeMaker" : "0" + } + }, + "runtime" : { + "requires" : { + "Log::Dispatch" : "2.37", + "Log::Log4perl" : "0.32" + } + } + }, + "release_status" : "stable", + "version" : "1.09" +} diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..dd9b950 --- /dev/null +++ b/META.yml @@ -0,0 +1,23 @@ +--- +abstract: 'Object for logging to date/time/pid stamped files' +author: + - 'M. Jacob ' +build_requires: + ExtUtils::MakeMaker: 0 +configure_requires: + ExtUtils::MakeMaker: 0 +dynamic_config: 1 +generated_by: 'ExtUtils::MakeMaker version 6.86, CPAN::Meta::Converter version 2.120351' +license: perl +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: 1.4 +name: Log-Dispatch-File-Rolling +no_index: + directory: + - t + - inc +requires: + Log::Dispatch: 2.37 + Log::Log4perl: 0.32 +version: 1.09 diff --git a/Makefile.PL b/Makefile.PL new file mode 100755 index 0000000..add5084 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,25 @@ +use 5.006001; +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. +WriteMakefile( + 'NAME' => 'Log::Dispatch::File::Rolling', + 'VERSION_FROM' => 'lib/Log/Dispatch/File/Rolling.pm', # finds $VERSION + 'PREREQ_PM' => { + 'Log::Log4perl' => '0.32', + 'Log::Dispatch' => '2.37', +# 'Pod::Readme' => '0.05', # only needed for 'make dist' + }, + ($] >= 5.005 ? ( ## Add these new keywords supported since 5.005 + ABSTRACT_FROM => 'lib/Log/Dispatch/File/Rolling.pm', # retrieve abstract from module + AUTHOR => 'M. Jacob ') : (), + LICENSE => 'perl', + depend => { + create_distdir => 'Changes', + Changes => 'lib/Log/Dispatch/File/Rolling.pm'."\n\t".q[$(FULLPERLRUN) -MPod::Readme -e 'Pod::Readme->new( readme_type => "changes" )->parse_from_file( "lib/Log/Dispatch/File/Rolling.pm", "Changes" )']."\n\n", + }, + realclean => { + FILES => "Changes" + }, + ), +); diff --git a/README b/README new file mode 100755 index 0000000..2ef77c9 --- /dev/null +++ b/README @@ -0,0 +1,79 @@ +Log/Dispatch/File/Rolling version 1.09 +====================================== + +-------- +Abstract +-------- + +This module subclasses Log::Dispatch::File for logging to date/time +stamped files. It uses flock to ensure being safe in a multitasking +environment. It recognizes a fork() and will reopen the logfile, if +configured so even with a process specific filename. + +------------ +Requirements +------------ + +This module requires Log::Dispatch::File, included in the Log::Dispatch +distribution and Log::Log4perl::DateFormat, included in the +Log::Log4perl distribution. It has only be tested with the versions as +stated in Makefile.PL, if you find it works with earlier versions, too, +please send me a email. Thank you. + +------------------ +Basic Installation +------------------ + +Log::Dispatch::File::Rolling may be installed through the CPAN shell in +the usual manner: + + # perl -MCPAN -e 'install Log::Dispatch::File::Rolling' + +You can also read this README from the CPAN shell: + + # perl -MCPAN -e shell + cpan> readme Log::Dispatch::File::Rolling + +And you can install the component from the CPAN prompt as well: + + cpan> install Log::Dispatch::File::Rolling + +------------------- +Manual Installation +------------------- + +Log::Dispatch::File::Rolling can also be installed manually. The latest +CPAN version can be found at or in a similarly named directory at your +favorite CPAN mirror. + +Downloading and unpacking the distribution are left as exercises for the +reader. To build and test it: + + perl Makefile.PL + make test + +When you're ready to install the component: + + make install + +It should now be ready to use. + +On Win32 systems, replace "make" in the above commands with "nmake". The +nmake utility can be downloaded from +http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN- +US/Nmake15.exe + +--------------------- +COPYRIGHT AND LICENCE +--------------------- + +Copyright (C) 2003, 2004, 2007, 2010, 2013 M. Jacob + +Based on: + Log::Dispatch::File::Stamped by Eric Cholet + Log::Dispatch::FileRotate by Mark Pfeiffer, + +This library is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + diff --git a/lib/Log/Dispatch/File/Rolling.pm b/lib/Log/Dispatch/File/Rolling.pm new file mode 100755 index 0000000..2928c1e --- /dev/null +++ b/lib/Log/Dispatch/File/Rolling.pm @@ -0,0 +1,328 @@ +## no critic +package Log::Dispatch::File::Rolling; + +use 5.006001; +use strict; +use warnings; + +use Log::Dispatch::File '2.37'; +use Log::Log4perl::DateFormat; +use Fcntl ':flock'; # import LOCK_* constants + +our @ISA = qw(Log::Dispatch::File); + +our $VERSION = '1.09'; + +our $TIME_HIRES_AVAILABLE = undef; + +BEGIN { # borrowed from Log::Log4perl::Layout::PatternLayout, Thanks! + # Check if we've got Time::HiRes. If not, don't make a big fuss, + # just set a flag so we know later on that we can't have fine-grained + # time stamps + + eval { require Time::HiRes; }; + if ($@) { + $TIME_HIRES_AVAILABLE = 0; + } else { + $TIME_HIRES_AVAILABLE = 1; + } +} + +# Preloaded methods go here. + +sub new { + my $proto = shift; + my $class = ref $proto || $proto; + + my %p = @_; + + my $self = bless {}, $class; + + # only append mode is supported + $p{mode} = 'append'; + + # base class initialization + $self->_basic_init(%p); + + # split pathname into path, basename, extension + if ($p{filename} =~ /^(.*)\%d\{([^\}]*)\}(.*)$/) { + $self->{rolling_filename_prefix} = $1; + $self->{rolling_filename_postfix} = $3; + $self->{rolling_filename_format} = Log::Log4perl::DateFormat->new($2); + $self->{filename} = $self->_createFilename(); + } elsif ($p{filename} =~ /^(.*)(\.[^\.]+)$/) { + $self->{rolling_filename_prefix} = $1; + $self->{rolling_filename_postfix} = $2; + $self->{rolling_filename_format} = Log::Log4perl::DateFormat->new('-yyyy-MM-dd'); + $self->{filename} = $self->_createFilename(); + } else { + $self->{rolling_filename_prefix} = $p{filename}; + $self->{rolling_filename_postfix} = ''; + $self->{rolling_filename_format} = Log::Log4perl::DateFormat->new('.yyyy-MM-dd'); + $self->{filename} = $self->_createFilename(); + } + + $self->{rolling_fh_pid} = $$; + $self->_make_handle(); + + return $self; +} + +sub log_message { # parts borrowed from Log::Dispatch::FileRotate, Thanks! + my $self = shift; + my %p = @_; + + my $filename = $self->_createFilename(); + if ($filename ne $self->{filename}) { + $self->{filename} = $filename; + $self->{rolling_fh_pid} = 'x'; # force reopen + } + + if ( $self->{close} ) { + $self->_open_file; + $self->_lock(); + my $fh = $self->{fh}; + print $fh $p{message}; + $self->_unlock(); + close($fh); + $self->{fh} = undef; + } elsif (defined $self->{fh} and ($self->{rolling_fh_pid}||'') eq $$ and defined fileno $self->{fh}) { # flock won't work after a fork() + my $inode = (stat($self->{fh}))[1]; # get real inode + my $finode = (stat($self->{filename}))[1]; # Stat the name for comparision + if(!defined($finode) || $inode != $finode) { # Oops someone moved things on us. So just reopen our log + $self->_open_file; + } + $self->_lock(); + my $fh = $self->{fh}; + print $fh $p{message}; + $self->_unlock(); + } else { + $self->{rolling_fh_pid} = $$; + $self->_open_file; + $self->_lock(); + my $fh = $self->{fh}; + print $fh $p{message}; + $self->_unlock(); + } +} + +sub _lock { # borrowed from Log::Dispatch::FileRotate, Thanks! + my $self = shift; + flock($self->{fh},LOCK_EX); + # Make sure we are at the EOF + seek($self->{fh}, 0, 2); + return 1; +} + +sub _unlock { # borrowed from Log::Dispatch::FileRotate, Thanks! + my $self = shift; + flock($self->{fh},LOCK_UN); + return 1; +} + +sub _current_time { # borrowed from Log::Log4perl::Layout::PatternLayout, Thanks! + # Return secs and optionally msecs if we have Time::HiRes + if($TIME_HIRES_AVAILABLE) { + return (Time::HiRes::gettimeofday()); + } else { + return (time(), 0); + } +} + +sub _createFilename { + my $self = shift; + return $self->{rolling_filename_prefix} + . $self->_format() + . $self->{rolling_filename_postfix}; +} + +sub _format { + my $self = shift; + my $result = $self->{rolling_filename_format}->format($self->_current_time()); + $result =~ s/(\$+)/sprintf('%0'.length($1).'.'.length($1).'u', $$)/eg; + return $result; +} + +1; +__END__ + +=for changes stop + +=head1 NAME + +Log::Dispatch::File::Rolling - Object for logging to date/time/pid +stamped files + +=head1 SYNOPSIS + + use Log::Dispatch::File::Rolling; + + my $file = Log::Dispatch::File::Rolling->new( + name => 'file1', + min_level => 'info', + filename => 'Somefile%d{yyyyMMdd}.log', + mode => 'append' ); + + $file->log( level => 'emerg', + message => "I've fallen and I can't get up\n" ); + +=head1 ABSTRACT + +This module provides an object for logging to files under the +Log::Dispatch::* system. + +=head1 DESCRIPTION + +This module subclasses Log::Dispatch::File for logging to date/time +stamped files. See L for instructions on usage. +This module differs only on the following three points: + +=over 4 + +=item fork()-safe + +This module will close and re-open the logfile after a fork. + +=item multitasking-safe + +This module uses flock() to lock the file while writing to it. + +=item stamped filenames + +This module supports a special tag in the filename that will expand to +the current date/time/pid. + +It is the same tag Log::Log4perl::Layout::PatternLayout uses, see +L, chapter "Fine-tune the date". +In short: Include a "%d{...}" in the filename where "..." is a format +string according to the SimpleDateFormat in the Java World +(http://java.sun.com/j2se/1.3/docs/api/java/text/SimpleDateFormat.html). +See also L for information about further +restrictions. + +In addition to the format provided by Log::Log4perl::DateFormat this +module also supports '$' for inserting the PID. Repeat the character to +define how many character wide the field should be. This should not be +needed regularly as this module also supports logfile sharing between +processes, but if you've got a high load on your logfile or a system +that doesn't support flock()... + +=back + +=head1 METHODS + +=over 4 + +=item new() + +See L and chapter DESCRIPTION above. + +=item log_message() + +See L and chapter DESCRIPTION above. + +=back + +=for changes continue + +=head1 HISTORY + +=over 8 + +=item 0.99 + +Original version; created by h2xs 1.22 with options + + -A + -C + -X + -b5.6.1 + -nLog::Dispatch::File::Rolling + --skip-exporter + -v0.99 + +=item 1.00 + +Initial coding + +=item 1.01 + +Someone once said "Never feed them after midnight!"---Ok, let's append: +"Never submit any code after midnight..." + +Now it is working, I also included 4 tests. + +=item 1.02 + +No code change, just updated Makefile.PL to include correct author +information and prerequisites. + +=item 1.03 + +Changed the syntax of the '$' format character because I noticed some +problems while making Log::Dispatch::File::Alerts. You need to change +your configuration! + +=item 1.04 + +Got a bug report where the file handle got closed in mid-execution somehow. +Added a additional check to re-open it instead of writing to a closed +handle. + +=item 1.05 + +Updated packaging for newer standards. No changes to the coding. + +=item 1.06 + +Fixed a subtle bug that prevented us from locking the logfile after a fork if no +PID was used in the filename. + +Also disabled forced double opening of the logfile at startup. It was in place +because I didn't trust L to really open the file at the +right moment. + +Thanks to Peter Lobsinger for the patch. Please always wrap non-standard Test::* +modules in eval and make your testfile clean up after itself... ;) + +=item 1.07 + +Fixed rt.cpan.org bug #89001. Seems L changed its +initialization procedure---and we are inheriting from it. + +=item 1.08 + +Fixed dependency on L. The change in 1.07 only works with +2.37 or later. For older versions of L use 1.06. + +=item 1.09 + +Dependency change of 1.08 was missing from the Makefile.PL. Oops. + +=back + +=for changes stop + +=head1 SEE ALSO + +L, L, +http://java.sun.com/j2se/1.3/docs/api/java/text/SimpleDateFormat.html, +L, 'perldoc -f flock', 'perldoc -f fork'. + +=head1 AUTHOR + +M. Jacob, Ejacob@j-e-b.netE + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2003, 2004, 2007, 2010, 2013 M. Jacob Ejacob@j-e-b.netE + +Based on: + + Log::Dispatch::File::Stamped by Eric Cholet + Log::Dispatch::FileRotate by Mark Pfeiffer, + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/t/1.t b/t/1.t new file mode 100755 index 0000000..5ae35f9 --- /dev/null +++ b/t/1.t @@ -0,0 +1,17 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl 1.t' + +######################### + +# change 'tests => 1' to 'tests => last_test_to_print'; + +use Test; +BEGIN { plan tests => 1 }; +use Log::Dispatch::File::Rolling; +ok(1); # If we made it this far, we're ok. + +######################### + +# Insert your test code below, the Test::More module is use()ed here so read +# its man page ( perldoc Test::More ) for help writing this test script. + diff --git a/t/2.t b/t/2.t new file mode 100755 index 0000000..ffda451 --- /dev/null +++ b/t/2.t @@ -0,0 +1,18 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl 1.t' + +######################### + +# change 'tests => 1' to 'tests => last_test_to_print'; + +use Test; +BEGIN { plan tests => 1 }; +use Log::Dispatch; +use Log::Dispatch::File::Rolling; +ok(1); # If we made it this far, we're ok. + +######################### + +# Insert your test code below, the Test::More module is use()ed here so read +# its man page ( perldoc Test::More ) for help writing this test script. + diff --git a/t/3.t b/t/3.t new file mode 100755 index 0000000..3d80a87 --- /dev/null +++ b/t/3.t @@ -0,0 +1,70 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl 1.t' + +######################### + +# change 'tests => 1' to 'tests => last_test_to_print'; + +use Test; +BEGIN { plan tests => 8 }; +use Log::Dispatch; +use Log::Dispatch::File::Rolling; +ok(1); # If we made it this far, we're ok. + +#########################1 + +my $dispatcher = Log::Dispatch->new; +ok($dispatcher); + +#########################2 + +my %params = ( + name => 'file', + min_level => 'debug', + filename => 'logfile.txt', +); + +my $Rolling = Log::Dispatch::File::Rolling->new(%params); +ok($Rolling); + +#########################3 + +$dispatcher->add($Rolling); + +ok(1); + +#########################4 + +my $message = 'logtest id ' . int(rand(9999)); + +$dispatcher->log( level => 'info', message => $message ); + +ok(1); + +#########################5 + +$dispatcher = $Rolling = undef; + +ok(1); + +#########################6 + +my @logfiles = glob('logfile*.txt'); + +ok(scalar(@logfiles) == 1 or scalar(@logfiles) == 2); + +#########################7 + +my $content = ''; + +foreach my $file (@logfiles) { + open F, '<', $file; + local $/ = undef; + $content .= ; + close F; + unlink $file; +} + +ok($content =~ /$message/); + +#########################8 diff --git a/t/4.t b/t/4.t new file mode 100755 index 0000000..db9c2af --- /dev/null +++ b/t/4.t @@ -0,0 +1,70 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl 1.t' + +######################### + +# change 'tests => 1' to 'tests => last_test_to_print'; + +use Test; +BEGIN { plan tests => 8 }; +use Log::Dispatch; +use Log::Dispatch::File::Rolling; +ok(1); # If we made it this far, we're ok. + +#########################1 + +my $dispatcher = Log::Dispatch->new; +ok($dispatcher); + +#########################2 + +my %params = ( + name => 'file', + min_level => 'debug', + filename => 'logfile%d{$$}.txt', +); + +my $Rolling = Log::Dispatch::File::Rolling->new(%params); +ok($Rolling); + +#########################3 + +$dispatcher->add($Rolling); + +ok(1); + +#########################4 + +my $message = 'logtest id ' . int(rand(9999)); + +$dispatcher->log( level => 'info', message => $message ); + +ok(1); + +#########################5 + +$dispatcher = $Rolling = undef; + +ok(1); + +#########################6 + +my @logfiles = glob("logfile$$.txt"); + +ok(scalar(@logfiles) == 1); + +#########################7 + +my $content = ''; + +foreach my $file (@logfiles) { + open F, '<', $file; + local $/ = undef; + $content .= ; + close F; + unlink $file; +} + +ok($content =~ /$message/); + +#########################8 diff --git a/t/5.t b/t/5.t new file mode 100755 index 0000000..0d20f1a --- /dev/null +++ b/t/5.t @@ -0,0 +1,70 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl 1.t' + +######################### + +# change 'tests => 1' to 'tests => last_test_to_print'; + +use Test; +BEGIN { plan tests => 8 }; +use Log::Dispatch; +use Log::Dispatch::File::Rolling; +ok(1); # If we made it this far, we're ok. + +#########################1 + +my $dispatcher = Log::Dispatch->new; +ok($dispatcher); + +#########################2 + +my %params = ( + name => 'file', + min_level => 'debug', + filename => 'logfile', +); + +my $Rolling = Log::Dispatch::File::Rolling->new(%params); +ok($Rolling); + +#########################3 + +$dispatcher->add($Rolling); + +ok(1); + +#########################4 + +my $message = 'logtest id ' . int(rand(9999)); + +$dispatcher->log( level => 'info', message => $message ); + +ok(1); + +#########################5 + +$dispatcher = $Rolling = undef; + +ok(1); + +#########################6 + +my @logfiles = glob("logfile.2*"); + +ok(scalar(@logfiles) == 1 or scalar(@logfiles) == 2); + +#########################7 + +my $content = ''; + +foreach my $file (@logfiles) { + open F, '<', $file; + local $/ = undef; + $content .= ; + close F; + unlink $file; +} + +ok($content =~ /$message/); + +#########################8 diff --git a/t/6.t b/t/6.t new file mode 100755 index 0000000..45176c2 --- /dev/null +++ b/t/6.t @@ -0,0 +1,74 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl 1.t' + +######################### + +# change 'tests => 1' to 'tests => last_test_to_print'; + +use Test; +BEGIN { plan tests => 9 }; +use Log::Dispatch; +use Log::Dispatch::File::Rolling; +ok(1); # If we made it this far, we're ok. + +#########################1 + +my $dispatcher = Log::Dispatch->new; +ok($dispatcher); + +#########################2 + +my %params = ( + name => 'file', + min_level => 'debug', + filename => 'logfile.txt', +); + +my $Rolling = Log::Dispatch::File::Rolling->new(%params); +ok($Rolling); + +#########################3 + +$dispatcher->add($Rolling); + +ok(1); + +#########################4 + +my $message1 = 'logtest id ' . int(rand(9999)); +my $message2 = 'logtest id ' . int(rand(9999)); + +$dispatcher->log( level => 'info', message => $message1 ); +close $Rolling->{fh}; # disturb internal bookkeeping, must recover from this +$dispatcher->log( level => 'info', message => $message2 ); + +ok(1); + +#########################5 + +$dispatcher = $Rolling = undef; + +ok(1); + +#########################6 + +my @logfiles = glob('logfile*.txt'); + +ok(scalar(@logfiles) == 1 or scalar(@logfiles) == 2); + +#########################7 + +my $content = ''; + +foreach my $file (@logfiles) { + open F, '<', $file; + local $/ = undef; + $content .= ; + close F; + unlink $file; +} + +ok($content =~ /$message1/); +ok($content =~ /$message2/); + +#########################8 diff --git a/t/7testpod.t b/t/7testpod.t new file mode 100755 index 0000000..fb0be94 --- /dev/null +++ b/t/7testpod.t @@ -0,0 +1,5 @@ +use Test::More; +eval " +use Test::Pod 1.00;"; +plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; +all_pod_files_ok(); \ No newline at end of file diff --git a/t/8coverage.t b/t/8coverage.t new file mode 100755 index 0000000..22c024f --- /dev/null +++ b/t/8coverage.t @@ -0,0 +1,5 @@ +use Test::More; +eval " +use Test::Pod::Coverage 1.00; "; +plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@; +all_pod_coverage_ok(); \ No newline at end of file diff --git a/t/9reopenfh.t b/t/9reopenfh.t new file mode 100755 index 0000000..a9e2837 --- /dev/null +++ b/t/9reopenfh.t @@ -0,0 +1,75 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl 1.t' + +######################### + +use Test::More; +eval " +use Test::Fork; "; +plan skip_all => "Test::Fork required for this test" if $@; +plan tests => 12; + +use Log::Dispatch; +use Log::Dispatch::File::Rolling; +ok(1); # If we made it this far, we're ok. + +#########################1 + +my $dispatcher = Log::Dispatch->new; +ok($dispatcher); + +#########################2 + +my %params = ( + name => 'file', + min_level => 'debug', + filename => 'logfile.txt', +); + +my $Rolling = Log::Dispatch::File::Rolling->new(%params); +ok($Rolling); + +#########################3 + +$dispatcher->add($Rolling); + +ok(1); + +#########################4 + +my @message = map {'logtest id ' . int(rand(9999))} 1 .. 3; + +my $initial_fileno = fileno $Rolling->{fh}; +$dispatcher->log( level => 'info', message => $message[0] ); +my $parent_fileno = fileno $Rolling->{fh}; +is( $parent_fileno, $initial_fileno, "initial log call doesn't reopen" ); +fork_ok( 2, sub { + $dispatcher->log( level => 'info', message => $message[1] ); + my $child_fileno = fileno $Rolling->{fh}; + isnt( $child_fileno, $parent_fileno, "logging in child reopens" ); + $dispatcher = $Rolling = undef; + ok(1); +}); +$dispatcher->log( level => 'info', message => $message[2] ); +my $_parent_fileno = fileno $Rolling->{fh}; +is( $_parent_fileno, $parent_fileno, "logging in parent does not reopen" ); + +ok(1); + +#########################5 + +$dispatcher = $Rolling = undef; + +ok(1); + +#########################6 + +my @logfiles = glob('logfile*.txt'); + +ok(scalar(@logfiles) == 1 or scalar(@logfiles) == 2); + +#########################7 + +foreach my $file (@logfiles) { + unlink $file; +}