Log-Dispatch-FileRotate-1.38000755001751001751 014053462761 16320 5ustar00mschoutmschout000000000000README100644001751001751 60414053462761 17241 0ustar00mschoutmschout000000000000Log-Dispatch-FileRotate-1.38This archive contains the distribution Log-Dispatch-FileRotate, version 1.38: Log to Files that Archive/Rotate Themselves This software is copyright (c) 2005 by Mark Pfeiffer. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. This README file was generated by Dist::Zilla::Plugin::Readme v6.017. Changes100640001751001751 1722614053462761 17720 0ustar00mschoutmschout000000000000Log-Dispatch-FileRotate-1.38Revision history for Perl extension Log::Dispatch::FileRotate. 1.38 Wed 14 26 2021 - No Changes other than SIGNATURE, v1.37 was missing SIGNATURE 1.37 Wed 58 26 2021 - Improve synopsis showing how to use it with Log::Dispatch [Github #23] - Bump minimum version of Log::Dispatch to v2.59 to address minimum List::Util indirect dependency via Specio [Github #26] 1.36 Sun 24 29 2018 - If the "permissions" param is set, use the same permissions for the lock file that the log file will use. [github #21] 1.35 Wed 43 07 2018 - Fix lockfile race condition test in Strawberry Perl (Thanks Zak B. Elep) - Skip file open failure test on Cygwin - chmod bahaviour varies on Cygwin (Zak B. Elep) - Minor test cleanups (Zak B. Elep) - Fix "Use of "localtime" without parentheses" warning on older Perls - Migrate issues/bug tracking from rt.cpan.org to Github issues. 1.34 Wed 55 13 2017 - We now use a a global Mutex object for each open file that gracefully handles locking between threads and across forks. This fixes the following deadlock scenarios: - a $SIG{__WARN__} handler is installed that logs to Log::Dispatch::FileRotate and log_message issues a warning. - multiple dispatchers are in logit() at the same time. - Abstract locking functions into Log::Dispatch::FileRotoate::Flock module. - Remove flock()'ing of the logfile filehandle. Rely on the lock that we hold on the "lockfile" instead to synchronize writes. [Github #12] holding a lock on the lockfile when writing the log message. - Various pod cleanups and enhancements (Thanks Emanuele Tomasi) - Avoid multiple stat() calls on the same filehandle (Thanks Emanuele Tomasi) - Add user_constraint option to use a custom function to determine when rotation happens (Thanks Emanuele Tomasi). - Move rotation code into its own function (Thanks Emanuele Tomasi) 1.30 Thu Aug 03 2017 - Docs: fix synopsis usage to "name" (incorrect) instead of filename (correct) (Thanks Emanuele Tomasi) - improve debug() routine so that all debug messages have the same layout (Thanks Emanuele Tomasi) - fix race condition in lockfile-race-condition.t [sic] (Thanks Emanuele Tomasi) 1.29 Fri Jul 28 2017 - Fix deadlock on Windows due to the fact that stat() on a filehandle vs a path doesn't return the same device field on Windows. 1.28 Thu Jul 27 2017 *** Multiple fixes to locking code: - flock() can be interrupted by a syscall. work around by using a safe_flock() wrapper that retries if errno is EAGAIN (and also EWOULDBLOCK). - handle several possible race conditions between open() and flock(). - DESTROY() was unlinking the lockfile (.logfile.LCK). This was the cause of a race condition where multiple processes could enter the critical seciton at the same time. Avoided by leaving .LCK files in place. Probably fixes #77075 (Thanks Emanuele Tomasi). - add author test for DESTROY lockfile race condition. 1.27 Thu Jul 06 2017 - add "check_both" configuration option which allows the use of both time and size based rotation at the same time. If either conditions require a rotation, a rotation will happen. Default is false (previous behaviour). Thanks Emanuele Tomasi. PR #6. - make signature test an "author" test and make Test::Signature optional 1.26 Tue May 09 2017 - add SEE ALSO reference to Log::Dispath::File::Stamped (Thanks Karen Etheridge) 1.25 Mon Apr 10 2017 - Fix test failures if the test suite is running as root user. 1.24 Tue Feb 14 2017 - fix test failure on file-open-failure.t related to current locale setting. - improve fix to Date::Manip TZ deprecation warnings. 1.23 Thu Feb 09 2017 - Issue a warning if the lockfile cannot be opened (Thanks KGOESS) [#63544] - Fix POD typo (Thanks Anirvan Chatterjee) 1.22 Thu Oct 06 2016 - Fix minor POD error (Thanks Matthias Schmitz) [#47665] - Remove Log::Log4perl dependency. The tests now use Log::Dispatch directly instead of going through Log4perl. [#55359] - Split out "no activity" test case into its own file - Use Dist::Zilla to build the dist - Move test.pl to t/basic.t - Allow "size" parameter to contain underscores such as 10_000_000 (recognized as 10000000) [#41064] - Add a signature test (optional, skipped if Module::Signature is not installed and only run if TEST_SIGNATURE=1 is passed to make test) - Docs: fix synopsis reference to size parameter to make it clear that the size is in bytes, not megabytes. [#88286] 1.21 [REMOVED] - accidental release, bad dist. 1.20 Sat Oct 01 2016 - Fix Date::Manip warnings about deprecated TZ config variable. If Date::Manip 6.x or later is installed we now use SetDate instead. 1.19 Tue Oct 21 2008 - Added patch from MS to solve bug 39900. Basically logs appearing slower than a recurrance cause the module to keep rotating logs. We now jump forward to the right recurrance interval. Thanks to the people at Yahoo who discovered it. - Updated dependancy on Log4Perl to 1.0 1.18 Wed Jun 25 12:19:11 EST 2008 - rolled up issue with using Date::Manip internal function - added extra test for cygwin - added better tests for 'max' paramater - removed TZ details from doco and pointed people to Date::Manip 1.15 Wed Apr 26 08:09:20 EST 2006 - Added GPL copyright notice to fit with Perl 5 1.14 Mon Apr 24 13:35:06 EST 2006 - create copyright notice 1.13 Tue Mar 1 12:04:13 EST 2005 - Went back to epoch times for comparisions. My comments above regarding Date::Manip and MacOSX are silly. - Added better lockfile name picking thanks to Stephen Gordon - Removed the $$ from the lockfile name as it makes it too uniq 1.12 Mon Feb 28 23:20:03 EST 2005 - Added code to handle short running proggies like CGIs that want to use the DatePattern stuff. Now check mtime of log file to see if we need to rotate (at start up only). - Got rid of epochs as they conflict with Date::Manip's UnixDate() function on MacOSX. This slows us down quite a bit so I am using cmp instead of Date_Cmp() to get some speed back. - Fixed up some typos and removed some email addresses as requested. - Not released 1.11 Thu Sep 25 11:18:04 EST 2003 - Forgot to update the Doco from 1.10. - Added some missing log4j recurrence patterns and made them case insensitive 1.10 Mon Jun 23 09:40:34 EST 2003 - Seems defaulting to size in Megs happened between 1.05 and 1.06 which is not what people want. So back to bytes now. 1.09 Thu Jun 5 17:57:46 EST 2003 - Even better testing of TZ issues. Try to see if we can work around them by ignoring and then testing results. 1.08 Thu Jun 5 11:27:49 EST 2003 - now build log.conf at 'make test' time as we keep having people fail due to bad TZ settings - Also added some more testing on the recurrances 1.07 Sun May 4 23:42:03 EST 2003 - fixed up locking in a forked environment - speed up in time mode. Cache recurrences. Much quicker now :-) 1.06 Tue Apr 29 16:08:37 EST 2003 - moved inode tests around a bit to fix a warning message 1.05 Thu Nov 21 09:28:42 EST 2002 - fixed typos in hash key 1.04 Wed Nov 20 13:43:04 EST 2002 - added Time based constraints. 1.03 Mon Nov 18 17:19:06 EST 2002 - added multiple writer stuff. Use flock() to handle locks 1.01 Tue Oct 1 01:21:54 EST 2002 - Real code copied over h2xs stuff. 0.01 Tue Oct 1 01:12:30 2002 - original version; created by h2xs 1.20 with options -AX -n Log::Dispatch::FileRotate LICENSE100644001751001751 4366014053462761 17437 0ustar00mschoutmschout000000000000Log-Dispatch-FileRotate-1.38This software is copyright (c) 2005 by Mark Pfeiffer. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2005 by Mark Pfeiffer. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2005 by Mark Pfeiffer. This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End META.yml100644001751001751 276314053462761 17662 0ustar00mschoutmschout000000000000Log-Dispatch-FileRotate-1.38--- abstract: 'Log to Files that Archive/Rotate Themselves' author: - 'Michael Schout ' build_requires: Encode: '0' Log::Dispatch: '2.60' Log::Dispatch::Screen: '0' POSIX: '0' Path::Tiny: '0.018' Test::More: '0.88' Test::Warn: '0' perl: '5.008' utf8: '0' configure_requires: ExtUtils::MakeMaker: '0' perl: '5.006' dynamic_config: 0 generated_by: 'Dist::Zilla version 6.017, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Log-Dispatch-FileRotate provides: Log::Dispatch::FileRotate: file: lib/Log/Dispatch/FileRotate.pm version: '1.38' Log::Dispatch::FileRotate::Flock: file: lib/Log/Dispatch/FileRotate/Flock.pm version: '1.38' Log::Dispatch::FileRotate::Mutex: file: lib/Log/Dispatch/FileRotate/Mutex.pm version: '1.38' requires: Carp: '0' Date::Manip: '0' Exporter: '0' Fcntl: '0' File::Spec: '0' Log::Dispatch: '2.60' Log::Dispatch::File: '0' Log::Dispatch::Output: '0' base: '0' perl: '5.008' strict: '0' version: '0' warnings: '0' resources: bugtracker: https://github.com/mschout/perl-log-dispatch-filerotate/issues homepage: https://github.com/mschout/perl-log-dispatch-filerotate repository: https://github.com/mschout/perl-log-dispatch-filerotate.git version: '1.38' x_generated_by_perl: v5.30.3 x_serialization_backend: 'YAML::Tiny version 1.73' x_spdx_expression: 'Artistic-1.0-Perl OR GPL-1.0-or-later' MANIFEST100644001751001751 101514053462761 17527 0ustar00mschoutmschout000000000000Log-Dispatch-FileRotate-1.38# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.017. Changes LICENSE MANIFEST MANIFEST.SKIP META.json META.yml Makefile.PL README SIGNATURE cpanfile lib/Log/Dispatch/FileRotate.pm lib/Log/Dispatch/FileRotate/Flock.pm lib/Log/Dispatch/FileRotate/Mutex.pm t/00-compile.t t/author-lockfile-race-condition.t t/author-pod-syntax.t t/author-signature.t t/basic.t t/file-open-failure.t t/lockfile-open-failure.t t/lockfile-permissions.t t/no-activity-bug.t t/sig-warn-deadlock.t t/size-with-underscore.t cpanfile100644001751001751 240314053462761 20104 0ustar00mschoutmschout000000000000Log-Dispatch-FileRotate-1.38# This file is generated by Dist::Zilla::Plugin::CPANFile v6.017 # Do not edit this file directly. To change prereqs, edit the `dist.ini` file. requires "Carp" => "0"; requires "Date::Manip" => "0"; requires "Exporter" => "0"; requires "Fcntl" => "0"; requires "File::Spec" => "0"; requires "Log::Dispatch" => "2.60"; requires "Log::Dispatch::File" => "0"; requires "Log::Dispatch::Output" => "0"; requires "base" => "0"; requires "perl" => "5.008"; requires "strict" => "0"; requires "version" => "0"; requires "warnings" => "0"; on 'test' => sub { requires "Encode" => "0"; requires "Log::Dispatch" => "2.60"; requires "Log::Dispatch::Screen" => "0"; requires "POSIX" => "0"; requires "Path::Tiny" => "0.018"; requires "Test::More" => "0.88"; requires "Test::Warn" => "0"; requires "perl" => "5.008"; requires "utf8" => "0"; }; on 'configure' => sub { requires "ExtUtils::MakeMaker" => "0"; requires "perl" => "5.006"; }; on 'develop' => sub { requires "Dist::Zilla" => "5"; requires "Dist::Zilla::Plugin::CPANFile" => "0"; requires "Dist::Zilla::Plugin::Prereqs" => "0"; requires "Dist::Zilla::PluginBundle::MSCHOUT" => "0"; requires "Software::License::Perl_5" => "0"; requires "Test::Pod" => "1.41"; requires "Test::Signature" => "0"; }; t000755001751001751 014053462761 16504 5ustar00mschoutmschout000000000000Log-Dispatch-FileRotate-1.38basic.t100755001751001751 536314053462761 20124 0ustar00mschoutmschout000000000000Log-Dispatch-FileRotate-1.38/t#!/usr/bin/perl -w use strict; use warnings; use Test::More 0.88; use Path::Tiny 0.018; if ($^O eq 'cygwin') { # Date::Manip doesn't like Cygwin's TZ value. $ENV{TZ} = (split " ",(`date`)[0])[4]; } use Log::Dispatch; use Log::Dispatch::Screen; use Log::Dispatch::FileRotate; use Date::Manip; my $tz; eval { $tz = Date_TimeZone(); }; if($@) { diag 'Unable to determine timezone! Lets see if it matters..'; my $start = DateCalc("now","+ 1 second"); my @dates = ParseRecur('0:0:0:0:0:1*0', 'now', $start, '20 minutes later'); # Should get about 20 in the array my @epochs = map { UnixDate($_,'%s') } @dates; shift @epochs while @epochs && $epochs[0] <= time; # If no epochs left then Timezone issue is going to bite us! # all bets are off. if (@epochs) { pass 'It looks like we can get by without a timezone. Lucky!'; } else { fail '**** Time Zone problem: All bets are off. ****'; } $tz = ''; } else { pass "Your timezone is $tz"; } my $tempdir = Path::Tiny->tempdir; my $dispatcher = Log::Dispatch->new; isa_ok $dispatcher, 'Log::Dispatch'; my $screen_logger = Log::Dispatch::Screen->new(min_level => 'emergency'); isa_ok $screen_logger, 'Log::Dispatch::Screen'; $dispatcher->add($screen_logger); my $file_logger = Log::Dispatch::FileRotate->new( filename => $tempdir->child('myerrs.log')->stringify, min_level => 'debug', mode => 'append', size => 20000, max => 5, newline => 1, DatePattern => 'YYYY-dd-HH', TZ => $tz); isa_ok $file_logger, 'Log::Dispatch::FileRotate'; $dispatcher->add($file_logger); note <log(level => $level, message => $msg); push @logged, $msg; } $i++; # sleep 1; } open my $logfile, '<', $tempdir->child('myerrs.log'); my @logfile_lines = <$logfile>; cmp_ok scalar @logged, '==', scalar @logfile_lines, 'Logfile has expected number of lines'; my $line_num = 1; while (my $line = shift @logfile_lines) { chomp $line; my $expected = shift @logged; is $line, $expected, 'Logfile line '. $line_num++; } done_testing; SIGNATURE100644001751001751 663414053462761 17676 0ustar00mschoutmschout000000000000Log-Dispatch-FileRotate-1.38This file contains message digests of all files listed in MANIFEST, signed via the Module::Signature module, version 0.83. To verify the content in this distribution, first make sure you have Module::Signature installed, then type: % cpansign -v It will check each file's integrity, as well as the signature's validity. If "==> Signature verified OK! <==" is not displayed, the distribution may already have been compromised, and you should not run its Makefile.PL or Build.PL. -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA256 SHA256 dd6c4123984f762e4a834ed4c280e37a052cd4ca14813037fcc8ced352b72dfa Changes SHA256 62bd0190adff97c39493d0b233cd16b791f2d3a31934dd9300be7a163c1af4dc LICENSE SHA256 f5fb564637e7bc4aa8bf42f30c403b59eba2d62714ff7c53f6f60f3858b12dfc MANIFEST SHA256 b814ca0e4ffa66f015c015c28b583cb63e06cdeb86752c3a6c611ec4d64f3f46 MANIFEST.SKIP SHA256 ecbf9965b7c6b0457338da2477954bcba66f0cad0328dbeb2fecb306c99b273a META.json SHA256 17216531d13f8eb983257afca80e2b2180563543f6266d7736ec5698d4760235 META.yml SHA256 b2e5bb73caaaecc10167613ab4e14ba19495efbe2a7843cd59d6b4f385d769e4 Makefile.PL SHA256 ce33811c27fff1789d831c7892a52e9553f8d1114d1c2c949e676586188e1aed README SHA256 4f2c55e5e5b9fa0fdf71ecd93cee6ea9cb4c451b45343083b9efeca2a8fda103 cpanfile SHA256 29efa351157e24b199727ca6879896fc2ac56db45057a0228ad1c636b6798109 lib/Log/Dispatch/FileRotate.pm SHA256 31ef1267b21334f1e58568a34e0315615731ccc255c2777a4458e751640239c5 lib/Log/Dispatch/FileRotate/Flock.pm SHA256 bc234997250bdf47e30ad1c3b1137e1c19a0683cfd2b38f4b70eb42cdd695ae5 lib/Log/Dispatch/FileRotate/Mutex.pm SHA256 f1d254742caa039bf5d25846aaf9fc0329b8bb232ee34f8a999349cbe6c770b8 t/00-compile.t SHA256 48069796de323761914d4ecbc7e5645abebf791efff24e66cbae1a7ef636472e t/author-lockfile-race-condition.t SHA256 305c657c6b73f10767a0ea286b8a73d693940f4cbb8b6a0a4d34e2b5a1c04635 t/author-pod-syntax.t SHA256 9a339818bc8fe7f23595b06538321f26436cb3318c81446d88cd8af2d2ff4806 t/author-signature.t SHA256 0894405d46ccd7e1c2d4bdfb031e158046e5247eea1f1652db9f606bf878d022 t/basic.t SHA256 be1d3ba112e0958ba2c544e582696b30cfb12f7e972461ff0bc0d38dadc7ce7e t/file-open-failure.t SHA256 f2db0abf9dac76bcd4924b0a3aaa546a1e1938a7d616f4d5370a2d59d330dee9 t/lockfile-open-failure.t SHA256 832478b50202476ff3cf94ab9560bdb2219202ecf33ee49254e5a420329eb320 t/lockfile-permissions.t SHA256 829692cce04bb471e837498f27ad03a3baec78b32228aeb5f6030c5a540e22e5 t/no-activity-bug.t SHA256 2b5f3ee7fe786f925e06bbc519de6895e0383b3e1fa09fb93565130d7a441099 t/sig-warn-deadlock.t SHA256 3e37b95687a9096450a2ef6b2b170e3e3ffb6b92cc8a362d4dfd63a2e692f900 t/size-with-underscore.t -----BEGIN PGP SIGNATURE----- iQJFBAEBCAAvFiEE2EtuRfhGgngE8PsARAzvLrlUzY4FAmCuZfARHG1zY2hvdXRA Y3Bhbi5vcmcACgkQRAzvLrlUzY7D1w/+IpzPK5QPWiUtBuZVjHas3qeIQXE8oSbk Q3R+zRn8y6Nx+OzbgrmQh8uYBNn+nZDdAH9AwOUvWl+TZCo5tJK3P9V3/0RpTnb2 egTSPM2O4D+jq8/HmExEUc8CcZVoRZVGtXTqaJj2DUyEDnAxTdFYudBQ0bpgXLK/ fM5VfWo2B0kliSdVQcUbvns2n6qBK/utUg54nkyizxdXdYsz+ST84ADDaiITcR9M vj/XdmXemt4ObAuond3vbZ5MkgdaNPf9ipsJdAbgVXuP3fPxO5Qs0gHYnhpxLPk2 Ok+HjwQIXAXc60jIYqpncfAn6qR1t0Gn3KdpkVMls1tr4HhV0rrIVNSuNcj5ZpZl O1n5q7KNG8joLCG6RSNqE81alPGV9oWRbgIpfmg3hlHETStjSAfsaUcMty7ukaQT L8tXnhW40fESvIlRIt4KvowwaBPmlfX/1PdMsqEiTuomwoSi/g5XJJjnoaM/2dBN RGXIFpoLghvKijZb20ryVyNhOSlh4SYSKB1oGX2zBJx+7j4IzbVb+dvPw/jctHov KHWVY/oNBn63Qi/iJqj0Kn7QkRQAWO/Dy5YXFjXVwSy+Wm0h1a2X12iV6//U7eVB OtGfc0b8+qGvl1CwHjh9VpplYmoJpzs5J6FdeBfd3zm0FXjhTPCbkF3a75jpWNia Cm9pPqX/2ts= =jXG6 -----END PGP SIGNATURE----- META.json100644001751001751 547114053462761 20031 0ustar00mschoutmschout000000000000Log-Dispatch-FileRotate-1.38{ "abstract" : "Log to Files that Archive/Rotate Themselves", "author" : [ "Michael Schout " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 6.017, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Log-Dispatch-FileRotate", "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0", "perl" : "5.006" } }, "develop" : { "requires" : { "Dist::Zilla" : "5", "Dist::Zilla::Plugin::CPANFile" : "0", "Dist::Zilla::Plugin::Prereqs" : "0", "Dist::Zilla::PluginBundle::MSCHOUT" : "0", "Software::License::Perl_5" : "0", "Test::Pod" : "1.41", "Test::Signature" : "0" } }, "runtime" : { "requires" : { "Carp" : "0", "Date::Manip" : "0", "Exporter" : "0", "Fcntl" : "0", "File::Spec" : "0", "Log::Dispatch" : "2.60", "Log::Dispatch::File" : "0", "Log::Dispatch::Output" : "0", "base" : "0", "perl" : "5.008", "strict" : "0", "version" : "0", "warnings" : "0" } }, "test" : { "requires" : { "Encode" : "0", "Log::Dispatch" : "2.60", "Log::Dispatch::Screen" : "0", "POSIX" : "0", "Path::Tiny" : "0.018", "Test::More" : "0.88", "Test::Warn" : "0", "perl" : "5.008", "utf8" : "0" } } }, "provides" : { "Log::Dispatch::FileRotate" : { "file" : "lib/Log/Dispatch/FileRotate.pm", "version" : "1.38" }, "Log::Dispatch::FileRotate::Flock" : { "file" : "lib/Log/Dispatch/FileRotate/Flock.pm", "version" : "1.38" }, "Log::Dispatch::FileRotate::Mutex" : { "file" : "lib/Log/Dispatch/FileRotate/Mutex.pm", "version" : "1.38" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/mschout/perl-log-dispatch-filerotate/issues" }, "homepage" : "https://github.com/mschout/perl-log-dispatch-filerotate", "repository" : { "type" : "git", "url" : "https://github.com/mschout/perl-log-dispatch-filerotate.git", "web" : "https://github.com/mschout/perl-log-dispatch-filerotate" } }, "version" : "1.38", "x_generated_by_perl" : "v5.30.3", "x_serialization_backend" : "Cpanel::JSON::XS version 4.19", "x_spdx_expression" : "Artistic-1.0-Perl OR GPL-1.0-or-later" } Makefile.PL100644001751001751 350714053462761 20360 0ustar00mschoutmschout000000000000Log-Dispatch-FileRotate-1.38# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.017. use strict; use warnings; use 5.008; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( "ABSTRACT" => "Log to Files that Archive/Rotate Themselves", "AUTHOR" => "Michael Schout ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0 }, "DISTNAME" => "Log-Dispatch-FileRotate", "LICENSE" => "perl", "MIN_PERL_VERSION" => "5.008", "NAME" => "Log::Dispatch::FileRotate", "PREREQ_PM" => { "Carp" => 0, "Date::Manip" => 0, "Exporter" => 0, "Fcntl" => 0, "File::Spec" => 0, "Log::Dispatch" => "2.60", "Log::Dispatch::File" => 0, "Log::Dispatch::Output" => 0, "base" => 0, "strict" => 0, "version" => 0, "warnings" => 0 }, "TEST_REQUIRES" => { "Encode" => 0, "Log::Dispatch" => "2.60", "Log::Dispatch::Screen" => 0, "POSIX" => 0, "Path::Tiny" => "0.018", "Test::More" => "0.88", "Test::Warn" => 0, "utf8" => 0 }, "VERSION" => "1.38", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "Carp" => 0, "Date::Manip" => 0, "Encode" => 0, "Exporter" => 0, "Fcntl" => 0, "File::Spec" => 0, "Log::Dispatch" => "2.60", "Log::Dispatch::File" => 0, "Log::Dispatch::Output" => 0, "Log::Dispatch::Screen" => 0, "POSIX" => 0, "Path::Tiny" => "0.018", "Test::More" => "0.88", "Test::Warn" => 0, "base" => 0, "strict" => 0, "utf8" => 0, "version" => 0, "warnings" => 0 ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); MANIFEST.SKIP100644001751001751 33014053462761 20253 0ustar00mschoutmschout000000000000Log-Dispatch-FileRotate-1.38^blib/ ^Makefile$ ^Makefile\.old$ ^pm_to_blib$ ^\.git/ ^\.gitignore$ ^t/TEST$ ^t/db/ ~$ error_log ^dist\.ini ^weaver\.ini ^t/httpd.loc ^MYMETA ^log\.conf$ ^myerrs\. ^\.travis.yml$ ^\.appveyor\.cmd$ ^\.appveyor\.yml$ 00-compile.t100644001751001751 32014053462761 20651 0ustar00mschoutmschout000000000000Log-Dispatch-FileRotate-1.38/t#!/usr/bin/perl -w use strict; use warnings; use Test::More 0.88; use_ok $_ for qw( Log::Dispatch::FileRotate Log::Dispatch::FileRotate::Flock Log::Dispatch::FileRotate::Mutex ); done_testing; no-activity-bug.t100755001751001751 173514053462761 22063 0ustar00mschoutmschout000000000000Log-Dispatch-FileRotate-1.38/t#!/usr/bin/env perl use strict; use warnings; use Test::More 0.88; use Path::Tiny 0.018; plan tests => 5; use Log::Dispatch; use Log::Dispatch::FileRotate; my $tempdir = Path::Tiny->tempdir; my $dispatcher = Log::Dispatch->new; isa_ok $dispatcher, 'Log::Dispatch'; my $count = 0; my $logger = Log::Dispatch::FileRotate->new( filename => $tempdir->child('test.log')->stringify, mode => 'append', max => 6, min_level => 'info', DatePattern => 'yyyy-MM-dd-HH'); isa_ok $logger, 'Log::Dispatch::FileRotate'; $logger->{timer} = sub { time + $count * 3600; }; $dispatcher->add($logger); # $logger->{debug} = 1; $dispatcher->log(level => 'info', message => "count=$count"); $count += 10; for (1..3) { $dispatcher->log(level => 'info', message => "count=$count"); } ok -f $tempdir->child('test.log')->stringify; ok -f $tempdir->child('test.log.1')->stringify; # This shouldn't exist ok ! -f $tempdir->child('test.log.2')->stringify; author-signature.t100644001751001751 65714053462761 22322 0ustar00mschoutmschout000000000000Log-Dispatch-FileRotate-1.38/t#!perl -w BEGIN { unless ($ENV{AUTHOR_TESTING}) { print qq{1..0 # SKIP these tests are for testing by the author\n}; exit } } # This file was automatically generated by Dist::Zilla::Plugin::AuthorSignatureTest use strict; use warnings; use Test::More; unless (eval { require Test::Signature; 1 }) { plan skip_all => 'Test::Signature is required for this test'; } Test::Signature::signature_ok(); done_testing; sig-warn-deadlock.t100755001751001751 533314053462761 22333 0ustar00mschoutmschout000000000000Log-Dispatch-FileRotate-1.38/t#!/usr/bin/env perl # # Test case for deadlock caused by a $SIG{__WARN__} handler that logs warnings # through Log::Dispatch::FileRotate. # # See https://github.com/mschout/perl-log-dispatch-filerotate/issues/11 # use utf8; use strict; use warnings; use Test::More 0.88; use Path::Tiny 0.018; use Encode qw(decode); use Test::Warn; if ($] < 5.008000) { # we depend on the "Wide character in print" warning, which was added in 5.8 plan skip_all => 'This test requires Perl 5.8.0 or later'; } plan tests => 8; use Log::Dispatch; use Log::Dispatch::FileRotate; my $tempdir = Path::Tiny->tempdir; my $logfile = $tempdir->child('myerrs.log')->stringify; my $dispatcher = Log::Dispatch->new; isa_ok $dispatcher, 'Log::Dispatch'; # we need to make sure we do not turn on utf8 mode here so that we can trigger # the "Wide character in print" warning. my $file_logger = Log::Dispatch::FileRotate->new( filename => $logfile, min_level => 'debug', mode => 'append', max => 5, newline => 0, DatePattern => 'YYYY-dd-HH'); isa_ok $file_logger, 'Log::Dispatch::FileRotate'; $dispatcher->add($file_logger); # install __WARN__ handler $SIG{__WARN__} = sub { $dispatcher->warn(@_) }; $SIG{ALRM} = sub { die "timeout\n" }; my $desc = '__WARN__ deadlock'; eval { alarm 10; # "warning" in chinese, at least according to google translate. $dispatcher->info("1: \x{8b66}\x{544a}"); alarm 0; }; if ($@) { diag $@ =~ /^timeout/ ? 'deadlock detected' : "error: $@"; fail $desc; } else { pass $desc; } open my $fh, '<', $logfile or die "cannot open $logfile: $!"; # first line in the file should be the warning my $line = <$fh>; like $line, qr/Wide character in print/; # next line should be the UTF-8 string $line = <$fh>; chomp $line; is decode('UTF-8', $line), "1: \x{8b66}\x{544a}"; # test scenario where we have a different dispatcher instance in the __WARN__ # handler, but logging to the same file. my $warn_dispatcher = Log::Dispatch->new; isa_ok $warn_dispatcher, 'Log::Dispatch'; # we need to make sure we do not turn on utf8 mode here so that we can trigger # the "Wide character in print" warning. my $warn_logger = Log::Dispatch::FileRotate->new( filename => $logfile, min_level => 'debug', mode => 'append', max => 5, newline => 0, DatePattern => 'YYYY-dd-HH'); isa_ok $warn_logger, 'Log::Dispatch::FileRotate'; $warn_dispatcher->add($warn_logger); $SIG{__WARN__} = sub { $warn_dispatcher->warn(@_) }; eval { alarm 10; $dispatcher->info("2: \x{8b66}\x{544a}"); alarm 0; }; if ($@) { diag $@ =~ /^timeout/ ? 'deadlock detected' : "error: $@"; fail $desc; } else { pass $desc; } file-open-failure.t100755001751001751 313414053462761 22340 0ustar00mschoutmschout000000000000Log-Dispatch-FileRotate-1.38/t#!/usr/bin/env perl -w # # Test case for what happens when filename cannot be written to # use strict; use warnings; use Test::More 0.88; use Path::Tiny 0.018; use Test::Warn; # we need to make sure we are in the correct locale so that we get "Permission # denied" as the error message, not a translation of that into another locale unless (eval { require POSIX; 1 }) { plan skip_all => 'POSIX module is required for this test'; } if ($^O eq 'cygwin') { plan skip_all => 'chmod behavior varies on cygwin'; } if ($> == 0) { plan skip_all => 'root user is exempt from file RW permissions restrictions'; } my $locale = 'en_US.UTF-8'; my $curloc = POSIX::setlocale(&POSIX::LC_ALL, $locale) || ''; unless ($curloc eq $locale) { plan skip_all => "locale $locale is not available on this system"; } use Log::Dispatch::FileRotate; my $tempdir = Path::Tiny->tempdir; # Create a file that isn't writable my $filename = $tempdir->child('myerrs.log')->stringify; open my $o, '>', $filename; close $o; chmod 0, $filename; warning_is( sub { my $file_logger = eval { Log::Dispatch::FileRotate->new( filename => $filename, min_level => 'debug', mode => 'append', max => 5, newline => 0, DatePattern => 'YYYY-dd-HH'); }; like( $@, qr/Cannot write to '.*myerrs.log': Permission denied/, 'Expect a "Permission denied" error' ); }, undef, 'No warnings from using an unwritable filename' ); done_testing; author-pod-syntax.t100644001751001751 45414053462761 22422 0ustar00mschoutmschout000000000000Log-Dispatch-FileRotate-1.38/t#!perl BEGIN { unless ($ENV{AUTHOR_TESTING}) { print qq{1..0 # SKIP these tests are for testing by the author\n}; exit } } # This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. use strict; use warnings; use Test::More; use Test::Pod 1.41; all_pod_files_ok(); lockfile-permissions.t100755001751001751 155114053462761 23177 0ustar00mschoutmschout000000000000Log-Dispatch-FileRotate-1.38/t#!/usr/bin/env perl use strict; use warnings; use Test::More; use Path::Tiny; use Log::Dispatch::FileRotate; for my $mode (0666, 0644, 0600) { my $tempdir = Path::Tiny->tempdir; my $dispatcher = Log::Dispatch->new; isa_ok $dispatcher, 'Log::Dispatch'; my $file_logger = Log::Dispatch::FileRotate->new( filename => $tempdir->child('myerrs.log')->stringify, permissions => 0666, min_level => 'debug', mode => 'append', size => 20000, max => 5, newline => 1, DatePattern => 'YYYY-dd-HH'); isa_ok $file_logger, 'Log::Dispatch::FileRotate'; $dispatcher->add($file_logger); $dispatcher->log(level => 'info', message => 'Hello world'); my $permissions = (stat $file_logger->{lf})[2] & 07777; cmp_ok $permissions, '==', 0666; } done_testing; size-with-underscore.t100755001751001751 102514053462761 23124 0ustar00mschoutmschout000000000000Log-Dispatch-FileRotate-1.38/t#!/usr/bin/env perl use strict; use warnings; use Test::More 0.88; use Path::Tiny 0.018; use Log::Dispatch; use Log::Dispatch::FileRotate; my $tempdir = Path::Tiny->tempdir; for my $size ('20_000', 20_000) { my $logger = Log::Dispatch::FileRotate->new( filename => $tempdir->child('error.log')->stringify, min_level => 'debug', mode => 'append', size => '20_000'); isa_ok $logger, 'Log::Dispatch::FileRotate'; cmp_ok $logger->{size}, '==', 20000; } done_testing; lockfile-open-failure.t100755001751001751 251014053462761 23206 0ustar00mschoutmschout000000000000Log-Dispatch-FileRotate-1.38/t#!/usr/bin/env perl # # Test case for what happens when lockfile cannot be opened # use strict; use warnings; use Test::More 0.88; use Path::Tiny 0.018; use Test::Warn; use Fcntl qw(LOCK_EX LOCK_UN); if ($> == 0) { plan skip_all => 'root user is exempt from file RW permissions restrictions'; } use Log::Dispatch; use Log::Dispatch::FileRotate; my $tempdir = Path::Tiny->tempdir; my $dispatcher = Log::Dispatch->new; isa_ok $dispatcher, 'Log::Dispatch'; my $file_logger = Log::Dispatch::FileRotate->new( filename => $tempdir->child('myerrs.log')->stringify, min_level => 'debug', mode => 'append', max => 5, newline => 0, DatePattern => 'YYYY-dd-HH'); isa_ok $file_logger, 'Log::Dispatch::FileRotate'; $dispatcher->add($file_logger); $dispatcher->info('write with successful lock'); # mock out lock() so it returns failure no warnings qw(redefine once); *Log::Dispatch::FileRotate::Mutex::lock = sub { return 0 }; warning_like { $dispatcher->info('Write with unsuccessful lock'); } [qr/\d+ Log::Dispatch::FileRotate failed to get lock/, qr/\d+ Log::Dispatch::FileRotate not logging/]; open my $fh, '<', $tempdir->child('myerrs.log')->stringify or die "can't open logfile: $!"; my $content = do { local $/ = undef; <$fh> }; is $content, 'write with successful lock'; done_testing; Dispatch000755001751001751 014053462761 21267 5ustar00mschoutmschout000000000000Log-Dispatch-FileRotate-1.38/lib/LogFileRotate.pm100640001751001751 7065514053462761 24054 0ustar00mschoutmschout000000000000Log-Dispatch-FileRotate-1.38/lib/Log/Dispatchpackage Log::Dispatch::FileRotate; $Log::Dispatch::FileRotate::VERSION = '1.38'; # ABSTRACT: Log to Files that Archive/Rotate Themselves require 5.005; use strict; use base 'Log::Dispatch::Output'; use Date::Manip; use File::Spec; use Log::Dispatch::File; use Log::Dispatch::FileRotate::Mutex; sub DESTROY { my $self = shift; # get rid of current LDF if ($self->{LDF}) { delete $self->{LDF}; } } sub new { my $proto = shift; my $class = ref $proto || $proto; my %p = @_; my $self = bless {}, $class; # Turn ON/OFF debugging as required $self->{debug} = $p{DEBUG}; $self->_basic_init(%p); $self->{LDF} = Log::Dispatch::File->new(%p); # Our log unless (defined $self->{timer}) { $self->{timer} = sub { time }; } # Keep a copy of interesting stuff as well $self->{params} = \%p; # Size defaults to 10meg in all failure modes, hopefully my $ten_meg = 1024*1024*10; my $two_gig = 1024*1024*1024*2; my $size = $ten_meg; if (defined $p{size}) { # allow perl-literal style nubers 10_000_000 -> 10000000 $p{size} =~ s/_//g; $size = $p{size}; } unless ($size =~ /^\d+$/ && $size < $two_gig && $size > 0) { $size = $ten_meg; } $self->{size} = $size; # Max number of files defaults to 1. No limit enforced here. Only # positive whole numbers allowed $self->{max} = $p{max}; unless (defined $self->{max} && $self->{max} =~ /^\d+$/ && $self->{max} > 0) { $self->{max} = 1 } # Get a name for our Lock file my $name = $self->{params}->{filename}; my ($vol, $dir, $f) = File::Spec->splitpath($name); $dir ||= '.'; $f ||= $name; $self->{lf} = File::Spec->catpath($vol, $dir, ".${f}.LCK"); $self->debug('Lock file is '.$self->{lf}); # Have we been called with a time based rotation pattern then setup # timebased stuff. TZ is important and must match current TZ or all # bets are off! if (defined $p{TZ}) { # Date::Manip deprecated TZ= in 6.x. In order to maintain backwards # compat with 5.8, we use TZ if setdate is not avilable. Otherwise we # use setdate. require version; if (version->parse(DateManipVersion()) < version->parse('6.0')) { Date_Init("TZ=".$p{TZ}); } else { # Date::Manip 6.x deprecates TZ, use SetDate instead Date_Init("setdate=now,".$p{TZ}); } } if (defined $p{DatePattern}) { $self->setDatePattern($p{DatePattern}); } $self->{check_both} = $p{check_both} ? 1 : 0; # User callback to rotate the file. $self->{user_constraint} = $p{user_constraint}; # A post rotate callback. $self->{post_rotate} = $p{post_rotate}; # Flag this as first creation point $self->{new} = 1; return $self; } sub filename { my $self = shift; return $self->{params}->{filename}; } ########################################################################### # # Subroutine setDatePattern # # Args: a single string or ArrayRef of strings # # Rtns: Nothing # # Description: # Set a recurrance for file rotation. We accept Date::Manip # recurrances and the log4j/DailyRollingFileAppender patterns # # Date:Manip => # 0:0:0:0:5:30:0 every 5 hours and 30 minutes # 0:0:0:2*12:30:0 every 2 days at 12:30 (each day) # 3*1:0:2:12:0:0 every 3 years on Jan 2 at noon # # DailyRollingFileAppender => # yyyy-MM # yyyy-ww # yyyy-MM-dd # yyyy-MM-dd-a # yyyy-MM-dd-HH # yyyy-MM-dd-HH-MM # # To specify multiple recurances in a single string seperate them with a # comma: yyyy-MM-dd,0:0:0:2*12:30:0 # sub setDatePattern { my ($self, $arg) = @_; local($_); # Don't crap on $_ my @pats = (); my %lookup = ( # Y:M:W:D:H:M:S 'yyyy-mm' => '0:1*0:1:0:0:0', # Every Month 'yyyy-ww' => '0:0:1*0:0:0:0', # Every week 'yyyy-dd' => '0:0:0:1*0:0:0', # Every day 'yyyy-mm-dd' => '0:0:0:1*0:0:0', # Every day 'yyyy-dd-a' => '0:0:0:1*12:0:0', # Every day 12noon 'yyyy-mm-dd-a' => '0:0:0:1*12:0:0', # Every day 12noon 'yyyy-dd-hh' => '0:0:0:0:1*0:0', # Every hour 'yyyy-mm-dd-hh' => '0:0:0:0:1*0:0', # Every hour 'yyyy-dd-hh-mm' => '0:0:0:0:0:1*0', # Every minute 'yyyy-mm-dd-hh-mm' => '0:0:0:0:0:1*0', # Every minute ); # Convert arg to array if (ref $arg eq 'ARRAY') { @pats = @$arg; } elsif (!ref $arg) { $arg =~ s/\s+//go; @pats = split /;/, $arg; } else { die "Bad reference type argument ".ref $arg; } # Handle (possibly multiple) recurrances foreach my $pat (@pats) { # Convert any log4j patterns across if ($pat =~ /^yyyy/i) { # log4j style $pat = $lookup{lc $pat}; # Default to daily on bad pattern unless (defined $pat) { warn "Bad Rotation pattern ($pat) using yyyy-dd\n"; $pat = 'yyyy-dd'; } } my $abs = $self->_get_next_occurance($pat); $self->debug("Adding [dates,pat] =>[$abs,$pat]"); my $ref = [$abs, $pat]; push @{$self->{recurrance}}, $ref; } } sub log_message { my ($self, %p) = @_; my $mutex = $self->rotate(1); unless (defined $mutex) { $self->error('not logging'); return; } $self->debug('normal log'); $self->logit($p{message}); $self->debug('releasing lock'); $mutex->unlock; } sub rotate { my ($self, $hold_lock) = @_; # NOTE: $hold_lock is internal use only! my $max_size = $self->{size}; my $numfiles = $self->{max}; my $name = $self->filename(); my $fh = $self->{LDF}->{fh}; # Prime our time based data outside the critical code area my ($in_time_mode,$time_to_rotate) = $self->time_to_rotate(); my $user_rotation = 0; if (ref $self->{user_constraint} eq 'CODE') { eval { $user_rotation = &{$self->{user_constraint}}(); 1; } or do { $self->error("user's callback error: $@"); }; } # Handle critical code for logging. No changes if someone else is in. We # lock a lockfile, not the actual log filehandle since the log filehandle # will change if we rotate the logs. my $mutex = $self->mutex_for_path($self->{lf}); unless ($mutex->lock) { $self->error("failed to get lock: $!"); return; } $self->debug('got lock'); my $have_to_rotate = 0; my ($inode, $size) = (stat $fh)[1,7]; # real inode and size my $finode = (stat $name)[1]; # inode of filename for comparision $self->debug("s=$size, i=$inode, f=". (defined $finode ? $finode : "undef") . ", n=$name"); # If finode and inode are the same then nobody has done a rename # under us and we can continue. Otherwise just close and reopen. if (!defined $finode || $inode != $finode) { # Oops someone moved things on us. So just reopen our log delete $self->{LDF}; # Should get rid of current LDF $self->{LDF} = Log::Dispatch::File->new(%{$self->{params}}); # Our log $self->debug('Someone else rotated'); } else { my $check_both = $self->{check_both}; my $rotate_by_size = ($size >= $max_size) ? 1 : 0; if(($in_time_mode && $time_to_rotate) || (!$in_time_mode && $rotate_by_size) || ($rotate_by_size && $check_both) || ($user_rotation)) { $have_to_rotate = 1; } $self->debug("in time mode: $in_time_mode; time to rotate: $time_to_rotate;" ." rotate by size: $rotate_by_size; check_both: $check_both;" ." user rotation: $user_rotation; have to rotate: $have_to_rotate"); } if ($have_to_rotate) { # Shut down the log delete $self->{LDF}; # Should get rid of current LDF $self->debug('Rotating'); $self->_for_each_file(\&_move_file); $self->debug('Rotating Done'); # reopen the logfile for writing. $self->{LDF} = Log::Dispatch::File->new(%{$self->{params}}); # Our log if (ref $self->{post_rotate} eq 'CODE') { $self->debug('Calling user post-rotate callback'); $self->_for_each_file($self->{post_rotate}); } } if ($hold_lock) { return $mutex; } $mutex->unlock; return $have_to_rotate; } sub _for_each_file { my ($self, $callback) = @_; my $basename = $self->filename(); my $idx = $self->{max} - 1; while ($idx >= 0) { my $filename = $basename; if ($idx) { $filename .= ".$idx"; } eval { if (-f $filename) { &{$callback}($filename, $idx, $self); } 1; } or do { $self->error("callback error: $@"); }; $idx--; } return undef; } sub _move_file { my ($filename, $idx, $fileRotate) = @_; my $basename = $fileRotate->filename(); my $newfile = $basename . '.' . ($idx+1); $fileRotate->debug("rename $filename $newfile"); rename $filename, $newfile; return undef; } sub logit { my ($self, $message) = @_; # Make sure we are at the EOF seek $self->{LDF}{fh}, 0, 2; $self->{LDF}->log_message(message => $message); return; } { my %MUTEXES; sub mutex_for_path { my ($self, $path) = @_; my %args; # use same permissions for the Mutex file if (exists $self->{params}{permissions}) { $args{permissions} = $self->{params}{permissions}; } $MUTEXES{$path} ||= Log::Dispatch::FileRotate::Mutex->new($path, %args); } } ########################################################################### # # Subroutine time_to_rotate # # Args: none # # Rtns: (1,n) if we are in time mode and its time to rotate # n defines the number of timers that expired # (1,0) if we are in time mode but not ready to rotate # (0,0) otherwise # # Description: # time_to_rotate - update internal clocks and return status as # defined above # # If we have just been created then the first recurrance is an indication # to check against the log file. # # # my ($in_time_mode,$time_to_rotate) = $self->time_to_rotate(); sub time_to_rotate { my $self = shift; my $mode = defined $self->{recurrance}; my $rotate = 0; if ($mode) { # Then do some checking and update ourselves if we think we need # to rotate. Wether we rotate or not is up to our caller. We # assume they know what they are doing! # Only stat the log file here if we are in our first invocation. my $ftime = $self->{new} ? (stat $self->{LDF}{fh})[9] : 0; # Check need for rotation. Loop through our recurrances looking # for expiration times. Any we find that have expired we update. my $tm = $self->{timer}->(); my @recur = @{$self->{recurrance}}; $self->{recurrance} = []; for my $rec (@recur) { my ($abs, $pat) = @$rec; # Extra checking unless (defined $abs && $abs) { warn "Bad time found for recurrance pattern $pat: $abs\n"; next; } my $dorotate = 0; # If this is first time through if ($self->{new}) { # If it needs a rotate then flag it if ($ftime <= $abs) { # Then we need to rotate $self->debug("Need rotate file($ftime) <= $abs"); $rotate++; $dorotate++; # Just for debugging } # Move to next occurance regardless $self->debug("Dropping initial occurance($abs)"); $abs = $self->_get_next_occurance($pat); unless (defined $abs && $abs) { warn "Next occurance is null for $pat\n"; $abs = 0; } } elsif ($abs <= $tm) { # Then we need to rotate $self->debug("Need rotate $abs <= $tm"); $abs = $self->_get_next_occurance($pat); unless (defined $abs && $abs) { warn "Next occurance is null for $pat\n"; $abs = 0; } $rotate++; $dorotate++; # Just for debugging } if ($abs) { push @{$self->{recurrance}}, [$abs, $pat]; } $self->debug("time_to_rotate(mode,rotate,next) => ($mode,$dorotate,$abs)"); } } $self->{new} = 0; # No longer brand-spankers $self->debug("time_to_rotate(mode,rotate) => ($mode,$rotate)"); return wantarray ? ($mode, $rotate) : $rotate; } ########################################################################### # # Subroutine _gen_occurance # # Args: Date::Manip occurance pattern # # Rtns: array of dates for next few events # # If asked we will return an inital occurance that is before the current # time. This can be used to see if we need to rotate on start up. We are # often called by CGI (short lived) proggies :-( # sub _gen_occurance { my ($self, $pat, $initial) = @_; # Do we return an initial occurance before the current time? $initial ||= 0; my $range = ''; my $base = 'now'; # default to calcs based on the current time if ($pat =~ /^0:0:0:0:0/) { # Small recurrance less than 1 hour $range = "4 hours later"; $base = "1 hours ago" if $initial; } elsif ($pat =~ /^0:0:0:0/) { # recurrance less than 1 day $range = "4 days later"; $base = "1 days ago" if $initial; } elsif ($pat =~ /^0:0:0:/) { # recurrance less than 1 week $range = "4 weeks later"; $base = "1 weeks ago" if $initial; } elsif ($pat =~ /^0:0:/) { # recurrance less than 1 month $range = "4 months later"; $base = "1 months ago" if $initial; } elsif ($pat =~ /^0:/) { # recurrance less than 1 year $range = "24 months later"; $base = "24 months ago" if $initial; } else { # years my ($yrs) = $pat =~ m/^(\d+):/; $yrs ||= 1; my $months = $yrs * 4 * 12; $range = "$months months later"; $base = "$months months ago" if $initial; } # The next date must start at least 1 second away from now other wise # we may rotate for every message we recieve with in this second :-( my $start = DateCalc($base,"+ 1 second"); $self->debug("ParseRecur($pat,$base,$start,$range);"); my @dates = ParseRecur($pat,$base,$start,$range); # Just in case we have a bad parse or our assumptions are wrong. # We default to days unless (scalar @dates >= 2) { warn "Failed to parse ($pat). Going daily\n"; if ($initial) { @dates = ParseRecur('0:0:0:1*0:0:0',"2 days ago","2 days ago","1 months later"); } else { @dates = ParseRecur('0:0:0:1*0:0:0',"now","now","1 months later"); } } # Convert the dates to seconds since the epoch so we can use # numerical comparision instead of textual my @epochs = (); my @a = ('%Y','%m','%d','%H','%M','%S'); foreach (@dates) { my ($y,$m,$d,$h,$mn,$s) = Date::Manip::UnixDate($_, @a); my $e = Date_SecsSince1970GMT($m,$d,$y,$h,$mn,$s); $self->debug("Date to epochs ($_) => ($e)"); push @epochs, $e; } # Clean out all but the one previous to now if we are doing an # initial occurance my $now = time; if ($initial) { my $before = ''; while (@epochs && $epochs[0] <= $now) { $before = shift @epochs; } if ($before) { unshift @epochs, $before; } } else { # Clean out dates that occur before now, being careful not to loop # forever (thanks James). while (@epochs && $epochs[0] <= $now) { shift @epochs; } } $self->debug("Recurrances are at: ". join "\n\t", @dates); warn "No recurrances found! Probably a timezone issue!\n" unless @dates; return @epochs; } ########################################################################### # # Subroutine _get_next_occurance # # Args: Date::Manip occurance pattern # # Rtns: date # # We don't want to call Date::Manip::ParseRecur too often as it is very # expensive. So, we cache what is returned from _gen_occurance(). sub _get_next_occurance { my ($self, $pat) = @_; # (ms) Throw out expired occurances my $now = $self->{timer}->(); if (defined $self->{dates}{$pat}) { while (@{$self->{dates}{$pat}}) { last if $self->{dates}{$pat}->[0] >= $now; shift @{$self->{dates}{$pat}}; } } # If this is first time then generate some new ones including one # before our time to test against the log file unless (defined $self->{'dates'}{$pat}) { @{$self->{'dates'}{$pat}} = $self->_gen_occurance($pat,1); } elsif (scalar(@{$self->{'dates'}{$pat}}) < 2) { # close to the end of what we have @{$self->{'dates'}{$pat}} = $self->_gen_occurance($pat); } return shift @{$self->{'dates'}{$pat}}; } sub debug { my ($self, $message) = @_; return unless $self->{debug}; warn localtime() . " $$ $message\n"; return; } sub error { my ($self, $message) = @_; chomp $message; warn "$$ " . __PACKAGE__ . " $message\n"; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Log::Dispatch::FileRotate - Log to Files that Archive/Rotate Themselves =head1 VERSION version 1.38 =head1 SYNOPSIS use Log::Dispatch::FileRotate; my $logger = Log::Dispatch::FileRotate->new( name => 'file1', min_level => 'info', filename => 'Somefile.log', mode => 'append' , size => 10*1024*1024, max => 6); # or for a time based rotation my $logger = Log::Dispatch::FileRotate->new( name => 'file1', min_level => 'info', filename => 'Somefile.log', mode => 'append' , TZ => 'AEDT', DatePattern => 'yyyy-dd-HH'); # and attach to Log::Dispatch my $dispatcher = Log::Dispatch->new; $dispatcher->add($logger); $dispatcher->log( level => 'info', message => "your comment\n" ); =head1 DESCRIPTION This module extends the base class L to provides a simple object for logging to files under the Log::Dispatch::* system, and automatically rotating them according to different constraints. This is basically a L wrapper with additions. =head2 Rotation There are three different constraints which decide when a file must be rotated. The first is by size: when the log file grows more than a specified size, then it's rotated. The second constraint is with occurrences. If a L is defined, a file rotation ignores size constraint (unless C) and uses the defined date pattern constraints. When using L make sure TZ is defined correctly and that the TZ you use is understood by Date::Manip. We use Date::Manip to generate our recurrences. Bad TZ equals bad recurrences equals surprises! Read the L man page for more details on TZ. L will default to a daily rotate if your entered pattern is incorrect. You will also get a warning message. You can also check both constraints together by using the C parameter. The latter constraint is a user callback. This function is called outside the restricted area (see L) and, if it returns a true value, a rotation will happen unconditionally. All check are made before logging. The C method leaves us check these constraints without logging anything. To let more power at the user, a C callback it'll call after every rotation. =head2 Concurrency Multiple writers are allowed by this module. There is a restricted area where only one writer can be inside. This is done by using an external lock file, which name is "C<.filename.LCK>" (never deleted). The user constraint and the L constraint are checked outside this restricted area. So, when you write a callback, don't rely on the logging file because it can disappear under your feet. Within this restricted area we: =over 4 =item * check the size constraint =item * eventually rotate the log file =item * if it's defined, call the C function =item * write the log message =back =head1 METHODS =head2 new(%p) The constructor takes the following parameters in addition to parameters documented in L: =over 4 =item max ($) The maximum number of log files to create. Default 1. =item size ($) The maximum (or close to) size the log file can grow too. Default 10M. =item DatePattern ($) The L as defined above. =item TZ ($) The TimeZone time based calculations should be done in. This should match L's concept of timezones and of course your machines timezone. =item check_both ($) 1 for checking L and size concurrently, 0 otherwise. Default 0. =item user_constraint (\&) If this callback is defined and returns true, a rotation will happen unconditionally. =item post_rotate (\&) This callback is called after that all files were rotated. Will be called one time for every rotated file (in reverse order) with this arguments: =over 4 =item C the path of the rotated file =item C the index of the rotated file from C-1 to 0, in the latter case C is the new, empty, log file =item C a object reference to this instance =back With this, you can have infinite files renaming each time the rotated file log. E.g: my $file = Log::Dispatch::FileRotate ->new( ... post_rotate => sub { my ($filename, $idx, $fileRotate) = @_; if ($idx == 1) { use POSIX qw(strftime); my $basename = $fileRotate->filename(); my $newfilename = $basename . '.' . strftime('%Y%m%d%H%M%S', localtime()); $fileRotate->debug("moving $filename to $newfilename"); rename($filename, $newfilename); } }, ); B: this is called within the restricted area (see L). This means that any other concurrent process is locked in the meanwhile. For the same reason, don't use the C or C methods because you will get a deadlock! =item DEBUG ($) Turn on lots of warning messages to STDERR about what this module is doing if set to 1. Really only useful to me. =back =head2 filename() Returns the log filename. =head2 setDatePattern( $ or [ $, $, ... ] ) Set a new suite of recurrances for file rotation. You can pass in a single string or a reference to an array of strings. Multiple recurrences can also be define within a single string by seperating them with a semi-colon (;) See the discussion above regarding the setDatePattern paramater for more details. =head2 log_message( message => $ ) Sends a message to the appropriate output. Generally this shouldn't be called directly but should be called through the C method (in L). =head2 rotate() Rotates the file, if it has to be done. You can call this method if you want to check, and eventually do, a rotation without logging anything. Returns 1 if a rotation was done, 0 otherwise. C on error. =head2 debug($) If C is true, prints a standard warning message. =head1 Tip If you have multiple writers that were started at different times you will find each writer will try to rotate the log file at a recurrence calculated from its start time. To sync all the writers just use a config file and update it after starting your last writer. This will cause C to be called by each of the writers close to the same time, and if your recurrences aren't too close together all should sync up just nicely. I initially assumed a long running process but it seems people are using this module as part of short running CGI programs. So, now we look at the last modified time stamp of the log file and compare it to a previous occurance of a L, on startup only. If the file stat shows the mtime to be earlier than the previous recurrance then I rotate the log file. =head1 DatePattern As I said earlier we use L for generating our recurrence events. This means we can understand L's recurrence patterns and the normal log4j DatePatterns. We don't use DatePattern to define the extension of the log file though. DatePattern can therefore take forms like: Date::Manip style 0:0:0:0:5:30:0 every 5 hours and 30 minutes 0:0:0:2*12:30:0 every 2 days at 12:30 (each day) 3*1:0:2:12:0:0 every 3 years on Jan 2 at noon DailyRollingFileAppender log4j style yyyy-MM every month yyyy-ww every week yyyy-MM-dd every day yyyy-MM-dd-a every day at noon yyyy-MM-dd-HH every hour yyyy-MM-dd-HH-MM every minute To specify multiple recurrences in a single string separate them with a semicolon: yyyy-MM-dd; 0:0:0:2*12:30:0 This says we want to rotate every day AND every 2 days at 12:30. Put in as many as you like. A complete description of L recurrences is beyond us here except to quote (from the man page): A recur description is a string of the format Y:M:W:D:H:MN:S . Exactly one of the colons may optionally be replaced by an asterisk, or an asterisk may be prepended to the string. Any value "N" to the left of the asterisk refers to the "Nth" one. Any value to the right of the asterisk refers to a value as it appears on a calendar/clock. Values to the right can be listed a single values, ranges (2 numbers separated by a dash "-"), or a comma separated list of values or ranges. In a few cases, negative values are appropriate. This is best illustrated by example. 0:0:2:1:0:0:0 every 2 weeks and 1 day 0:0:0:0:5:30:0 every 5 hours and 30 minutes 0:0:0:2*12:30:0 every 2 days at 12:30 (each day) 3*1:0:2:12:0:0 every 3 years on Jan 2 at noon 0:1*0:2:12,14:0:0 2nd of every month at 12:00 and 14:00 1:0:0*45:0:0:0 45th day of every year 0:1*4:2:0:0:0 4th tuesday (day 2) of every month 0:1*-1:2:0:0:0 last tuesday of every month 0:1:0*-2:0:0:0 2nd to last day of every month =head1 TODO compression, signal based rotates, proper test suite Could possibly use L as well/instead. =head1 SEE ALSO =over 4 =item * L Log directly to timestamped files. =back =head1 HISTORY Originally written by Mark Pfeiffer, inspired by Dave Rolsky's, , code :-) Kevin Goess suggested multiple writers should be supported. He also conned me into doing the time based stuff. Thanks Kevin! :-) Thanks also to Dan Waldheim for helping with some of the locking issues in a forked environment. And thanks to Stephen Gordon for his more portable code on lockfile naming. =head1 SOURCE The development version is on github at L and may be cloned from L =head1 BUGS Please report any bugs or feature requests on the bugtracker website L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 AUTHOR Michael Schout =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2005 by Mark Pfeiffer. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut author-lockfile-race-condition.t100750001751001751 524714053462761 25023 0ustar00mschoutmschout000000000000Log-Dispatch-FileRotate-1.38/t#!/usr/bin/perl -w BEGIN { unless ($ENV{AUTHOR_TESTING}) { print qq{1..0 # SKIP these tests are for testing by the author\n}; exit } } # test case for regression where the .LCK file was unlinked in DESTROY(), # allowing multiple processes to enter the critical section at the same time. use strict; use warnings; use Path::Tiny; use IO::Handle; use Test::More; my $pid = fork; if (!defined $pid) { plan skip_all => 'fork() does not work on this platform'; } elsif ($pid == 0) { # child exit; } else { # parent waitpid $pid, 0; } plan tests => 1; use Log::Dispatch::FileRotate; shim_logit_delay(); my $tempdir = Path::Tiny->tempdir; my $warnings_file = $tempdir->child('warnings.txt')->stringify; $pid = fork; if (!defined $pid) { die "fork failed: $!\n"; } if ($pid == 0) { run_processes(); exit; } else { waitpid($pid, 0); } my $output = read_warnings($warnings_file); is $output, 'got lock:releasing lock:got lock:releasing lock:got lock:releasing lock'; # shim a delay in before logit() so that it will wait for the child process # to enter the critical section sub shim_logit_delay { no warnings 'redefine'; my $orig_logit = \&Log::Dispatch::FileRotate::logit; *Log::Dispatch::FileRotate::logit = sub { sleep 3; &$orig_logit(@_); }; } sub run_processes { open my $warnfh, '+>', $warnings_file or die "Failed to open warnings file: $!"; $warnfh->autoflush(1); $SIG{__WARN__} = sub { my $msg = shift; # we only want the "got lock" and "exiting" lines if ($msg =~ /got lock/ or $msg =~ /releasing/) { # strip off dates and pid numbers from front of message $msg = substr($msg, 25); $msg =~ s/^-?[0-9]+ //; # save in the warnings file print $warnfh $msg; } }; my $file = Log::Dispatch::FileRotate->new( filename => $tempdir->child('test.log')->stringify, min_level => 'info', DEBUG => 1); my $child1_pid = fork; if ($child1_pid == 0) { $file->log(level => 'info', message => "first_child\n"); } else { sleep 1; my $child2_pid = fork; if ($child2_pid == 0) { $file->log(level => 'info', message => "second_child\n"); } else { waitpid($child1_pid, 0); $file->log(level => 'info', message => "parent\n"); } } delete $SIG{__WARN__}; close $warnfh; } sub read_warnings { my $file = shift; local $/ = undef; open my $fh, '<', $file; my $content = <$fh>; $content =~ s/[\r\n]+$//s; $content =~ s/[\r\n]+/:/sg; return $content; } FileRotate000755001751001751 014053462761 23325 5ustar00mschoutmschout000000000000Log-Dispatch-FileRotate-1.38/lib/Log/DispatchMutex.pm100640001751001751 1030214053462761 25135 0ustar00mschoutmschout000000000000Log-Dispatch-FileRotate-1.38/lib/Log/Dispatch/FileRotate# # This file is part of Log-Dispatch-FileRotate # # This software is copyright (c) 2005 by Mark Pfeiffer. # # This is free software; you can redistribute it and/or modify it under # the same terms as the Perl 5 programming language system itself. # package Log::Dispatch::FileRotate::Mutex; $Log::Dispatch::FileRotate::Mutex::VERSION = '1.38'; # ABSTRACT: Flock Based File Mutex. use strict; use warnings; use Carp 'croak'; use Log::Dispatch::FileRotate::Flock qw(safe_flock flopen); use Fcntl ':flock'; my $HAS_THREADS = $INC{'threads.pm'} ? 1 : 0; my $THREAD_ID = $HAS_THREADS ? threads->tid() : 0; sub CLONE { $THREAD_ID = threads->tid() if $HAS_THREADS; } sub DESTROY { my $self = shift; my $pid = $self->pid; if ($self->{$pid}) { $self->unlock; close(delete $self->{_fh}); } return; } sub new { my ($class, $path, %args) = @_; $class = ref $class || $class; my $self = bless { _path => $path, %args }, $class; return $self; } sub lock { my $self = shift; my $pid = $self->pid; unless (exists $self->{$pid}) { # we have not opened the lockfile in this thread. my ($fh, $inode) = flopen($self->{_path}); $self->_set_permissions; unless (defined $fh) { return 0; } $self->{_fh} = $fh; $self->{_inode} = $inode; $self->{$pid} = 1; } elsif ($self->{$pid} == 0) { # file is open, but not locked. if (safe_flock($self->{_fh}, LOCK_EX)) { my ($inode) = (stat $self->{_path})[1]; if ($inode != $self->{_inode}) { # file was removed or changed underneath us, reopen instead delete $self->{$pid}; close(delete $self->{_fh}); delete $self->{$pid}; delete $self->{_inode}; return $self->lock; } $self->{$pid} = 1; } } # otherwise this $pid is already holding the lock return $self->{$pid} || 0; } sub _set_permissions { my $self = shift; unless (defined $self->{permissions}) { return; } my $file = $self->{_path}; my $current_mode = (stat $self->{_path})[2] & 07777; if ($current_mode ne $self->{permissions}) { chmod $self->{permissions}, $self->{_path} or croak sprintf 'Failed to chmod %s to %04o: %s', $self->{_path}, $self->{permissions} & 07777, $!; } } sub unlock { my $self = shift; my $pid = $self->pid; if ($self->{$pid}) { safe_flock($self->{_fh}, LOCK_UN); $self->{$pid} = 0; } } sub pid { return $HAS_THREADS ? join('.', $$, $THREAD_ID) : $$; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Log::Dispatch::FileRotate::Mutex - Flock Based File Mutex. =head1 VERSION version 1.38 =head1 SYNOPSIS Internal Use Only! =head1 DESCRIPTION Internal Use Only! =head1 METHODS =head2 new($path) Create a new mutex for the given file path. Only one mutex per path should be created. The path will not actually be opened or locked until you call L. =head2 lock() Obtains a lock on the path. If the thread id or pid has changed since the path was opened, the path will be re-opened automatically in this thread or process. =head2 unlock() Releases the lock if the current thread or process is holding it. =head2 pid(): string Get the current process or thread id =head1 SOURCE The development version is on github at L and may be cloned from L =head1 BUGS Please report any bugs or feature requests on the bugtracker website L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 AUTHOR Michael Schout =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2005 by Mark Pfeiffer. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Flock.pm100640001751001751 667514053462761 25073 0ustar00mschoutmschout000000000000Log-Dispatch-FileRotate-1.38/lib/Log/Dispatch/FileRotate# # This file is part of Log-Dispatch-FileRotate # # This software is copyright (c) 2005 by Mark Pfeiffer. # # This is free software; you can redistribute it and/or modify it under # the same terms as the Perl 5 programming language system itself. # package Log::Dispatch::FileRotate::Flock; $Log::Dispatch::FileRotate::Flock::VERSION = '1.38'; # ABSTRACT: File Locking Functions for L use strict; use warnings; use base 'Exporter'; use Fcntl ':flock'; our @EXPORT_OK = qw(safe_flock flopen); sub safe_flock { my ($fh, $flags) = @_; while (1) { unless (flock $fh, $flags) { # retry if we were interrupted or we are in non-blocking and the file is locked next if $!{EAGAIN} or $!{EWOULDBLOCK}; return 0; } else { return 1; } } } sub flopen { my $path = shift; my $flags = LOCK_EX; my $fh; while (1) { unless (open $fh, '>>', $path) { return; } unless (safe_flock($fh, $flags)) { return; } my @path_stat = stat $path; unless (@path_stat) { # file disappeared fron under our feet close $fh; next; } my @fh_stat = stat $fh; unless (@fh_stat) { # This should never happen return; } unless ($^O =~ /^MSWin/) { # stat on a filehandle and path return different "dev" and "rdev" # fields on windows if ($path_stat[0] != $fh_stat[0]) { # file was changed under our feet. try again; close $fh; next; } } # check that inode are the same for the path and fh if ($path_stat[1] != $fh_stat[1]) { # file was changed under our feet. try again; close $fh; next; } return ($fh, $fh_stat[1]); } } 1; __END__ =pod =encoding UTF-8 =head1 NAME Log::Dispatch::FileRotate::Flock - File Locking Functions for L =head1 VERSION version 1.38 =head1 SYNOPSIS Internal Use Only! =head2 DESCRIPTION Internal Use Only! =head1 METHODS =head2 safe_flock($filehandle, $flags): boolean This is a wrapper around C that handles things such as interruption of the call by a signal automatically. =head2 flopen($path): ($filehandle, $inode) This function is similar to BSD's C function. It opens a file, obtiains an exclusive lock on it using C, and handles a bunch of race conditions that can happen. It returns the opened filehandle and the inode of the file on success, nothing on failure. =head1 SOURCE The development version is on github at L and may be cloned from L =head1 BUGS Please report any bugs or feature requests on the bugtracker website L When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =head1 AUTHOR Michael Schout =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2005 by Mark Pfeiffer. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut