diff -Nru libfile-flock-perl-2008.01/Build.PL libfile-flock-perl-2013.11/Build.PL --- libfile-flock-perl-2008.01/Build.PL 1970-01-01 00:00:00.000000000 +0000 +++ libfile-flock-perl-2013.11/Build.PL 2013-09-17 03:54:58.000000000 +0000 @@ -0,0 +1,36 @@ +# Note: this file has been initially generated by Module::Build::Convert 0.49 + +use strict; +use warnings; + +use Module::Build; + +my $build = Module::Build->new + ( + module_name => 'File::Flock', + dist_abstract => 'Wrapper for flock() to make file locking trivial', + dist_author => 'David Muir Sharnoff ', + dist_version_from => 'lib/File/Flock.pm', + requires => { + 'AnyEvent' => 0, + 'Data::Structure::Util' => 0, + 'IO::Event' => '0.812', + 'Time::HiRes' => 0, + }, + build_requires => { + 'File::Slurp' => 0, + 'Time::HiRes' => 0, + 'Test::SharedFork' => 0, + }, + meta_merge => { + resources => { + repository => 'http://github.com/muir/File-Flock', + }, + }, + license => 'unknown', + create_readme => 1, + create_makefile_pl => 'traditional', + ); + +$build->create_build_script; + diff -Nru libfile-flock-perl-2008.01/CHANGELOG libfile-flock-perl-2013.11/CHANGELOG --- libfile-flock-perl-2008.01/CHANGELOG 2008-03-28 06:53:22.000000000 +0000 +++ libfile-flock-perl-2013.11/CHANGELOG 1970-01-01 00:00:00.000000000 +0000 @@ -1,67 +0,0 @@ -+ 2008/03/27 version 2008.01 - -Joshua Kronengold, mneme at io dot com, sent in a patch -to use IO::File instead of the $gensym hack. Applied. - -Carl Fürstenber, azatoth at gmail dot com and others -requested that license terms be spelled out. Done. - -+ 2004/11/19 - -Bugfix in &unlock for if the lock file has been removed. - -Bugfix by Vadim O. Ustiansky . - -+ 2001/06/05 - -Added $av0debug variable to note locking attempts in $0 - -+ 2001/05/18 - -Added lock_rename to the EXPORT list. - -+ 2000/09/25 - -Added tests to make sure 'nonblocking' works - -+ 1999/12/17 - -Added the lock_rename() function. - -+ 1999/06/22 - -SunOS systems seem to fail with EWOULDBLOCK on locked files. - -+ 1999/06/21 - -It appears that on some systems (HP-UX) a blocking call to flock() -can fail with EACCES instead of EAGAIN. - -+ 1999/06/15 - -Perl changes. File::Flock must change to keep up. A call to -lock() had to be changed to &lock(). Why? - -+ 1998/12/01 - -More fixes for Solaris. - -Modified the unlock() function so that it can be called as a reference. - -+ 1998/11/30 - -Fixed the object-style interface. - -Attempt to fix a double-unlock bug that makes the Linux port unhappy - -+ 1998/11/26 - -Chaged O_RDONLY to O_RDWR for all file opens because Solaris won't let -you get an exclusive lock on a read-only file. Crazy! Change suggested -by Lupe Christoph . Thanks! - -Rewrote the handling of the removal of files created just so that -they could be locked. Also tried to make sure that now file descriptors -could get leaked. - - diff -Nru libfile-flock-perl-2008.01/Changes libfile-flock-perl-2013.11/Changes --- libfile-flock-perl-2008.01/Changes 1970-01-01 00:00:00.000000000 +0000 +++ libfile-flock-perl-2013.11/Changes 2013-09-17 03:54:58.000000000 +0000 @@ -0,0 +1,95 @@ +Revision history for Perl module File::Flock + +2013.10 2013-09-16 + + - Switched from CHANGELOG to Changes + +2013.09 2013-09-11 + + - Resolve un-initialized variable $ready in Subprocess.pm + - Resolve un-initialized variable isues in Forking.pm + +2013.08 2013-04-17 + + - Removed "my $_" instances that broke older perls. + +2013.07 2013-04-09 + + - Require IO::Event version 0.812 to work around a FreeBSD issue. + +2013.06 2013-04-05 + + - Added File::Flock::Forking to auto-select between File::Flock and + File::Flock::Subprocess. + + - Added File::Flock::Subprocess for machines that don't propogate + locks across fork(). + + - POD is now after __END__ instead of __DATA__. Oops! + +2008.01 2008-03-27 + + - Joshua Kronengold, mneme at io dot com, sent in a patch + to use IO::File instead of the $gensym hack. Applied. + + - Carl Fürstenber, azatoth at gmail dot com and others + requested that license terms be spelled out. Done. + +104.111901 2004-11-19 + + - Bugfix in &unlock for if the lock file has been removed. + + - Bugfix by Vadim O. Ustiansky . + +101.060501 2001-06-05 + + - Added $av0debug variable to note locking attempts in $0 + + [2001-05-18] + + - Added lock_rename to the EXPORT list. + +100.092501 2000-09-25 + + - Added tests to make sure 'nonblocking' works + +99.121701 1999-12-17 + + - Added the lock_rename() function. + +99.062201 1999-06-22 + + - SunOS systems seem to fail with EWOULDBLOCK on locked files. + + [1999-06-21] + + - It appears that on some systems (HP-UX) a blocking call to flock() + can fail with EACCES instead of EAGAIN. + + [1999-06-15] + + - Perl changes. File::Flock must change to keep up. A call to + lock() had to be changed to &lock(). Why? + +98.120101 1998-12-01 + + - More fixes for Solaris. + + - Modified the unlock() function so that it can be called as a reference. + +98.113001 1998-11-30 + + - Fixed the object-style interface. + + - Attempt to fix a double-unlock bug that makes the Linux port unhappy + +98.112801 1998-11-26 + + - Chaged O_RDONLY to O_RDWR for all file opens because Solaris won't let + you get an exclusive lock on a read-only file. Crazy! Change suggested + by Lupe Christoph . Thanks! + + - Rewrote the handling of the removal of files created just so that + they could be locked. Also tried to make sure that now file descriptors + could get leaked. + diff -Nru libfile-flock-perl-2008.01/LICENSE libfile-flock-perl-2013.11/LICENSE --- libfile-flock-perl-2008.01/LICENSE 2008-05-24 12:26:58.000000000 +0000 +++ libfile-flock-perl-2013.11/LICENSE 1970-01-01 00:00:00.000000000 +0000 @@ -1,16 +0,0 @@ -File::Flock 104.111901 -A wrapper around the flock() call. -(C) 1998-2004 David Muir Sharnoff -All rights reserved. - -License -------- - -File::Flock is free software. You may use, modify, and -distribute it under the same terms as Perl itself, that is under the terms of -either the GNU General Public License (version 1 or later) or the Artistic -License. - -The complete text of these licenses is included in LICENSE.gpl and -LICENSE.artistic. - diff -Nru libfile-flock-perl-2008.01/LICENSE.artistic libfile-flock-perl-2013.11/LICENSE.artistic --- libfile-flock-perl-2008.01/LICENSE.artistic 2008-05-24 12:27:05.000000000 +0000 +++ libfile-flock-perl-2013.11/LICENSE.artistic 1970-01-01 00:00:00.000000000 +0000 @@ -1,131 +0,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 as specified below. - - "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 uunet.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) give non-standard executables non-standard names, and clearly - document 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. You may embed this Package's interpreter within -an executable of yours (by linking); this shall be construed as a mere -form of aggregation, provided that the complete Standard Version of the -interpreter is so embedded. - -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 whoever generated -them, and may be sold commercially, and may be aggregated with this -Package. If such scripts or library files are aggregated with this -Package via the so-called "undump" or "unexec" methods of producing a -binary executable image, then distribution of such an image shall -neither be construed as a distribution of this Package nor shall it -fall under the restrictions of Paragraphs 3 and 4, provided that you do -not represent such an executable image as a Standard Version of this -Package. - -7. C subroutines (or comparably compiled subroutines in other -languages) supplied by you and linked into this Package in order to -emulate subroutines and variables of the language defined by this -Package shall not be considered part of this Package, but are the -equivalent of input as in Paragraph 6, provided these subroutines do -not change the language in any way that would cause it to fail the -regression tests for the language. - -8. Aggregation of this Package with a commercial distribution is always -permitted provided that the use of this Package is embedded; that is, -when no overt attempt is made to make this Package's interfaces visible -to the end user of the commercial distribution. Such use shall not be -construed as a distribution of this Package. - -9. The name of the Copyright Holder may not be used to endorse or promote -products derived from this software without specific prior written permission. - -10. 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 diff -Nru libfile-flock-perl-2008.01/LICENSE.gpl libfile-flock-perl-2013.11/LICENSE.gpl --- libfile-flock-perl-2008.01/LICENSE.gpl 2008-05-24 12:27:05.000000000 +0000 +++ libfile-flock-perl-2013.11/LICENSE.gpl 1970-01-01 00:00:00.000000000 +0000 @@ -1,248 +0,0 @@ - GNU GENERAL PUBLIC LICENSE - Version 1, February 1989 - - Copyright (C) 1989 Free Software Foundation, Inc. - 59 Temple Place, Suite 330, Boston, MA 02111-1307, 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307, 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! diff -Nru libfile-flock-perl-2008.01/MANIFEST libfile-flock-perl-2013.11/MANIFEST --- libfile-flock-perl-2008.01/MANIFEST 2004-11-20 00:30:36.000000000 +0000 +++ libfile-flock-perl-2013.11/MANIFEST 2013-09-17 03:54:58.000000000 +0000 @@ -1,7 +1,22 @@ +Build.PL +Changes +lib/File/Flock.pm +lib/File/Flock/Forking.pm +lib/File/Flock/Subprocess.pm MANIFEST -CHANGELOG -Makefile.PL +MYMETA.yml +MYMETA.json README -lib/File/Flock.pm +t/auto.t +t/auto2.t t/flock.t -META.yml Module meta-data (added by MakeMaker) +t/flock.tt +t/flock2.t +t/flock2.tt +t/forking.t +t/forking2.t +t/subprocess.t +t/subprocess2.t +t/wrap.tm +META.yml +Makefile.PL diff -Nru libfile-flock-perl-2008.01/META.yml libfile-flock-perl-2013.11/META.yml --- libfile-flock-perl-2008.01/META.yml 2008-03-28 06:53:27.000000000 +0000 +++ libfile-flock-perl-2013.11/META.yml 2013-09-17 03:54:58.000000000 +0000 @@ -1,10 +1,36 @@ -# http://module-build.sourceforge.net/META-spec.html -#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# -name: File-Flock -version: 2008.01 -version_from: lib/File/Flock.pm -installdirs: site +--- +abstract: 'Wrapper for flock() to make file locking trivial' +author: + - 'David Muir Sharnoff ' +build_requires: + File::Slurp: 0 + Test::SharedFork: 0 + Time::HiRes: 0 +configure_requires: + Module::Build: 0.36 +generated_by: 'Module::Build version 0.3603' +license: unknown +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: 1.4 +name: File-Flock +provides: + File::Flock: + file: lib/File/Flock.pm + version: 2013.11 + File::Flock::Forking: + file: lib/File/Flock/Forking.pm + File::Flock::Subprocess: + file: lib/File/Flock/Subprocess.pm + File::Flock::Subprocess::Connections: + file: lib/File/Flock/Subprocess.pm + File::Flock::Subprocess::Master: + file: lib/File/Flock/Subprocess.pm requires: - -distribution_type: module -generated_by: ExtUtils::MakeMaker version 6.30_01 + AnyEvent: 0 + Data::Structure::Util: 0 + IO::Event: 0.812 + Time::HiRes: 0 +resources: + repository: http://github.com/muir/File-Flock +version: 2013.11 diff -Nru libfile-flock-perl-2008.01/MYMETA.json libfile-flock-perl-2013.11/MYMETA.json --- libfile-flock-perl-2008.01/MYMETA.json 1970-01-01 00:00:00.000000000 +0000 +++ libfile-flock-perl-2013.11/MYMETA.json 2013-09-17 03:54:58.000000000 +0000 @@ -0,0 +1,67 @@ +{ + "abstract" : "Wrapper for flock() to make file locking trivial", + "author" : [ + "David Muir Sharnoff " + ], + "dynamic_config" : 0, + "generated_by" : "Module::Build version 0.3603, CPAN::Meta::Converter version 2.112150", + "license" : [ + "unknown" + ], + "meta-spec" : { + "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", + "version" : "2" + }, + "name" : "File-Flock", + "prereqs" : { + "build" : { + "requires" : { + "ExtUtils::MakeMaker" : 0 + } + }, + "configure" : { + "requires" : { + "Module::Build" : "0.36" + } + }, + "runtime" : { + "requires" : { + "AnyEvent" : 0, + "Data::Structure::Util" : 0, + "File::Slurp" : 0, + "IO::Event" : "0.812", + "Test::SharedFork" : 0, + "Time::HiRes" : 0 + } + } + }, + "provides" : { + "File::Flock" : { + "file" : "lib/File/Flock.pm", + "version" : "2013.1" + }, + "File::Flock::Forking" : { + "file" : "lib/File/Flock/Forking.pm", + "version" : 0 + }, + "File::Flock::Subprocess" : { + "file" : "lib/File/Flock/Subprocess.pm", + "version" : 0 + }, + "File::Flock::Subprocess::Connections" : { + "file" : "lib/File/Flock/Subprocess.pm", + "version" : 0 + }, + "File::Flock::Subprocess::Master" : { + "file" : "lib/File/Flock/Subprocess.pm", + "version" : 0 + } + }, + "release_status" : "stable", + "resources" : { + "repository" : { + "url" : "http://github.com/muir/File-Flock" + } + }, + "version" : "2013.1" +} diff -Nru libfile-flock-perl-2008.01/MYMETA.yml libfile-flock-perl-2013.11/MYMETA.yml --- libfile-flock-perl-2008.01/MYMETA.yml 1970-01-01 00:00:00.000000000 +0000 +++ libfile-flock-perl-2013.11/MYMETA.yml 2013-09-17 03:54:58.000000000 +0000 @@ -0,0 +1,37 @@ +--- +abstract: 'Wrapper for flock() to make file locking trivial' +author: + - 'David Muir Sharnoff ' +build_requires: + File::Slurp: 0 + Test::SharedFork: 0 + Time::HiRes: 0 +configure_requires: + Module::Build: 0.36 +dynamic_config: 0 +generated_by: 'Module::Build version 0.3603' +license: unknown +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: 1.4 +name: File-Flock +provides: + File::Flock: + file: lib/File/Flock.pm + version: 2013.11 + File::Flock::Forking: + file: lib/File/Flock/Forking.pm + File::Flock::Subprocess: + file: lib/File/Flock/Subprocess.pm + File::Flock::Subprocess::Connections: + file: lib/File/Flock/Subprocess.pm + File::Flock::Subprocess::Master: + file: lib/File/Flock/Subprocess.pm +requires: + AnyEvent: 0 + Data::Structure::Util: 0 + IO::Event: 0.812 + Time::HiRes: 0 +resources: + repository: http://github.com/muir/File-Flock +version: 2013.10 diff -Nru libfile-flock-perl-2008.01/Makefile.PL libfile-flock-perl-2013.11/Makefile.PL --- libfile-flock-perl-2008.01/Makefile.PL 1998-11-27 22:44:44.000000000 +0000 +++ libfile-flock-perl-2013.11/Makefile.PL 2013-09-17 03:54:58.000000000 +0000 @@ -1,12 +1,19 @@ - +# Note: this file was auto-generated by Module::Build::Compat version 0.3603 use ExtUtils::MakeMaker; - -WriteMakefile( - 'VERSION_FROM' => 'lib/File/Flock.pm', - 'NAME' => 'File::Flock', - 'dist' => { COMPRESS=>"gzip", SUFFIX=>"gz" }, - ($] >= 5.005 ? - ('ABSTRACT' => 'Wrapper for flock() to make file locking trivial', - 'AUTHOR' => 'David Muir Sharnoff ') : ()), - ); - +WriteMakefile +( + 'NAME' => 'File::Flock', + 'VERSION_FROM' => 'lib/File/Flock.pm', + 'PREREQ_PM' => { + 'AnyEvent' => 0, + 'Data::Structure::Util' => 0, + 'File::Slurp' => 0, + 'IO::Event' => '0.812', + 'Test::SharedFork' => 0, + 'Time::HiRes' => 0 + }, + 'INSTALLDIRS' => 'site', + 'EXE_FILES' => [], + 'PL_FILES' => {} + ) +; diff -Nru libfile-flock-perl-2008.01/README libfile-flock-perl-2013.11/README --- libfile-flock-perl-2008.01/README 1996-11-18 09:02:23.000000000 +0000 +++ libfile-flock-perl-2013.11/README 2013-09-17 03:54:58.000000000 +0000 @@ -1,18 +1,59 @@ +NAME + File::Flock - file locking with flock -File::Flock is a wrapper around the flock() call. The only thing it -does that is special is that it creates the lock file if the lock file -does not already exist. - -It will also try to remove the lock file. This makes it a bit -complicated. - -To install File::Flock use the following: - - perl Makefile.PL - make - make test - make install +SYNOPSIS + use File::Flock; -Under perl5.002, the make test will emit some warnings about "9" and -"99" not being numeric values. I believe this is a bug in perl. + lock($filename); + + lock($filename, 'shared'); + + lock($filename, undef, 'nonblocking'); + + lock($filename, 'shared', 'nonblocking'); + + unlock($filename); + + lock_rename($oldfilename, $newfilename) + + my $lock = new File::Flock '/somefile'; + + $lock->unlock(); + + $lock->lock_rename('/new/file'); + + forget_locks(); + +DESCRIPTION + Lock files using the flock() call. If the file to be locked does not + exist, then the file is created. If the file was created then it will be + removed when it is unlocked assuming it's still an empty file. + + Locks can be created by new'ing a File::Flock object. Such locks are + automatically removed when the object goes out of scope. The unlock() + method may also be used. + + lock_rename() is used to tell File::Flock when a file has been renamed + (and thus the internal locking data that is stored based on the filename + should be moved to a new name). unlock() the new name rather than the + original name. + + Locks are released on process exit when the process that created the + lock exits. Subprocesses that exit do not remove locks. Use + forget_locks() or POSIX::_exit() to prevent unlocking on process exit. + +SEE ALSO + See File::Flock::Subprocess for a variant that uses a subproess to hold + the locks so that the locks survive when the parent process forks. See + File::Flock::Forking for a way to automatically choose between + File::Flock and File::Flock::Subprocess. + +LICENSE + Copyright (C) 1996-2012 David Muir Sharnoff + Copyright (C) 2013 Google, Inc. This module may be used/copied/etc on + the same terms as Perl itself. + +PACKAGERS + File::Flock is packaged for Fedora by Emmanuel Seyman + . diff -Nru libfile-flock-perl-2008.01/debian/changelog libfile-flock-perl-2013.11/debian/changelog --- libfile-flock-perl-2008.01/debian/changelog 2013-10-22 07:29:26.000000000 +0000 +++ libfile-flock-perl-2013.11/debian/changelog 2013-10-01 18:51:02.000000000 +0000 @@ -1,8 +1,25 @@ -libfile-flock-perl (2008.01-1fakesync1) natty; urgency=low +libfile-flock-perl (2013.11-1) unstable; urgency=low - * Fake sync due to mismatching orig tarball. + [ Marc Haber ] + * set Maintainer to Debian Perl Group, myself as uploader, add Vcs-* - -- Bhavani Shankar Fri, 19 Nov 2010 10:02:02 +0530 + [ Ansgar Burchardt ] + * debian/control: Convert Vcs-* fields to Git. + + [ Salvatore Bonaccorso ] + * Change search.cpan.org based URIs to metacpan.org based URIs + + [ gregor herrmann ] + * New upstream release. + * Switch to "3.0 (quilt)" source format. + * Don't install README anymore, just a text version of the POD. + * debian/copyright: switch formatting to Copyright-Format 1.0. + * Bump debhelper compatibility level to 8. + * Add new build and runtime dependencies. + * Add /me to Uploaders. + * Declare compliance with Debian Policy 3.9.4. + + -- gregor herrmann Tue, 01 Oct 2013 20:50:40 +0200 libfile-flock-perl (2008.01-1) unstable; urgency=low diff -Nru libfile-flock-perl-2008.01/debian/compat libfile-flock-perl-2013.11/debian/compat --- libfile-flock-perl-2008.01/debian/compat 2013-10-22 07:29:26.000000000 +0000 +++ libfile-flock-perl-2013.11/debian/compat 2013-10-01 18:51:02.000000000 +0000 @@ -1 +1 @@ -7 +8 diff -Nru libfile-flock-perl-2008.01/debian/control libfile-flock-perl-2013.11/debian/control --- libfile-flock-perl-2008.01/debian/control 2013-10-22 07:29:26.000000000 +0000 +++ libfile-flock-perl-2013.11/debian/control 2013-10-01 18:51:02.000000000 +0000 @@ -1,16 +1,28 @@ Source: libfile-flock-perl +Maintainer: Debian Perl Group +Uploaders: Marc Haber , + gregor herrmann Section: perl Priority: optional -Build-Depends: debhelper (>= 7) -Build-Depends-Indep: perl -Maintainer: Ubuntu Developers -XSBC-Original-Maintainer: Marc Haber -Standards-Version: 3.9.1 -Homepage: http://search.cpan.org/dist/File-Flock/ +Build-Depends: debhelper (>= 8) +Build-Depends-Indep: perl, + libanyevent-perl, + libdata-structure-util-perl, + libfile-slurp-perl, + libio-event-perl, + libtest-sharedfork-perl +Standards-Version: 3.9.4 +Vcs-Browser: http://anonscm.debian.org/gitweb/?p=pkg-perl/packages/libfile-flock-perl.git +Vcs-Git: git://anonscm.debian.org/pkg-perl/packages/libfile-flock-perl.git +Homepage: https://metacpan.org/release/File-Flock/ Package: libfile-flock-perl Architecture: all -Depends: ${misc:Depends}, ${perl:Depends} +Depends: ${misc:Depends}, + ${perl:Depends}, + libanyevent-perl, + libdata-structure-util-perl, + libio-event-perl Description: file locking with flock Lock files using the flock() call. Locks can be created by new'ing a File::Flock object and are automatically removed when the object goes diff -Nru libfile-flock-perl-2008.01/debian/copyright libfile-flock-perl-2013.11/debian/copyright --- libfile-flock-perl-2008.01/debian/copyright 2013-10-22 07:29:26.000000000 +0000 +++ libfile-flock-perl-2013.11/debian/copyright 2013-10-01 18:51:02.000000000 +0000 @@ -1,25 +1,26 @@ -Format-Specification: http://svn.debian.org/wsvn/dep/web/deps/dep5.mdwn?op=file&rev=135 -Maintainer: David Muir Sharnoff -Source: http://search.cpan.org/dist/File-Flock/ -Name: File-Flock - +Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ +Source: https://metacpan.org/release/File-Flock +Upstream-Contact: David Muir Sharnoff +Upstream-Name: File-Flock X-Packaging: Done in November 2010 by Marc Haber, aided by dh-make-perl Files: * -Copyright: David Muir Sharnoff +Copyright: 1996-2012, David Muir Sharnoff + 2013, Google, Inc. License: Artistic or GPL-1+ Files: debian/* Copyright: 2010, Marc Haber + 2013, gregor herrmann License: Artistic or GPL-1+ License: Artistic This program is free software; you can redistribute it and/or modify it under the terms of the Artistic License, which comes with Perl. . - On Debian GNU/Linux systems, the complete text of the Artistic License - can be found in `/usr/share/common-licenses/Artistic'. + On Debian systems, the complete text of the Artistic License can be + found in `/usr/share/common-licenses/Artistic'. License: GPL-1+ This program is free software; you can redistribute it and/or modify @@ -27,5 +28,5 @@ the Free Software Foundation; either version 1, or (at your option) any later version. . - On Debian GNU/Linux systems, the complete text of version 1 of the - General Public License can be found in `/usr/share/common-licenses/GPL-1'. + On Debian systems, the complete text of version 1 of the GNU General + Public License can be found in `/usr/share/common-licenses/GPL-1'. diff -Nru libfile-flock-perl-2008.01/debian/libfile-flock-perl.docs libfile-flock-perl-2013.11/debian/libfile-flock-perl.docs --- libfile-flock-perl-2008.01/debian/libfile-flock-perl.docs 2013-10-22 07:29:26.000000000 +0000 +++ libfile-flock-perl-2013.11/debian/libfile-flock-perl.docs 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -README diff -Nru libfile-flock-perl-2008.01/debian/source/format libfile-flock-perl-2013.11/debian/source/format --- libfile-flock-perl-2008.01/debian/source/format 1970-01-01 00:00:00.000000000 +0000 +++ libfile-flock-perl-2013.11/debian/source/format 2013-10-22 07:29:27.132565265 +0000 @@ -0,0 +1 @@ +3.0 (quilt) diff -Nru libfile-flock-perl-2008.01/debian/watch libfile-flock-perl-2013.11/debian/watch --- libfile-flock-perl-2008.01/debian/watch 2013-10-22 07:29:26.000000000 +0000 +++ libfile-flock-perl-2013.11/debian/watch 2013-10-01 18:51:02.000000000 +0000 @@ -1,2 +1,2 @@ version=3 -http://search.cpan.org/dist/File-Flock/ .*/File-Flock-v?(\d[\d.-]+)\.(?:tar(?:\.gz|\.bz2)?|tgz|zip)$ +https://metacpan.org/release/File-Flock/ .*/File-Flock-v?(\d[\d.-]+)\.(?:tar(?:\.gz|\.bz2)?|tgz|zip)$ diff -Nru libfile-flock-perl-2008.01/lib/File/Flock/Forking.pm libfile-flock-perl-2013.11/lib/File/Flock/Forking.pm --- libfile-flock-perl-2008.01/lib/File/Flock/Forking.pm 1970-01-01 00:00:00.000000000 +0000 +++ libfile-flock-perl-2013.11/lib/File/Flock/Forking.pm 2013-09-17 03:54:58.000000000 +0000 @@ -0,0 +1,59 @@ + +package File::Flock::Forking; + +require Exporter; +@ISA = qw(Exporter); + +use strict; +use Config; + +die "Import File::Flock::Forking before importing File::Flock" + if defined $File::Flock::VERSION; + +if ((!$Config{d_flock} && ! ($ENV{FLOCK_FORKING_USE} || '') eq 'flock') + || (($ENV{FLOCK_FORKING_USE} || '') eq 'subprocess')) +{ + $File::Flock::Forking::SubprocessEnabled = 1; + require File::Flock::Subprocess; +} + +1; + +__END__ + +=head1 NAME + + File::Flock::Forking - adjust File::Flock to handle fork() + +=head1 SYNOPSIS + + use File::Flock::Forking; + use File::Flock; + +=head1 DESCRIPTION + +The purpose of File::Flock::Forking is to change the implementation +of L to handle locking on systems that do not hold +locks across calls to fork(). + +If you are using L or any module that uses L +then and your program uses fork(), then you should import +File::Flock::Forking before you import L or any module that +uses L. + +On most operating systems, File::Flock::Forking does nothing. On +Solaris, it changes the behavior of L to be implemented +by L. + +You can also force it to use L by with + + $ENV{FLOCK_FORKING_USE} = 'subprocess' + +Or force it to use L with + + $ENV{FLOCK_FORKING_USE} = 'flock' + +=head1 LICENSE + +Copyright (C) 2013 Google, Inc. +This module may be used/copied/etc on the same terms as Perl itself. diff -Nru libfile-flock-perl-2008.01/lib/File/Flock/Subprocess.pm libfile-flock-perl-2013.11/lib/File/Flock/Subprocess.pm --- libfile-flock-perl-2008.01/lib/File/Flock/Subprocess.pm 1970-01-01 00:00:00.000000000 +0000 +++ libfile-flock-perl-2013.11/lib/File/Flock/Subprocess.pm 2013-09-17 03:54:58.000000000 +0000 @@ -0,0 +1,552 @@ + +package File::Flock::Subprocess; + +@ISA = qw(Exporter); +@EXPORT = qw(lock unlock lock_rename forget_lock); + +# use Smart::Comments; +use strict; +use warnings; +require Exporter; +require POSIX; +use Socket; +use IO::Handle; +use Time::HiRes qw(sleep time); +use Carp; +use File::Temp qw(tempdir); +use IO::Socket::UNIX; +use Data::Structure::Util qw(unbless); + +# shared +my $dir; +my $socket; +my $av0; +my $debug; + +BEGIN { $debug = 0; } + +# proxy server +my $connections; +my $parent_pid; +my $timer; +my $ioe_parent; +my $counter = '0001'; +my %locks; + +# client side +my $child; +my %lock_pids; # filename -> pid +my %lock_proxies; # pid -> proxy +my %lock_count; # pid -> count +my $last_pid; + +sub new +{ + my ($pkg, $file, $shared, $nonblocking) = @_; + &lock($file, $shared, $nonblocking) or return undef; + return bless [$file], __PACKAGE__; +} + +sub DESTROY +{ + my ($this) = @_; + unlock($this->[0]); +} + +sub encode +{ + local($_); + for $_ (@_) { + ### assert: defined $_ + s/\\/\\\\/g; + s/\n/\\n/g; + s/\t/\\t/g; + } +} + +sub decode +{ + local($_); + for $_ (@_) { + ### assert: defined $_ + s/\\t/\t/g; + s/\\n/\n/g; + s/\\\\/\\/g; + } +} + +sub update_proxy_connections +{ +use Carp qw(longmess); + print STDERR longmess("last_pid undefined") unless defined $last_pid; + return if $last_pid == $$; + ### UPDATING PROXY CONNECTIONS: "$$ IS NOT $last_pid" + $last_pid = $$; + for my $pid (keys %lock_proxies) { + my $proxy = IO::Socket::UNIX->new( + Peer => "$socket.$pid", + Type => SOCK_STREAM, + ) or carp "Could not open connection to lockserver $socket.$pid: $!"; + + ### CLOSING OLD $$ + $lock_proxies{$pid}->close(); + $lock_proxies{$pid} = $proxy; + } + ### DONE UPDATING: $$ +} + +sub request +{ + my ($request, $file) = @_; + my $av0 = $0; + local($0) = $av0; + $0 = "$av0 - lock proxy request $request"; + my $ts_before = time; + ### REQUEST: "$$ $request" + + my $proxy = $lock_proxies{$lock_pids{$file}} or die; + + $proxy->print("$$ $request\n") + or croak "print to lock proxy: $!"; + for(;;) { + my $ok = $proxy->getline(); + chomp($ok); + ### RESPONSE: $ok + if ($ts_before) { + my $diff = time - $ts_before; + } + if ($ok =~ /^ERROR:(.*)/) { + my $error = $1; + decode($error); + ### ................. $error + $error =~ s/\n.*//s; + ### ..... $error + croak $error; + } elsif ($ok =~ /^RESULT=(\d+)/) { + ### RESULT: $$.$1 + return $1; + } else { + die "unexpected response from lock proxy: $ok"; + } + } +} + +sub lock +{ + my ($file, $shared, $nonblocking) = @_; + + update_proxy_connections(); + + if (!$lock_pids{$file}) { + $lock_pids{$file} = $$; + $lock_count{$$}++; + } + if (!$lock_proxies{$$}) { + $lock_proxies{$$} = IO::Socket::UNIX->new( + Peer => $socket, + Type => SOCK_STREAM, + ) or carp "Could not open connection to lockserver $socket: $!"; + + request("LISTEN", $file); + } + + $shared = $shared ? "1" : "0"; + $nonblocking = $nonblocking ? "1" : "0"; + my $orig_file = $file; + encode($file); + my $r = request("LOCK $shared$nonblocking $file", $file); + $locks{$orig_file} = $$ if $r; + return $r; +} + +sub unlock +{ + my ($file) = @_; + + if (ref $file eq __PACKAGE__) { + unbless $file; # avoid destructor later + $file = $file->[0]; + } + + update_proxy_connections(); + + if (ref $file eq 'File::Flock') { + bless $file, 'UNIVERSAL'; # avoid destructor later + $file = $$file; + } + croak "File $file not locked" unless $lock_pids{$file}; + my $orig_file = $file; + encode($file); + my $r = request("UNLOCK $file", $file); + my $lock_pid = delete $lock_pids{$orig_file}; + if ($lock_count{$lock_pid} <= 0) { + delete $lock_proxies{$lock_pid}; + } + delete $locks{$orig_file}; + return $r; +} + +sub lock_rename +{ + croak "arguments to lock_rename" unless @_ == 2; + my ($oldfile, $newfile) = @_; + + if (ref $oldfile eq 'File::Flock::Subprocess') { + my $obj = $oldfile; + $oldfile = $obj->[0]; + $obj->[0] = $newfile; + } + + update_proxy_connections(); + + carp "File $oldfile not locked" unless $lock_pids{$oldfile}; + carp "File $newfile already locked" if $lock_pids{$newfile}; + my ($orig_oldfile, $orig_newfile) = ($oldfile, $newfile); + encode($oldfile, $newfile); + my $r = request("LOCK_RENAME $oldfile\t$newfile", $oldfile); + $lock_pids{$orig_newfile} = delete $lock_pids{$orig_oldfile}; + $locks{$orig_newfile} = delete $locks{$orig_oldfile} if exists $locks{$orig_oldfile}; + return $r; +} + +sub forget_locks +{ + %locks = (); +} + +sub final_cleanup +{ + for (keys %locks) { + unlock($_) if $locks{$_} == $$; + } + $child->close() if defined $child; + undef $child; + undef %lock_proxies; +} + +END { + final_cleanup(); +} + +sub run_lockserver +{ + my ($parent) = @_; + require IO::Event; + import IO::Event 'AnyEvent'; + + my $ioe_listener = IO::Event::Socket::UNIX->new( + Type => SOCK_STREAM, + Local => $socket, + Listen => 255, + Handler => 'File::Flock::Subprocess::Master', + Description => "listen($socket)", + ); + carp "could not listen on unix socket: $!" unless $ioe_listener; + + # we don't add a connection for the listener + + $parent->print("ready\n"); + + $ioe_parent = IO::Event->new($parent, __PACKAGE__, + { description => 'socketpair', read_only => 1}); + + $connections->add($ioe_parent); + + if ($debug) { + $timer = IO::Event->timer( + interval => 2, + cb => sub { $connections->display() }, + ); + } + + IO::Event::loop(); + + File::Flock::final_cleanup_flock(); +} + +{ + package File::Flock::Subprocess::Master; + use strict; + use warnings; + + # lock proxy master accepting connection to start new child + sub ie_connection + { + my ($pkg, $ioe) = @_; + my $client = $ioe->accept('File::Flock::Subprocess') or die; + ### CONNECT IN MASTER: "$$ - @{[$ioe->ie_desc()]}" + my $new_child; + for(;;) { + $new_child = fork(); + ### FORKED IN ACCEPT + ### PID: $$ + ### CHILD: $new_child + last if defined $new_child; + warn "Could not fork: $!"; + sleep(1); + } + if ($new_child) { + # now is as good a time as any to clean up zombies + my $kid; + do { + $kid = waitpid(-1, &POSIX::WNOHANG); + ### CHILD PROXY ZOMBIE REAPED: $kid + } while $kid > 0; + $client->close(); + } else { + $ioe->close(); + $connections->remove($ioe_parent); + $ioe_parent->close(); + undef $ioe_parent; + ### NEW CHILD PROXY SERVER $$ + $av0 = "Locking proxy slave for $parent_pid using $socket"; + $connections->add($client, "connection($socket)"); + } + } + sub ie_input { + die; + } + sub ie_eof { + die; + } +} + +# lock proxy children accepting replacement connections +sub ie_connection +{ + my ($pkg, $ioe) = @_; + my $replacement = $ioe->accept(); + $connections->add($replacement, "slave(@{[$ioe->ie_desc().$counter++]})"); +} + +# could be lock server master losing socketpair or lock server +# proxy child losing a client +sub ie_eof +{ + ### EOF IN CHILD + my ($handler, $ioe, $input_buffer_reference) = @_; + $ioe->close(); + unless ($connections->remove($ioe)) { + ### "PROXY SERVER $$ ALL DONE" + IO::Event::unloop_all(); + } +} + +sub ie_input +{ + ### INPUT IN CHILD + my ($handler, $ioe, $input_buffer_reference) = @_; + $0 = "$av0: processing request"; + while (my $request = $ioe->getline()) { + $0 = "$av0: handling $request"; + + my $pid; + $request =~ s/^(\d+) // + or die "bad request to lock proxy: $request"; + $pid = $1; + $0 = "$av0: handling $request from $pid: $request"; + + my $r; + ### PROCESSING REQUEST FROM $pid : $request + eval { + if ($request =~ m{^LOCK (.)(.) (.*)\n}s) { + my ($shared, $nonblocking, $file) = ($1, $2, $3); + decode($file); + $r = File::Flock::lock_flock($file, $shared, $nonblocking); + } elsif ($request =~ m{^UNLOCK (.*)\n}s) { + my $file = $1; + decode($file); + $r = File::Flock::unlock_flock($file); + } elsif ($request =~ m{^LOCK_RENAME (.*?)\t(.*)\n}) { + my ($oldfile, $newfile) = ($1, $2); + decode($oldfile, $newfile); + $r = File::Flock::lock_rename_flock($oldfile, $newfile); + } elsif ($request =~ m{^LISTEN\n}) { + IO::Event::Socket::UNIX->new( + Type => SOCK_STREAM, + Local => "$socket.$pid", + Listen => 255, + Description => "slave($socket.$pid)", + ) or die "Listen $socket.$pid: $!"; + $r = 1; + } elsif ($request =~ m{^QUIT\n}) { + $r = 1; + } else { + die "Unknown remote lock request: $request"; + } + }; + if ($@) { + my $error = $@; + encode($error); + $ioe->print("ERROR:$error\n"); + } else { + $r = 0 + $r; + $ioe->print("RESULT=$r\n"); + } + $0 = "$av0: idle"; + } +} + +{ + package File::Flock::Subprocess::Connections; + + use strict; + use warnings; + + sub new { + return bless {}; + } + sub add { + my ($self, $ioe, $label) = @_; + $ioe->ie_desc($label) if $label; + die "duplicate @{[$ioe->ie_desc()]}" if ++$self->{$ioe->ie_desc()} > 1; + print STDERR "PROXY $$: " . join(' ', 'ADD', $ioe->ie_desc(), ':', sort keys %$self) . "\n" if $debug; + } + sub remove + { + my ($self, $ioe) = @_; + die $ioe unless $self->{$ioe->ie_desc()}; + delete $self->{$ioe->ie_desc()};; + print STDERR "PROXY $$: " . join(' ', 'REMOVE', $ioe->ie_desc(), ':', sort keys %$self) . "\n" if $debug; + return scalar(keys %$self); + } + sub display { + my ($self) = @_; + print STDERR "PROXY $$: " . join(' ', sort keys %$self) . "\n" if $debug; + } +} + + +BEGIN { + # Let File::Flock know we're live with Subprocess + $File::Flock::Forking::SubprocessEnabled = 1; + require File::Flock; + + $dir = tempdir(CLEANUP => 0); + $socket = "$dir/lock"; + + my $parent = new IO::Handle; + $child = new IO::Handle; + socketpair($parent, $child, AF_UNIX, SOCK_STREAM, PF_UNSPEC) + or die "cannot create socketpair: $!"; + + $parent_pid = $$; + my $child_pid; + ### FORKING: $$ + for(;;) { + $child_pid = fork(); + ### CHILD: $child_pid + last if defined $child_pid; + warn "Could not fork: $!"; + sleep(1); + } + if ($child_pid) { + $parent->close(); + my $ready = <$child>; + die unless $ready && $ready eq "ready\n"; + $last_pid = $$; + + # We need File::Flock->new() to work. This is a bit gross: + *File::Flock::new = \&File::Flock::Subprocess::new + unless defined &File::Flock::new; + + if ($debug) { + $SIG{ALRM} = sub { + print STDERR "$$ Alive with " . ($child ? "child defined" : "child undefined") . "\n"; + alarm(2); + }; + alarm(2); + } + } else { + require IO::Event; + $av0 = "Locking proxy master for $parent_pid, using $socket"; + $0 = $av0; + $child->close(); + undef $child; + + $connections = File::Flock::Subprocess::Connections->new(); + + run_lockserver($parent); + + POSIX::_exit(0); + die; + + } +} + +1; + +__END__ + +Implementation notes. + +We're trying to mimic the bahavior of locking on systems that +preserve locks across fork(). + +We create connections to the proxy server as needed. When we make +such connections, we record (with the connection) our current process +PID. + +Whenever we have a new lock()/unlock()/lock_rename() request, we check +to see if we're still the same process we used to be. If not, we +re-open connections to the lock proxies. This way connections aren't +shared with child processes. + + + +=head1 NAME + + File::Flock::Subprocess - file locking with flock in a subprocess + +=head1 SYNOPSIS + + use File::Flock::Subprocess; + + lock($filename); + + lock($filename, 'shared'); + + lock($filename, undef, 'nonblocking'); + + lock($filename, 'shared', 'nonblocking'); + + unlock($filename); + + lock_rename($oldfilename, $newfilename) + + my $lock = new File::Flock '/somefile'; + + $lock->unlock(); + + $lock->lock_rename('/new/file'); + + forget_locks(); + +=head1 DESCRIPTION + +This is a wrapper around L that starts a subprocess and +does the lcoking in the subprocess with L. The purpose of +this is to handle operating systems (eg: Solaris) that do not retain +locks across a call to fork(). + +The sub-process for this is created with fork() when +File::Flock::Subprocess is compiled. I've tried to minimize the +side-effects calling fork() by doing calling it early and by using +POSIX::_exit() to quit but it is still worth being aware of. I suggest +loading File::Flock::Subprocess early. + +Use L to automatically detect when this is needed. + +Read the docs for L for details of the API. + +=head1 ERRATA + +Any errors reported by the locking proxy File::Flock::Subprocess starts +will be reported as "Compilation Failed" errors because the proxy is +started in a BEGIN{} block. + +=head1 LICENSE + +Copyright (C) 2013 Google, Inc. +This module may be used/copied/etc on the same terms as Perl itself. + diff -Nru libfile-flock-perl-2008.01/lib/File/Flock.pm libfile-flock-perl-2013.11/lib/File/Flock.pm --- libfile-flock-perl-2008.01/lib/File/Flock.pm 2008-03-28 06:45:25.000000000 +0000 +++ libfile-flock-perl-2013.11/lib/File/Flock.pm 2013-09-17 03:54:58.000000000 +0000 @@ -1,20 +1,20 @@ -# Copyright (C) 1996, 1998 David Muir Sharnoff package File::Flock; require Exporter; @ISA = qw(Exporter); -@EXPORT = qw(lock unlock lock_rename); +@EXPORT = qw(lock unlock lock_rename forget_locks); use Carp; use POSIX qw(EAGAIN EACCES EWOULDBLOCK ENOENT EEXIST O_EXCL O_CREAT O_RDWR); use Fcntl qw(LOCK_SH LOCK_EX LOCK_NB LOCK_UN); use IO::File; +use Data::Structure::Util qw(unbless); use vars qw($VERSION $debug $av0debug); BEGIN { - $VERSION = 2008.01; + $VERSION = 2013.11; $debug = 0; $av0debug = 0; } @@ -28,20 +28,19 @@ my %pid; my %rm; -sub new -{ +sub new_flock { my ($pkg, $file, $shared, $nonblocking) = @_; - &lock($file, $shared, $nonblocking) or return undef; - return bless \$file, $pkg; + lock_flock($file, $shared, $nonblocking) or return undef; + return bless [$file], $pkg; } sub DESTROY { my ($this) = @_; - unlock($$this); + unlock_flock($this->[0]); } -sub lock +sub lock_flock { my ($file, $shared, $nonblocking) = @_; @@ -101,7 +100,7 @@ # oh well, try again flock($f, LOCK_UN); close($f); - return File::Flock::lock($file); + return lock_flock($file); } return 1 if $r; @@ -150,13 +149,13 @@ } } -sub unlock +sub unlock_flock { my ($file) = @_; if (ref $file eq 'File::Flock') { - bless $file, 'UNIVERSAL'; # avoid destructor later - $file = $$file; + unbless $file; # avoid destructor later + $file = $file->[0]; } croak "no lock on $file" unless exists $locks{$file}; @@ -193,12 +192,18 @@ return 1; } -sub lock_rename +sub lock_rename_flock { + croak "arguments to lock_rename" unless @_ == 2; my ($oldfile, $newfile) = @_; + if (ref $oldfile eq 'File::Flock') { + my $obj = $oldfile; + $oldfile = $obj->[0]; + $obj->[0] = $newfile; + } if (exists $locks{$newfile}) { - unlock $newfile; + unlock_flock($newfile); } delete $locks{$newfile}; delete $shared{$newfile}; @@ -217,16 +222,29 @@ delete $pid{$oldfile}; delete $lockHandle{$oldfile}; delete $rm{$oldfile}; + + return 1; +} + +sub forget_locks_flock +{ + %locks = (); + %shared = (); + %pid = (); + %lockHandle = (); + %rm = (); } # # Unlock any files that are still locked and remove any files # that were created just so that they could be locked. # -END { + +sub final_cleanup_flock +{ my $f; for $f (keys %locks) { - &unlock($f) + unlock_flock($f) if $pid{$f} == $$; } @@ -272,11 +290,41 @@ waitpid($ppid, 0); kill(9, $$); # exit w/o END or anything else } + + %locks = (); + %lockHandle = (); + %shared = (); + %pid = (); + %rm = (); + %bgrm = (); +} + +END { + final_cleanup(); +} + +BEGIN { + if ($File::Flock::Forking::SubprocessEnabled) { + require File::Flock::Subprocess; + *new = *File::Flock::Subprocess::new; + *final_cleanup = *File::Flock::Subprocess::final_cleanup; + *lock = *File::Flock::Subprocess::lock; + *unlock = *File::Flock::Subprocess::unlock; + *lock_rename = *File::Flock::Subprocess::lock_rename; + *forget_locks = *File::Flock::Subprocess::forget_locks; + } else { + *new = *new_flock; + *final_cleanup = *final_cleanup_flock; + *lock = *lock_flock; + *unlock = *unlock_flock; + *lock_rename = *lock_rename_flock; + *forget_locks = *forget_locks_flock; + } } 1; -__DATA__ +__END__ =head1 NAME @@ -296,9 +344,15 @@ unlock($filename); + lock_rename($oldfilename, $newfilename) + my $lock = new File::Flock '/somefile'; - lock_rename($oldfilename, $newfilename) + $lock->unlock(); + + $lock->lock_rename('/new/file'); + + forget_locks(); =head1 DESCRIPTION @@ -315,13 +369,24 @@ on the filename should be moved to a new name). B the new name rather than the original name. -=head1 LICENSE +Locks are released on process exit when the process that created the +lock exits. Subprocesses that exit do not remove locks. +Use forget_locks() or POSIX::_exit() to prevent unlocking on process exit. + +=head1 SEE ALSO + +See L for a variant that uses a subproess to hold +the locks so that the locks survive when the parent process forks. +See L for a way to automatically choose between +File::Flock and L. -File::Flock may be used/modified/distibuted on the same terms -as perl itself. +=head1 LICENSE -=head1 AUTHOR +Copyright (C) 1996-2012 David Muir Sharnoff +Copyright (C) 2013 Google, Inc. +This module may be used/copied/etc on the same terms as Perl itself. -David Muir Sharnoff +=head1 PACKAGERS +File::Flock is packaged for Fedora by Emmanuel Seyman . diff -Nru libfile-flock-perl-2008.01/t/auto.t libfile-flock-perl-2013.11/t/auto.t --- libfile-flock-perl-2008.01/t/auto.t 1970-01-01 00:00:00.000000000 +0000 +++ libfile-flock-perl-2013.11/t/auto.t 2013-09-17 03:54:58.000000000 +0000 @@ -0,0 +1,21 @@ +#!/usr/bin/perl + +BEGIN { + use Config; + if ($Config{d_flock}) { + print "1..0 # Skipped: flock() is supported on this platform\n"; + exit 0; + } +} + +use FindBin; +require "$FindBin::Bin/wrap.tm"; + +dirwrap(sub { + require File::Flock::Forking; + import File::Flock::Forking; + require File::Flock; + import File::Flock; + require "$FindBin::Bin/flock.tt" +}); + diff -Nru libfile-flock-perl-2008.01/t/auto2.t libfile-flock-perl-2013.11/t/auto2.t --- libfile-flock-perl-2008.01/t/auto2.t 1970-01-01 00:00:00.000000000 +0000 +++ libfile-flock-perl-2013.11/t/auto2.t 2013-09-17 03:54:58.000000000 +0000 @@ -0,0 +1,21 @@ +#!/usr/bin/perl + +BEGIN { + use Config; + if ($Config{d_flock}) { + print "1..0 # Skipped: flock() is supported on this platform\n"; + exit 0; + } +} + +use FindBin; +require "$FindBin::Bin/wrap.tm"; + +dirwrap(sub { + require File::Flock::Forking; + import File::Flock::Forking; + require File::Flock; + import File::Flock; + require "$FindBin::Bin/flock2.tt" +}); + diff -Nru libfile-flock-perl-2008.01/t/flock.t libfile-flock-perl-2013.11/t/flock.t --- libfile-flock-perl-2008.01/t/flock.t 2002-10-09 19:08:14.000000000 +0000 +++ libfile-flock-perl-2013.11/t/flock.t 2013-09-17 03:54:58.000000000 +0000 @@ -1,284 +1,18 @@ -#!/usr/bin/perl5.00502 -w -I. +#!/usr/bin/perl -$counter = "/tmp/flt1.$$"; -$lock = "/tmp/flt2.$$"; -$lock2 = "/tmp/flt3.$$"; -$lock3 = "/tmp/flt4.$$"; -$lock4 = "/tmp/flt5.$$"; -$lock5 = "/tmp/flt6.$$"; -$lock6 = "/tmp/flt7.$$"; -$lock7 = "/tmp/flt8.$$"; - -use File::Flock; -use Carp; -use FileHandle; - -STDOUT->autoflush(1); - -$children = 6; -$count = 120; -die unless $count % 2 == 0; -die unless $count % 3 == 0; -print "1..".($count*1.5+$children*2+7)."\n"; - -my $child = 0; -my $i; -for $i (1..$children) { - $p = fork(); - croak unless defined $p; - $parent = $p or $child = $i; - last unless $parent; -} - -STDOUT->autoflush(1); - -if ($parent) { - print "ok 1\n"; - &write_file($counter, "2"); - &write_file($lock, ""); - &write_file($lock4, ""); - lock($lock4); -} else { - my $e; - while (! -e $lock) { - # spin - die if $e++ > 1000000; +BEGIN { + use Config; + if (!$Config{d_flock}) { + print "1..0 # Skipped: flock() not supported on this platform, use File::Flock::Forking to workaround\n"; + exit 0; } - lock($lock3, 'shared'); } -lock($lock2, 'shared'); - -my $c; -my $ee; -while (($c = &read_file($counter)) < $count) { - die if $ee++ > 10000000; - if ($c < $count*.25 || $c > $count*.75) { - lock($lock); - } else { - lock($lock, 0, 1) || next; - } - $c = &read_file($counter); - - # make sure each child increments it at least once. - if ($c < $children+2 && $c != $child+2) { - unlock($lock); - next; - } - - if ($c < $count) { - print "ok $c\n"; - $c++; - &overwrite_file($counter, "$c"); - } - - # one of the children will exit (and thus need to clean up) - if ($c == $count/3) { - exit(0) if fork() == 0; - } - - # deal with a missing lock file - if ($c == $count/2) { - unlink($lock) - or croak "unlink $lock: $!"; - } - - # make sure the lock file doesn't get deleted - if ($c == int($count*.9)) { - &overwrite_file($lock, "keepme"); - } - - unlock($lock); -} - -lock($lock); -$c = &read_file($counter); -print "ok $c\n"; -$c++; -&overwrite_file($counter, "$c"); -unlock($lock); - -if ($c == $count+$children+1) { - print "ok $c\n"; - $c++; - if (&read_file($lock) eq 'keepme') - {print "ok $c\n";} else {print "not ok $c\n"}; - unlink($lock); - $c++; -} - -unlock($lock2); - -if ($parent) { - lock($lock2); - unlock($lock2); - - $c = $count+$children+3; - - &write_file($counter, $c); - unlock($lock4); -} - - -# okay, now that that's all done, lets try some locks using -# the object interface... - -my $start = $c; - -for(;;) { - my $l = new File::Flock $lock4; - - $c = &read_file($counter); - - last if $c > $count/2+$start; - - print "ok $c\n"; - $c++; - &overwrite_file($counter, "$c"); -} -# -# now let's make sure nonblocking works -# -if ($parent) { - my $e; - lock $lock6; - for(;;) { - lock($lock7, undef, 'nonblocking') - or last; - unlock($lock7); - die if $e++ > 1000; - sleep(1); - } - unlock $lock6; - lock $counter; - $c = &read_file($counter); - print "ok $c\n"; - $c++; - &overwrite_file($counter, "$c"); - unlock $counter; - -} elsif ($child == 1) { - my $e; - for(;;) { - lock($lock6, undef, 'nonblocking') - or last; - unlock($lock6); - die if $e++ > 1000; - sleep(1); - } - lock $lock7; - lock $lock6; - lock $counter; - $c = &read_file($counter); - print "ok $c\n"; - $c++; - &overwrite_file($counter, "$c"); - unlock $counter; - unlock $lock7; - unlock $lock6; -} - -# -# Shut everything down -# -if ($parent) { - my $l = new File::Flock $lock3; - $c = &read_file($counter); - if ($l) { print "ok $c\n" } else {print "not ok $c\n"} - $c++; - unlink($counter); - unlink($lock4); - unlink($lock); - lock($lock5); - unlock($lock5); - if (-e $lock5) { print "not ok $c\n" } else {print "ok $c\n"} - $c++; - $x = ''; - for (1..$children) { - wait(); - $status = $? >> 8; - if ($status) { $x .= "not ok $c\n";} else {$x .= "ok $c\n"} - $c++; - } - $l->unlock(); - print $x; -} else { - unlock($lock3); -} -exit(0); - -sub read_file -{ - my ($file) = @_; - - local(*F); - my $r; - my (@r); - - open(F, "<$file") || croak "open $file: $!"; - @r = ; - close(F); - - return @r if wantarray; - return join("",@r); -} - -sub write_file -{ - my ($f, @data) = @_; - - local(*F); - - open(F, ">$f") || croak "open >$f: $!"; - (print F @data) || croak "write $f: $!"; - close(F) || croak "close $f: $!"; - return 1; -} - -sub overwrite_file -{ - my ($f, @data) = @_; - - local(*F); - - if (-e $f) { - open(F, "+<$f") || croak "open +<$f: $!"; - } else { - open(F, "+>$f") || croak "open >$f: $!"; - } - (print F @data) || croak "write $f: $!"; - my $where = tell(F); - croak "could not tell($f): $!" - unless defined $where; - truncate(F, $where) - || croak "trucate $f at $where: $!"; - close(F) || croak "close $f: $!"; - return 1; -} - -sub append_file -{ - my ($f, @data) = @_; - - local(*F); - - open(F, ">>$f") || croak "open >>$f: $!"; - (print F @data) || croak "write $f: $!"; - close(F) || croak "close $f: $!"; - return 1; -} - -sub read_dir -{ - my ($d) = @_; - - my (@r); - local(*D); - - opendir(D,$d) || croak "opendir $d: $!"; - @r = grep($_ ne "." && $_ ne "..", readdir(D)); - closedir(D); - return @r; -} +use FindBin; +require "$FindBin::Bin/wrap.tm"; -1; +dirwrap(sub { + require File::Flock; + import File::Flock; + require "$FindBin::Bin/flock.tt"; +}); diff -Nru libfile-flock-perl-2008.01/t/flock.tt libfile-flock-perl-2013.11/t/flock.tt --- libfile-flock-perl-2008.01/t/flock.tt 1970-01-01 00:00:00.000000000 +0000 +++ libfile-flock-perl-2013.11/t/flock.tt 2013-09-17 03:54:58.000000000 +0000 @@ -0,0 +1,314 @@ +#!/usr/bin/perl + +use Carp; +use FileHandle; +use File::Slurp; +use strict; +use warnings; +use Time::HiRes; + +our $dir; # set in wrap.tm +die unless $dir; + +my $counter = "$dir/counter"; +my $lock = "$dir/lock"; +my $lock2 = "$dir/lock2"; +my $lock3 = "$dir/lock3"; +my $lock4 = "$dir/lock4"; +my $lock5 = "$dir/lock5"; +my $lock6 = "$dir/lock6"; +my $lock7 = "$dir/lock7"; + +STDOUT->autoflush(1); + +my $children = 6; +my $count = 120; +die unless $count % 2 == 0; +die unless $count % 3 == 0; +print "1..".($count*1.5+$children*2+7)."\n"; + +my %locks; +my $acquiring = ''; +my $releasing = ''; + +my $parent; +my $child = 0; +my $i; +for $i (1..$children) { + my $p = fork(); + croak unless defined $p; + $parent = $p or $child = $i; + last unless $parent; +} + +my $pdesc = "process $$, " . ($parent ? "the parent" : "child # $child"); +print "# $pdesc\n"; + +my $lastline; +my $lastdebug = 0; + +$SIG{WINCH} = sub { + if (time - $lastdebug > .5) { + $lastdebug = time; + debugprint(); + } +}; + +sub debugprint { + print STDERR "# $pdesc at $lastline" + . (scalar(keys %locks) ? " holding locks on " . join(' ', map { "$_$locks{$_}" } sort keys %locks) : '') + . ($acquiring ? " trying to acquire lock on $acquiring" : "") + . ($releasing ? " trying to release lock on $releasing" : "") + . "\n"; +} + +STDOUT->autoflush(1); + +sub dolock; +sub dounlock; + +dp(); + +if ($parent) { + print "ok 1\n"; + &write_file($counter, "2"); + &write_file($lock, ""); + &write_file($lock4, ""); + dolock($lock4); +} else { + my $e = 1; + while (! -e $lock) { + # spin + print "# $pdesc spinning\n" if $e %2000 == 0; + die if $e++ > 1000000; + } + dp(); + dolock($lock3, 'shared'); +} + +dp(); +dolock($lock2, 'shared'); +dp(); + +my $c; +my $ee; +while (($c = &read_file($counter)) < $count) { + die if $ee++ > 10000000; + if ($c < $count*.25 || $c > $count*.75) { + dolock($lock); + } else { + dolock($lock, 0, 1) || next; + } + $c = &read_file($counter); + + # make sure each child increments it at least once. + if ($c < $children+2 && $c != $child+2) { + dounlock($lock); + next; + } + + if ($c < $count) { + print "ok $c\n"; + $c++; + &overwrite_file($counter, "$c"); + } + + # one of the children will exit (and thus need to clean up) + if ($c == $count/3) { + exit(0) if fork() == 0; + } + + # deal with a missing lock file + if ($c == $count/2) { + unlink($lock) + or croak "unlink $lock: $!"; + } + + # make sure the lock file doesn't get deleted + if ($c == int($count*.9)) { + &overwrite_file($lock, "keepme"); + } + + dounlock($lock); +} + +dp(); +dolock($lock); +$c = &read_file($counter); +print "ok $c\n"; +$c++; +&overwrite_file($counter, "$c"); +dounlock($lock); +dp(); + +if ($c == $count+$children+1) { + print "ok $c\n"; + $c++; + if (&read_file($lock) eq 'keepme') + {print "ok $c\n";} else {print "not ok $c\n"}; + unlink($lock); + $c++; +} + +dounlock($lock2); + +if ($parent) { + dolock($lock2); + dounlock($lock2); + + $c = $count+$children+3; + + &write_file($counter, $c); + dounlock($lock4); +} + + +# okay, now that that's all done, lets try some locks using +# the object interface... + +my $start = $c; + +for(;;) { + my $l = dolock2($lock4); + + $c = &read_file($counter); + + last if $c > $count/2+$start; + + print "ok $c\n"; + $c++; + &overwrite_file($counter, "$c"); +} + +delete $locks{$lock4}; # unlocked by going out of scope + +# +# now let's make sure nonblocking works +# +if ($parent) { + my $e; + dolock $lock6; + for(;;) { + dp(); + dolock($lock7, undef, 'nonblocking') + or last; + dp(); + dounlock($lock7); + dp(); + die if $e++ > 1000; + sleep(1); + } + dp(); + dounlock $lock6; + dp(); + dolock $counter; + dp(); + $c = &read_file($counter); + print "ok $c\n"; + $c++; + &overwrite_file($counter, "$c"); + dp(); + dounlock $counter; + dp(); +} elsif ($child == 1) { + dp(); + my $e; + for(;;) { + dolock($lock6, undef, 'nonblocking') + or last; + dounlock($lock6); + die if $e++ > 1000; + sleep(1); + } + dolock $lock7; + dolock $lock6; + dolock $counter; + $c = &read_file($counter); + print "ok $c\n"; + $c++; + &overwrite_file($counter, "$c"); + dounlock $counter; + dounlock $lock7; + dounlock $lock6; +} + +dp(); + +# +# Shut everything down +# +if ($parent) { + dp(); + my $l = new File::Flock $lock3; + $c = &read_file($counter); + if ($l) { print "ok $c\n" } else {print "not ok $c\n"} + $c++; + unlink($counter); + unlink($lock4); + unlink($lock); + dolock($lock5); + dounlock($lock5); + if (-e $lock5) { print "not ok $c\n" } else {print "ok $c\n"} + $c++; + my $x = ''; + for (1..$children) { + dp(); + wait(); + dp(); + my $status = $? >> 8; + if ($status) { $x .= "not ok $c\n";} else {$x .= "ok $c\n"} + $c++; + } + $releasing = $lock3; + $l->unlock(); + undef $releasing; + delete $locks{$lock3}; + print $x; + dp(); +} else { + dp(); + dounlock($lock3); +} +dp(); +exit(0); + +sub dolock { + $lastline = (caller())[2]; + my $s = ""; + $s .= ":" if ($_[1] || $_[2]); + $s .= ":Shared" if $_[1]; + $s .= ":Nonblocking" if $_[2]; + my $r = lock(@_); + $locks{$_[0]} = $s if $r; + undef $acquiring; + return $r; +} + +sub dolock2 { + $lastline = (caller())[2]; + my $s = ""; + $s .= ":" if ($_[1] || $_[2]); + $s .= ":Shared" if $_[1]; + $s .= ":Nonblocking" if $_[2]; + $acquiring = "$_[0]$s"; + my $r = File::Flock->new(@_); + $locks{$_[0]} = $s if $r; + undef $acquiring; + return $r; +} + +sub dounlock { + $lastline = (caller())[2]; + $releasing = "$_[0]$locks{$_[0]}"; + delete $locks{$_[0]}; + unlock(@_); + undef $releasing; +} + +sub dp +{ + $lastline = (caller())[2]; + # debugprint(); +} + +1; diff -Nru libfile-flock-perl-2008.01/t/flock2.t libfile-flock-perl-2013.11/t/flock2.t --- libfile-flock-perl-2008.01/t/flock2.t 1970-01-01 00:00:00.000000000 +0000 +++ libfile-flock-perl-2013.11/t/flock2.t 2013-09-17 03:54:58.000000000 +0000 @@ -0,0 +1,18 @@ +#!/usr/bin/perl + +BEGIN { + use Config; + if (!$Config{d_flock}) { + print "1..0 # Skipped: flock() not supported on this platform, use File::Flock::Forking to workaround\n"; + exit 0; + } +} + +use FindBin; +require "$FindBin::Bin/wrap.tm"; + +dirwrap(sub { + require File::Flock; + import File::Flock; + require "$FindBin::Bin/flock2.tt"; +}); diff -Nru libfile-flock-perl-2008.01/t/flock2.tt libfile-flock-perl-2013.11/t/flock2.tt --- libfile-flock-perl-2008.01/t/flock2.tt 1970-01-01 00:00:00.000000000 +0000 +++ libfile-flock-perl-2013.11/t/flock2.tt 2013-09-17 03:54:58.000000000 +0000 @@ -0,0 +1,188 @@ + +use FindBin; +require "$FindBin::Bin/wrap.tm"; +use File::Slurp; +use Time::HiRes qw(sleep); +use POSIX qw(_exit); +use File::Flock; +use Test::More tests => 20; +use Test::SharedFork; +use strict; +use warnings; + + +test_lock_held_across_fork(); +test_locks_dropped_on_sole_process_exit(); +test_locks_dropped_on_multi_process_exit(); +test_lock_rename_object(); +test_forget_locks(); + +our $dir; # set in wrap.tt + +sub test_lock_held_across_fork +{ + my $lock1 = "$dir/lhaf1"; + my $lock2 = "$dir/lhaf2"; + + if (dofork()) { + lock($lock1); + my $l = File::Flock->new($lock2); + write_file("$dir/gate1", ""); + + POSIX::_exit(0) unless dofork(); + write_file("$dir/gate2", ""); + + sleep(0.1) while ! -e "$dir/gate3"; + ok(! -e "$dir/gotlock1a", "lock held"); + ok(! -e "$dir/gotlock1b", "obj lock held"); + ok(! -e "$dir/gotlock2a", "child lock held"); + ok(! -e "$dir/gotlock2b", "child obj lock held"); + unlock($lock1); + write_file("$dir/gate4", ""); + + sleep(0.1) while ! -e "$dir/gate5"; + ok(-e "$dir/gotlock3a", "lock released"); + ok(! -e "$dir/gotlock3b", "obj lock not released"); + $l->unlock(); + write_file("$dir/gate6", ""); + + sleep(0.1) while ! -e "$dir/gate7"; + ok(-e "$dir/gotlock4", "obj lock released"); + write_file("$dir/gate8", ""); + } else { + sleep(0.1) while ! -e "$dir/gate1"; + # parent has locked lock + write_file("$dir/gotlock1a", "") if lock($lock1, undef, 'nonblocking'); + write_file("$dir/gotlock1b", "") if lock($lock2, undef, 'nonblocking'); + + sleep(0.1) while ! -e "$dir/gate2"; + write_file("$dir/gotlock2a", "") if lock($lock1, undef, 'nonblocking'); + write_file("$dir/gotlock2b", "") if lock($lock2, undef, 'nonblocking'); + write_file("$dir/gate3", ""); + + sleep(0.1) while ! -e "$dir/gate4"; + write_file("$dir/gotlock3a", "") if lock($lock1, undef, 'nonblocking'); + write_file("$dir/gotlock3b", "") if lock($lock2, undef, 'nonblocking'); + write_file("$dir/gate5", ""); + + sleep(0.1) while ! -e "$dir/gate6"; + write_file("$dir/gotlock4", "") if lock($lock2, undef, 'nonblocking'); + write_file("$dir/gate7", ""); + sleep(0.1) while ! -e "$dir/gate8"; + exit(0); + } +} + +sub test_locks_dropped_on_sole_process_exit +{ + my $p = "$dir/tldospe"; + + my $pid; + if (($pid = dofork())) { + sleep(0.1) while ! -e "$p.gate1"; + ok(! lock("$p.lock1", undef, 'nonblocking'), "can't get lock"); + write_file("$p.gate2", ""); + waitpid($pid, 0); + ok(lock("$p.lock1", undef, 'nonblocking'), "can get lock"); + } else { + lock("$p.lock1"); + write_file("$p.gate1", ""); + + sleep(0.1) while ! -e "$p.gate2"; + exit(0); + } +} + +sub test_locks_dropped_on_multi_process_exit +{ + my $p = "$dir/tldompe"; + + my $pid; + if (($pid = dofork())) { + sleep(0.1) while ! -e "$p.gate1"; + ok(! lock("$p.lock1", undef, 'nonblocking'), "can't get lock"); + write_file("$p.gate2", ""); + waitpid($pid, 0); + ok(lock("$p.lock1", undef, 'nonblocking'), "can get lock"); + write_file("$p.gate3", ""); + } else { + lock("$p.lock1"); + if (dofork()) { + write_file("$p.gate1", ""); + + sleep(0.1) while ! -e "$p.gate2"; + exit(0); + } else { + sleep(0.1) while ! -e "$p.gate3"; + exit(0); + } + + } +} + +sub test_lock_rename_object +{ + my $p = "$dir/tlro"; + + my $l = File::Flock->new("$p.oldlock"); + undef $!; + undef $@; + ok(eval {rename("$p.oldlock", "$p.newlock")}, "rename file - $!"); + ok(eval {$l->lock_rename("$p.newlock")}, "rename lock - $@"); + ok(eval {$l->unlock()}, "unlock - $@"); +} + +sub test_forget_locks +{ + my $p = "$dir/tfl"; + + my $pid; + if (($pid = dofork())) { + sleep(0.1) while ! -e "$p.gate1"; + ok(! lock("$p.lock1", undef, 'nonblocking'), "can't get multi lock"); + + write_file("$p.gate2", ""); + # forget locks + sleep(0.1) while ! -e "$p.gate4"; + ok(! lock("$p.lock1", undef, 'nonblocking'), "still can't get multi lock"); + + write_file("$p.gate5", ""); + # sub master quits + waitpid($pid, 0); + ok(kill(0, $pid) == 0, "first proc ($pid) is dead"); + ok(! lock("$p.lock1", undef, 'nonblocking'), "and still can't get multi lock"); + + write_file("$p.gate3", ""); + my $pid2 = read_file("$p.gate1"); + sleep(0.1) while kill(0, $pid2); + ok(kill(0, $pid2) == 0, "second proc ($pid2) is dead"); + + ok(lock("$p.lock1", undef, 'nonblocking'), "now can get multi lock"); + } else { + lock("$p.lock1"); + my $subpid; + if (($subpid = dofork())) { + write_file("$p.gate1", "$subpid"); + + sleep(0.1) while ! -e "$p.gate2"; + forget_locks(); + write_file("$p.gate4", ""); + + sleep(0.1) while ! -e "$p.gate5"; + exit(0); + } else { + sleep(0.1) while ! -e "$p.gate3"; + exit(0); + } + + } +} + + +sub dofork +{ + my $p = fork(); + die unless defined $p; + return $p; +} + diff -Nru libfile-flock-perl-2008.01/t/forking.t libfile-flock-perl-2013.11/t/forking.t --- libfile-flock-perl-2008.01/t/forking.t 1970-01-01 00:00:00.000000000 +0000 +++ libfile-flock-perl-2013.11/t/forking.t 2013-09-17 03:54:58.000000000 +0000 @@ -0,0 +1,14 @@ +#!/usr/bin/perl + +use FindBin; +require "$FindBin::Bin/wrap.tm"; + +dirwrap(sub { + $ENV{FLOCK_FORKING_USE} = 'subprocess'; + require File::Flock::Forking; + import File::Flock::Forking; + require File::Flock; + import File::Flock; + require "$FindBin::Bin/flock.tt" +}); + diff -Nru libfile-flock-perl-2008.01/t/forking2.t libfile-flock-perl-2013.11/t/forking2.t --- libfile-flock-perl-2008.01/t/forking2.t 1970-01-01 00:00:00.000000000 +0000 +++ libfile-flock-perl-2013.11/t/forking2.t 2013-09-17 03:54:58.000000000 +0000 @@ -0,0 +1,14 @@ +#!/usr/bin/perl + +use FindBin; +require "$FindBin::Bin/wrap.tm"; + +dirwrap(sub { + $ENV{FLOCK_FORKING_USE} = 'subprocess'; + require File::Flock::Forking; + import File::Flock::Forking; + require File::Flock; + import File::Flock; + require "$FindBin::Bin/flock2.tt" +}); + diff -Nru libfile-flock-perl-2008.01/t/subprocess.t libfile-flock-perl-2013.11/t/subprocess.t --- libfile-flock-perl-2008.01/t/subprocess.t 1970-01-01 00:00:00.000000000 +0000 +++ libfile-flock-perl-2013.11/t/subprocess.t 2013-09-17 03:54:58.000000000 +0000 @@ -0,0 +1,11 @@ +#!/usr/bin/perl + +use FindBin; +require "$FindBin::Bin/wrap.tm"; + +dirwrap(sub { + require File::Flock::Subprocess; + import File::Flock::Subprocess; + require "$FindBin::Bin/flock.tt" +}); + diff -Nru libfile-flock-perl-2008.01/t/subprocess2.t libfile-flock-perl-2013.11/t/subprocess2.t --- libfile-flock-perl-2008.01/t/subprocess2.t 1970-01-01 00:00:00.000000000 +0000 +++ libfile-flock-perl-2013.11/t/subprocess2.t 2013-09-17 03:54:58.000000000 +0000 @@ -0,0 +1,11 @@ +#!/usr/bin/perl + +use FindBin; +require "$FindBin::Bin/wrap.tm"; + +dirwrap(sub { + require File::Flock::Subprocess; + import File::Flock::Subprocess; + require "$FindBin::Bin/flock2.tt" +}); + diff -Nru libfile-flock-perl-2008.01/t/wrap.tm libfile-flock-perl-2013.11/t/wrap.tm --- libfile-flock-perl-2008.01/t/wrap.tm 1970-01-01 00:00:00.000000000 +0000 +++ libfile-flock-perl-2013.11/t/wrap.tm 2013-09-17 03:54:58.000000000 +0000 @@ -0,0 +1,40 @@ + +use File::Temp; +use Data::Structure::Util qw(unbless); +use IO::Socket::UNIX; +require POSIX; +use Socket; +use IO::Handle; + +our $dir; + +sub dirwrap +{ + my ($code) = @_; + + my $dirobj = File::Temp->newdir(); + $dir = $dirobj->dirname(); + + my $parent = new IO::Handle; + my $child = new IO::Handle; + socketpair($parent, $child, AF_UNIX, SOCK_STREAM, PF_UNSPEC) + or die "cannot create socketpair: $!"; + + my $pid = fork(); + + if ($pid) { + unbless $dirobj; + + $parent->close(); + $code->(); + $child->close(); + } elsif (defined $pid) { + $child->close(); + while(<$parent>) {}; + } else { + die "could not fork: $!"; + } + exit(0); +} + +1;