From b8b72652e1f46813885c6547ccd30188ebcb58ad Mon Sep 17 00:00:00 2001 From: Packit Date: Sep 16 2020 12:21:32 +0000 Subject: perl-File-Remove-1.57 base --- diff --git a/Changes b/Changes new file mode 100644 index 0000000..d8752f8 --- /dev/null +++ b/Changes @@ -0,0 +1,203 @@ +Revision history for Perl extension File-Remove + +1.57 2016-04-24 - Shlomi Fish + - Correct the copyright holder and year. + - Add a test for Kwalitee and 'use warnings'. + +1.56 2016-03-23 - Shlomi Fish + - Remove the Build.PL so there won't be two build files. + - https://github.com/shlomif/File-Remove/pull/1 + - I think it doesn't matter too much with Dist-Zilla, but to avoid + future complaints, I decided to comply with the request. + - Thanks to Karen Etheridge (ETHER) for the report. + +1.55 2016-01-11 - Shlomi Fish + - Add the "{ glob => 0 }" option to remove(). + - See https://rt.cpan.org/Ticket/Display.html?id=78405 + - Thanks to SHARYANTO for the request. + +1.54 2016-01-10 - Shlomi Fish + - Fix a typo in the documentation: + - https://rt.cpan.org/Ticket/Display.html?id=72010 + - Thanks to DFH, and dsteinbrunner for the report. + - Hopefully fix the GitHub remote to make it more MetaCPAN-friendly. + +1.53 2016-01-10 - Shlomi Fish + - Convert the distribution from Module-Install to Dist-Zilla. + - Module-Install is undermaintained and unloved. + - Fix a problem running the tests in parallel. + - https://rt.cpan.org/Public/Bug/Display.html?id=90183 + - Thanks to ETHER, RJBS, and KENTNL for the report and the analysis. + - Earlier report by EDENC - thanks as well. + - https://rt.cpan.org/Ticket/Display.html?id=71779 + - Removed trailing whitespace and \r-s. + - The \r-s confused Dist-Zilla abstract extraction. + +1.52 2012-03-19 - Adam Kennedy + - No functional changes + - Updating Module::Install to 1.06 + - Moved File::Spec dependency to 3.29 to fix problems with + four-digit decimal dependencies in some downstream packaging + systems. + +1.51 2011-10-27 - Adam Kennedy + - END-time deletion by clear() is now fork-safe, it will only remove + paths created in the same process. + +1.50 2011-07-11 - Adam Kennedy + - Adding a second skip for the known-bad cygwin file permissions problem + +1.49 2011-03-14 - Adam Kennedy + - Restoring 02_directories to no_plan as it runs different test counts + on different systems. + +1.48 2011-03-11 - Adam Kennedy + - Promoting dev code to production version + - Fixed a major bug in the 1.46 logic that works out what to change the + cwd to when deleting while inside a directory. + +1.47_01 2011-02-18 - Adam Kennedy + - Add test counts to all test scripts + - Added a test for space-safe globs + +1.46 2011-02-18 - Adam Kennedy + - No changes from 1.45_01 + - CPAN Testers likes the dev release, moving to production release + +1.45_01 2011-02-17 - Adam Kennedy + - Updated to Module::Install::DSL 1.00 + - Skip test on cygwin due to non-root users not being able to deny + themselves write permissions to files. + - Added a test to delete directories when the current working + directory is inside the location to delete (ADAMK) + - Fixes for trash() with callbacks and on Mac (MIYAGAWA) + +1.42 2008-07-03 - Adam Kennedy + - Updated to Module::Install 0.76 + - Updated bundled author tests + - Added the test_remove function + - Localising $@ during eval calls + +1.41 2008-06-02 - Adam Kennedy + - No functional changes + - Updating location of author tests + - Switching to Module::Install again, to generate a better META.yml + +1.40 2008-02-23 - Adam Kennedy + - Dev release looks good, changing to production release + +1.39_01 2008-02-20 - Adam Kennedy + - Fixed rt.cpan.org #30251 "removing dirs enclosed by curly braces" + - remove now ignores globbing if -e is true BEFORE globbing + (This should fix numerous possible failures where people are trying + delete strangely named files, but globbing is kicking in and + expanding the names incorrectly) + - Moving to a production-grade version to indicate module stability + - Adding explicit 5.005 dependency + (Primarily for the benefit of automated quality/anaylsis tools) + +0.39 2007-11-12 - Adam Kennedy + - No functional changes + - Updating to Module::Install 0.68 + +0.38 2007-10-15 - Adam Kennedy + - Removed an extremely dangerous and reckless test case that tried + to delete a soft link to root and (when it failed) deleted the + actual root directory. + +0.37 2007-07-08 - Adam Kennedy + - Restoring support for broken symlinks (Marek Rouchal) + - Adding tests for the broken symlink case (Marek Rouchal) + - Tidying up the Changes file a bit + +0.36 2007-06-30 - Adam Kennedy + - Avoid the installation of Mac::Glue. + (It should not be necesary to test voice synthesis to delete a file) + - Anyone truly needing "trash" support will need to add a dependency + on Mac::Glue themself. The function may be split out of File::Remove + later down the track. + - Constanting the debugger flag for a minor speed and memory improvement + - Copy in a known-readonly flag for more accurate testing on Win32 + - Remove assumption that -w implied deletion rights on Win32 + - Validate that the file was actually deleted. + - Add better mode-handling for files. + - Add smarter implementation of "candelete" logic. + +0.35 2007-02-09 + - Update makefile to require Mac::Glue version compatible with Intel macs + - Change pod heading from "methods" to "subroutines" [RT#13687] + - No functional changes from 0.34 + +0.34 2006-11-06 + - Update t/03 to skip the "is this file not writable" test when + it would fail because the tests are being run by root (as sometimes + happens when installing Perl modules). + +0.33 2006-10-24 + - Previous release tested ok. + - Incrementing for production release. + - No functional changes + +0.32_01 2006-10-23 + - Use File::Spec to clean/canon paths instead of hand-stripping trailing slash + - Apply the File::Path "safe" check manually for the root only, and + use File::Path itself with safe OFF, so that we can handle deleting + deep readonly files (and do it properly on VMS) + - Added a test for the deletion of deep readonly files + - Removing the use of "our" variables to try and get the Perl version + dependency back to at least 5.005. + - Report "deleted" for non-existant files they want to delete + - Report the path they pass, but for dir USE a File::Spec->canonpath + +0.31 2005-12-28 + - Applied Eric Hanchrow's patch to support filenames with spaces. + - Skip recycle tests unless recycle/trash support is available. + +0.30 2005-07-14 + - Applied CNANDOR's patch to fix trash() support on OS X 10.4. + +0.29 2004-12-04 + - Stabilize undelete support for OS X and Windows. + +0.26 2004-11-16 + - Fix the synopsis. + +0.25 2004-11-15 + - Renamed undelete() to trash(), to be more clear. + - Allow users to provide their own rmdir/unlink to trash(). + - Re-disabled debugging by default. + +0.24 2004-11-15 + - Add undelete support for OS X (via Mac::Glue). + - Fix undelete overloading of unlink/rmdir and update tests. + - Fix the documentation to be readable with perldoc. + +0.23 2004-11-15 + - Add undelete supportand tests (currently only for Win32, via + Win32::FileOp). + +0.22 2004-11-15 + - Add the first set of tests. + +0.21 2004-07-20 + - Converted the internals to File::Spec. + - Maintenance transferred by modules@perl.org to Richard Soderberg. + Please e-mail bug reports to . + +0.20 1998-04-15 + - Now you can pass a scalar reference as the first argument and it + will used as the recursive flag when removing directories. With + recursive flag set to 0 only the files in the directory are + removed and no attempt is made to recurse into subdirectories. + Nevertheless, if the directory becomes empty it is removed. + +0.12 1998-04-14 + - change the umask and set the permission on directories so we can + remove the files + +0.11 1998-04-13 + - changed the return values to successes rather than failures since + it makes more sense. + +0.10 1998-04-10 + - original version diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..7a9e1ec --- /dev/null +++ b/LICENSE @@ -0,0 +1,379 @@ +This software is copyright (c) 1998 by Gabor Egressy and others. + +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) 2016 by Shlomi Fish. + +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) 2016 by Shlomi Fish. + +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 + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..4007a98 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,27 @@ +# This file was automatically generated by Dist::Zilla::Plugin::Manifest v5.046. +Changes +LICENSE +MANIFEST +MANIFEST.SKIP +META.yml +Makefile.PL +README +dist.ini +lib/File/Remove.pm +t/00-compile.t +t/01_compile.t +t/02_directories.t +t/03_deep_readonly.t +t/04_can_delete.t +t/05_links.t +t/06_curly.t +t/07_cwd.t +t/08_spaces.t +t/09_fork.t +t/10_noglob.t +t/author-pod-coverage.t +t/author-pod-syntax.t +t/release-cpan-changes.t +t/release-kwalitee.t +t/release-trailing-space.t +weaver.ini diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP new file mode 100644 index 0000000..9bf9440 --- /dev/null +++ b/MANIFEST.SKIP @@ -0,0 +1,2 @@ +~$ +^README\.markdown$ diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..c751067 --- /dev/null +++ b/META.yml @@ -0,0 +1,37 @@ +--- +abstract: 'Remove files and directories' +author: + - 'Shlomi Fish ' +build_requires: + File::Copy: '0' + File::Spec: '3.29' + File::Spec::Functions: '0' + File::Temp: '0' + IO::Handle: '0' + IPC::Open3: '0' + Test::More: '0' + blib: '1.01' + perl: '5.006' +configure_requires: + ExtUtils::MakeMaker: '0' +dynamic_config: 0 +generated_by: 'Dist::Zilla version 5.046, CPAN::Meta::Converter version 2.150001' +license: perl +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: '1.4' +name: File-Remove +requires: + Cwd: '3.29' + File::Glob: '0' + File::Path: '0' + File::Spec: '3.29' + constant: '0' + perl: '5.006' + strict: '0' + vars: '0' + warnings: '0' +resources: + bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=File-Remove + repository: git://github.com/shlomif/File-Remove.git +version: '1.57' diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..3cc656e --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,74 @@ +# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v5.046. +use strict; +use warnings; + +use 5.006; + +use ExtUtils::MakeMaker; + +my %WriteMakefileArgs = ( + "ABSTRACT" => "Remove files and directories", + "AUTHOR" => "Shlomi Fish ", + "CONFIGURE_REQUIRES" => { + "ExtUtils::MakeMaker" => 0 + }, + "DISTNAME" => "File-Remove", + "LICENSE" => "perl", + "MIN_PERL_VERSION" => "5.006", + "NAME" => "File::Remove", + "PREREQ_PM" => { + "Cwd" => "3.29", + "File::Glob" => 0, + "File::Path" => 0, + "File::Spec" => "3.29", + "constant" => 0, + "strict" => 0, + "vars" => 0, + "warnings" => 0 + }, + "TEST_REQUIRES" => { + "File::Copy" => 0, + "File::Spec" => "3.29", + "File::Spec::Functions" => 0, + "File::Temp" => 0, + "IO::Handle" => 0, + "IPC::Open3" => 0, + "Test::More" => 0, + "blib" => "1.01" + }, + "VERSION" => "1.57", + "test" => { + "TESTS" => "t/*.t" + } +); + + +my %FallbackPrereqs = ( + "Cwd" => "3.29", + "File::Copy" => 0, + "File::Glob" => 0, + "File::Path" => 0, + "File::Spec" => "3.29", + "File::Spec::Functions" => 0, + "File::Temp" => 0, + "IO::Handle" => 0, + "IPC::Open3" => 0, + "Test::More" => 0, + "blib" => "1.01", + "constant" => 0, + "strict" => 0, + "vars" => 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); diff --git a/README b/README new file mode 100644 index 0000000..17af14c --- /dev/null +++ b/README @@ -0,0 +1,15 @@ + + +This archive contains the distribution File-Remove, +version 1.57: + + Remove files and directories + +This software is copyright (c) 1998 by Gabor Egressy. + +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 v5.046. + diff --git a/dist.ini b/dist.ini new file mode 100644 index 0000000..d9d55c2 --- /dev/null +++ b/dist.ini @@ -0,0 +1,26 @@ +name = File-Remove +author = Shlomi Fish +license = Perl_5 +copyright_holder = Gabor Egressy +copyright_year = 1998 + +[@Filter] +-bundle = @Basic +-remove = License +[AutoPrereqs] +[PodSyntaxTests] +[PodCoverageTests] +[MetaResources] +bugtracker.web = http://rt.cpan.org/NoAuth/Bugs.html?Dist=File-Remove +bugtracker.mailto = bug-file-remove@rt.cpan.org +repository.url = git://github.com/shlomif/File-Remove.git +repository.web = https://github.com/shlomif/File-Remove +repository.type = git +[PodWeaver] +[Test::Compile] +fake_home = 1 +skip = bump-ver +[Test::CPAN::Changes] +[Test::Kwalitee::Extra] +[Test::TrailingSpace] +[VersionFromModule] diff --git a/lib/File/Remove.pm b/lib/File/Remove.pm new file mode 100644 index 0000000..08b6299 --- /dev/null +++ b/lib/File/Remove.pm @@ -0,0 +1,557 @@ +package File::Remove; + +use 5.00503; +use strict; +use warnings; + +use vars qw{ $VERSION @ISA @EXPORT_OK }; +use vars qw{ $DEBUG $unlink $rmdir }; +BEGIN { + $VERSION = '1.57'; + # $VERSION = eval $VERSION; + @ISA = qw{ Exporter }; + @EXPORT_OK = qw{ remove rm clear trash }; +} + +use File::Path (); +use File::Glob (); +use File::Spec 3.29 (); +use Cwd 3.29 (); + +# $debug variable must be set before loading File::Remove. +# Convert to a constant to allow debugging code to be pruned out. +use constant DEBUG => !! $DEBUG; + +# Are we on VMS? +# If so copy File::Path and assume VMS::Filespec is loaded +use constant IS_VMS => !! ( $^O eq 'VMS' ); + +# Are we on Mac? +# If so we'll need to do some special trash work +use constant IS_MAC => !! ( $^O eq 'darwin' ); + +# Are we on Win32? +# If so write permissions does not imply deletion permissions +use constant IS_WIN32 => !! ( $^O =~ /^MSWin/ or $^O eq 'cygwin' ); + +# If we ever need a Mac::Glue object we will want to cache it. +my $glue; + + + + + +##################################################################### +# Main Functions + +my @CLEANUP = (); + +sub clear (@) { + my @files = expand( @_ ); + + # Do the initial deletion + foreach my $file ( @files ) { + next unless -e $file; + remove( \1, $file ); + } + + # Delete again at END-time. + # Save the current PID so that forked children + # won't delete things that the parent expects to + # live until their end-time. + push @CLEANUP, map { [ $$, $_ ] } @files; +} + +END { + foreach my $file ( @CLEANUP ) { + next unless $file->[0] == $$; + next unless -e $file->[1]; + remove( \1, $file->[1] ); + } +} + +# Acts like unlink would until given a directory as an argument, then +# it acts like rm -rf ;) unless the recursive arg is zero which it is by +# default +sub remove (@) { + my $recursive = (ref $_[0] eq 'SCALAR') ? shift : \0; + my $opts = (ref $_[0] eq 'HASH') ? shift : { glob => 1 }; + my @files = _expand_with_opts ($opts, @_); + + # Iterate over the files + my @removes; + foreach my $path ( @files ) { + # need to check for symlink first + # could be pointing to nonexisting/non-readable destination + if ( -l $path ) { + print "link: $path\n" if DEBUG; + if ( $unlink ? $unlink->($path) : unlink($path) ) { + push @removes, $path; + } + next; + } + unless ( -e $path ) { + print "missing: $path\n" if DEBUG; + push @removes, $path; # Say we deleted it + next; + } + my $can_delete; + if ( IS_VMS ) { + $can_delete = VMS::Filespec::candelete($path); + } elsif ( IS_WIN32 ) { + # Assume we can delete it for the moment + $can_delete = 1; + } elsif ( -w $path ) { + # We have write permissions already + $can_delete = 1; + } elsif ( $< == 0 ) { + # Unixy and root + $can_delete = 1; + } elsif ( (lstat($path))[4] == $< ) { + # I own the file + $can_delete = 1; + } else { + # I don't think we can delete it + $can_delete = 0; + } + unless ( $can_delete ) { + print "nowrite: $path\n" if DEBUG; + next; + } + + if ( -f $path ) { + print "file: $path\n" if DEBUG; + unless ( -w $path ) { + # Make the file writable (implementation from File::Path) + (undef, undef, my $rp) = lstat $path or next; + $rp &= 07777; # Don't forget setuid, setgid, sticky bits + $rp |= 0600; # Turn on user read/write + chmod $rp, $path; + } + if ( $unlink ? $unlink->($path) : unlink($path) ) { + # Failed to delete the file + next if -e $path; + push @removes, $path; + } + + } elsif ( -d $path ) { + print "dir: $path\n" if DEBUG; + my $dir = File::Spec->canonpath($path); + + # Do we need to move our cwd out of the location + # we are planning to delete? + my $chdir = _moveto($dir); + if ( length $chdir ) { + chdir($chdir) or next; + } + + if ( $$recursive ) { + if ( File::Path::rmtree( [ $dir ], DEBUG, 0 ) ) { + # Failed to delete the directory + next if -e $path; + push @removes, $path; + } + + } else { + my ($save_mode) = (stat $dir)[2]; + chmod $save_mode & 0777, $dir; # just in case we cannot remove it. + if ( $rmdir ? $rmdir->($dir) : rmdir($dir) ) { + # Failed to delete the directory + next if -e $path; + push @removes, $path; + } + } + + } else { + print "???: $path\n" if DEBUG; + } + } + + return @removes; +} + +sub rm (@) { + goto &remove; +} + +sub trash (@) { + local $unlink = $unlink; + local $rmdir = $rmdir; + + if ( ref $_[0] eq 'HASH' ) { + my %options = %{+shift @_}; + $unlink = $options{unlink}; + $rmdir = $options{rmdir}; + + } elsif ( IS_WIN32 ) { + local $@; + eval 'use Win32::FileOp ();'; + die "Can't load Win32::FileOp to support the Recycle Bin: \$@ = $@" if length $@; + $unlink = \&Win32::FileOp::Recycle; + $rmdir = \&Win32::FileOp::Recycle; + + } elsif ( IS_MAC ) { + unless ( $glue ) { + local $@; + eval 'use Mac::Glue ();'; + die "Can't load Mac::Glue::Finder to support the Trash Can: \$@ = $@" if length $@; + $glue = Mac::Glue->new('Finder'); + } + my $code = sub { + my @files = map { + Mac::Glue::param_type( + Mac::Glue::typeAlias() => $_ + ) + } @_; + $glue->delete(\@files); + }; + $unlink = $code; + $rmdir = $code; + } else { + die "Support for trash() on platform '$^O' not available at this time.\n"; + } + + remove(@_); +} + +sub undelete (@) { + goto &trash; +} + + + + + +###################################################################### +# Support Functions + +sub _expand_with_opts { + my $opts = shift; + return ($opts->{glob} ? expand(@_) : @_); +} + +sub expand (@) { + map { -e $_ ? $_ : File::Glob::bsd_glob($_) } @_; +} + +# Do we need to move to a different directory to delete a directory, +# and if so which. +sub _moveto { + my $remove = File::Spec->rel2abs(shift); + my $cwd = @_ ? shift : Cwd::cwd(); + + # Do everything in absolute terms + $remove = Cwd::abs_path( $remove ); + $cwd = Cwd::abs_path( $cwd ); + + # If we are on a different volume we don't need to move + my ( $cv, $cd ) = File::Spec->splitpath( $cwd, 1 ); + my ( $rv, $rd ) = File::Spec->splitpath( $remove, 1 ); + return '' unless $cv eq $rv; + + # If we have to move, it's to one level above the deletion + my @cd = File::Spec->splitdir($cd); + my @rd = File::Spec->splitdir($rd); + + # Is the current directory the same as or inside the remove directory? + unless ( @cd >= @rd ) { + return ''; + } + foreach ( 0 .. $#rd ) { + $cd[$_] eq $rd[$_] or return ''; + } + + # Confirmed, the current working dir is in the removal dir + pop @rd; + return File::Spec->catpath( + $rv, + File::Spec->catdir(@rd), + '' + ); +} + +1; + +__END__ + +=pod + +=head1 NAME + +File::Remove - Remove files and directories + +=head1 VERSION + +version 1.57 + +=head1 SYNOPSIS + + use File::Remove 'remove'; + + # removes (without recursion) several files + remove( '*.c', '*.pl' ); + + # removes (with recursion) several directories + remove( \1, qw{directory1 directory2} ); + + # removes (with recursion) several files and directories + remove( \1, qw{file1 file2 directory1 *~} ); + + # removes without globbing: + remove( \1, {glob => 0}, '*'); + + # trashes (with support for undeleting later) several files + trash( '*~' ); + +=head1 DESCRIPTION + +B removes files and directories. It acts like +B, for the most part. Although C can be given a list +of files, it will not remove directories; this module remedies that. +It also accepts wildcards, * and ?, as arguments for filenames. + +B accepts the same arguments as B, with +the addition of an optional, infrequently used "other platforms" +hashref. + +=head1 SUBROUTINES + +=head2 remove + +Removes files and directories. Directories are removed recursively like +in B if the first argument is a reference to a scalar that +evaluates to true. If the first argument is a reference to a scalar, +then it is used as the value of the recursive flag. By default it's +false so only pass \1 to it. + +If the next argument is a hash reference then it is a key/values of options. +Currently, there is one supported option of C<<< 'glob' => 0 >>> which prevents +globbing. E.g: + + remove(\1, {glob => 0}, '*'); + +Will not remove files globbed by '*' and will only remove the file +called asterisk if it exists. + +In list context it returns a list of files/directories removed, in +scalar context it returns the number of files/directories removed. The +list/number should match what was passed in if everything went well. + +=head2 rm + +Just calls B. It's there for people who get tired of typing +B. + +=head2 clear + +The C function is a version of C designed for +use in test scripts. It takes a list of paths that it will both +initially delete during the current test run, and then further +flag for deletion at END-time as a convenience for the next test +run. + +=head2 trash + +Removes files and directories, with support for undeleting later. +Accepts an optional "other platforms" hashref, passing the remaining +arguments to B. + +=over 4 + +=item Win32 + +Requires L. + +Installation not actually enforced on Win32 yet, since L +has badly failing dependencies at time of writing. + +=item OS X + +Requires L. + +=item Other platforms + +The first argument to trash() must be a hashref with two keys, +'rmdir' and 'unlink', each referencing a coderef. The coderefs +will be called with the filenames that are to be deleted. + +=back + +=head2 expand + +B Kept for legacy. + +=head2 undelete + +B Kept for legacy. + +=head1 SUPPORT + +Bugs should always be submitted via the CPAN bug tracker + +L + +For other issues, contact the maintainer. + +=head1 AUTHOR + +Adam Kennedy Eadamk@cpan.orgE + +=head1 COPYRIGHT + +Taken over by Shlomi Fish (L) while disclaiming +all rights and placing his modifications under +CC0/public-domain/MIT/any-other-licence. + +Some parts copyright 2006 - 2012 Adam Kennedy. + +Taken over by Adam Kennedy Eadamk@cpan.orgE to fix the +"deep readonly files" bug, and do some package cleaning. + +Some parts copyright 2004 - 2005 Richard Soderberg. + +Taken over by Richard Soderberg Eperl@crystalflame.netE to +port it to L and add tests. + +Original copyright: 1998 by Gabor Egressy, Egabor@vmunix.comE. + +This program is free software; you can redistribute and/or modify it under +the same terms as Perl itself. + +=head1 AUTHOR + +Shlomi Fish + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 1998 by Gabor Egressy. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=head1 BUGS + +Please report any bugs or feature requests on the bugtracker website +http://rt.cpan.org/NoAuth/Bugs.html?Dist=File-Remove or by email to +bug-file-remove@rt.cpan.org. + +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. + +=for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan + +=head1 SUPPORT + +=head2 Perldoc + +You can find documentation for this module with the perldoc command. + + perldoc File::Remove + +=head2 Websites + +The following websites have more information about this module, and may be of help to you. As always, +in addition to those websites please use your favorite search engine to discover more resources. + +=over 4 + +=item * + +MetaCPAN + +A modern, open-source CPAN search engine, useful to view POD in HTML format. + +L + +=item * + +Search CPAN + +The default CPAN search engine, useful to view POD in HTML format. + +L + +=item * + +RT: CPAN's Bug Tracker + +The RT ( Request Tracker ) website is the default bug/issue tracking system for CPAN. + +L + +=item * + +AnnoCPAN + +The AnnoCPAN is a website that allows community annotations of Perl module documentation. + +L + +=item * + +CPAN Ratings + +The CPAN Ratings is a website that allows community ratings and reviews of Perl modules. + +L + +=item * + +CPAN Forum + +The CPAN Forum is a web forum for discussing Perl modules. + +L + +=item * + +CPANTS + +The CPANTS is a website that analyzes the Kwalitee ( code metrics ) of a distribution. + +L + +=item * + +CPAN Testers + +The CPAN Testers is a network of smokers who run automated tests on uploaded CPAN distributions. + +L + +=item * + +CPAN Testers Matrix + +The CPAN Testers Matrix is a website that provides a visual overview of the test results for a distribution on various Perls/platforms. + +L + +=item * + +CPAN Testers Dependencies + +The CPAN Testers Dependencies is a website that shows a chart of the test results of all dependencies for a distribution. + +L + +=back + +=head2 Bugs / Feature Requests + +Please report any bugs or feature requests by email to C, or through +the web interface at L. You will be automatically notified of any +progress on the request by the system. + +=head2 Source Code + +The code is open to the world, and available for you to hack on. Please feel free to browse it and play +with it, or whatever. If you want to contribute patches, please send me a diff or prod me to pull +from your repository :) + +L + + git clone git://github.com/shlomif/File-Remove.git + +=cut diff --git a/t/00-compile.t b/t/00-compile.t new file mode 100644 index 0000000..1318995 --- /dev/null +++ b/t/00-compile.t @@ -0,0 +1,57 @@ +use 5.006; +use strict; +use warnings; + +# this test was generated with Dist::Zilla::Plugin::Test::Compile 2.054 + +use Test::More; + +plan tests => 1 + ($ENV{AUTHOR_TESTING} ? 1 : 0); + +my @module_files = ( + 'File/Remove.pm' +); + + + +# fake home for cpan-testers +use File::Temp; +local $ENV{HOME} = File::Temp::tempdir( CLEANUP => 1 ); + + +my $inc_switch = -d 'blib' ? '-Mblib' : '-Ilib'; + +use File::Spec; +use IPC::Open3; +use IO::Handle; + +open my $stdin, '<', File::Spec->devnull or die "can't open devnull: $!"; + +my @warnings; +for my $lib (@module_files) +{ + # see L + my $stderr = IO::Handle->new; + + my $pid = open3($stdin, '>&STDERR', $stderr, $^X, $inc_switch, '-e', "require q[$lib]"); + binmode $stderr, ':crlf' if $^O eq 'MSWin32'; + my @_warnings = <$stderr>; + waitpid($pid, 0); + is($?, 0, "$lib loaded ok"); + + shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/ + and not eval { require blib; blib->VERSION('1.01') }; + + if (@_warnings) + { + warn @_warnings; + push @warnings, @_warnings; + } +} + + + +is(scalar(@warnings), 0, 'no warnings found') + or diag 'got warnings: ', ( Test::More->can('explain') ? Test::More::explain(\@warnings) : join("\n", '', @warnings) ) if $ENV{AUTHOR_TESTING}; + + diff --git a/t/01_compile.t b/t/01_compile.t new file mode 100755 index 0000000..a78ae08 --- /dev/null +++ b/t/01_compile.t @@ -0,0 +1,13 @@ +#!/usr/bin/perl + +# Tests that File::Remove compiles ok + +use strict; +BEGIN { + $| = 1; + $^W = 1; +} + +use Test::More tests => 1; + +use_ok( 'File::Remove' ); diff --git a/t/02_directories.t b/t/02_directories.t new file mode 100755 index 0000000..7d0a1a4 --- /dev/null +++ b/t/02_directories.t @@ -0,0 +1,149 @@ +#!/usr/bin/perl + +use strict; +BEGIN { + $| = 1; + $^W = 1; +} + +use Test::More 'no_plan'; +use File::Remove qw{ remove trash }; + + + + + +# Set up the tests +my @dirs = ("$0.tmp", map { "$0.tmp/$_" } qw(a a/b c c/d e e/f g)); + +for my $path ( reverse @dirs ) { + if ( -e $path ) { + ok( rmdir($path), "rmdir: $path" ); + ok( !-e $path, "!-e: $path" ); + } +} + +for my $path ( @dirs ) { + ok( ! -e $path, "!-e: $path" ); + ok( mkdir($path, 0777), "mkdir: $path" ); + chmod 0777, $path; + ok( -e $path, "-e: $path" ); +} + +for my $path (reverse @dirs) { + ok( -e $path, "-e: $path" ); + ok( rmdir($path), "rmdir: $path" ); + ok( !-e $path, "!-e: $path" ); +} + +for my $path ( @dirs ) { + ok( ! -e $path, "!-e: $path" ); + ok( mkdir($path, 0777), "mkdir: $path" ); + chmod 0777, $path; + ok( -e $path, "-e: $path" ); +} + +for my $path (reverse @dirs) { + ok( -e $path, "-e: $path" ); + ok( remove(\1, $path), "remove \\1: $path" ); + ok( !-e $path, "!-e: $path" ); +} + +for my $path (@dirs) { + ok( !-e $path, "!-e: $path" ); + ok( mkdir($path, 0777), "mkdir: $path" ); + chmod 0777, $path; + ok( -e $path, "-e: $path" ); +} + +for my $path (reverse @dirs) { + ok( -e $path, "-e: $path" ); + ok( remove($path), "remove: $path" ); + ok( !-e $path, "!-e: $path" ); +} + +for my $path (reverse @dirs) { + ok( !-e $path, "-e: $path" ); + if (-e _) { + ok( rmdir($path), "rmdir: $path" ); + ok( !-e $path, "!-e: $path" ); + } +} + +SKIP: { + if ($^O eq 'darwin') { + eval 'use Mac::Glue ();'; + skip "Undelete support requires Mac::Glue", 0 if length $@; + eval 'Mac::Glue->new("Finder")'; + skip "Undelete support requires Mac::Glue with Finder support", 0 if length $@; + } elsif ($^O eq 'cygwin' || $^O =~ /^MSWin/) { + eval 'use Win32::FileOp::Recycle;'; + skip "Undelete support requires Win32::FileOp::Recycle", 0 if length $@; + } else { + skip "Undelete support not available by default", 0; + } + + for my $path (@dirs) { + ok( !-e $path, "!-e: $path" ); + ok( mkdir($path, 0777), "mkdir: $path" ); + chmod 0777, $path; + ok( -e $path, "-e: $path" ); + } + + for my $path (reverse @dirs) { + ok( -e $path, "-e: $path" ); + ok( eval { trash($path) }, "trash: $path" ); + is( $@, '', "trash: \$@" ); + ok( !-e $path, "!-e: $path" ); + } + + for my $path (reverse @dirs) { + ok( !-e $path, "-e: $path" ); + if (-e _) { + ok( rmdir($path), "rmdir: $path" ); + ok( !-e $path, "!-e: $path" ); + } + } + + for my $path (@dirs) { + ok( !-e $path, "!-e: $path" ); + ok( mkdir($path, 0777), "mkdir: $path" ); + chmod 0777, $path; + ok( -e $path, "-e: $path" ); + } + + for my $path (reverse @dirs) { + ok( -e $path, "-e: $path" ); + ok( remove($path), "remove: $path" ); + ok( !-e $path, "!-e: $path" ); + } + + for my $path (reverse @dirs) { + ok( !-e $path, "-e: $path" ); + if (-e _) { + ok( rmdir($path), "rmdir: $path" ); + ok( !-e $path, "!-e: $path" ); + } + } + + for my $path (@dirs) { + ok( !-e $path, "!-e: $path" ); + ok( mkdir($path, 0777), "mkdir: $path" ); + chmod 0777, $path; + ok( -e $path, "-e: $path" ); + } + + for my $path (reverse @dirs) { + ok( -e $path, "-e: $path" ); + ok( + # Fake callbacks will not remove directories, so trash() would return empty list + eval { trash({ 'rmdir' => sub { 1 }, 'unlink' => sub { 1 } }, $path); 1 }, + "trash: $path", + ); + ok( -e $path, "-e: $path" ); + ok( rmdir($path), "rmdir: $path" ); + ok( !-e $path, "!-e: $path" ); + } + + UNDELETE: 1; +} diff --git a/t/03_deep_readonly.t b/t/03_deep_readonly.t new file mode 100755 index 0000000..11927ef --- /dev/null +++ b/t/03_deep_readonly.t @@ -0,0 +1,90 @@ +#!/usr/bin/perl + +# Test that File::Remove can recursively remove a directory that +# deeply contains a readonly file that is owned by the current user. +use strict; +BEGIN { + $| = 1; + $^W = 1; +} + +use Test::More tests => 12; +use File::Spec::Functions ':ALL'; +use File::Copy (); +use File::Remove (); + + + + + +##################################################################### +# Set up for the test + +my $in = catdir( curdir(), 't' ); +ok( -d $in, 'Found t dir' ); +my $d1 = catdir( $in, 'd1' ); +my $d2 = catdir( $d1, 'd2' ); +my $f3 = catfile( $d2, 'f3.txt' ); + +sub create_directory { + mkdir($d1,0777) or die "Failed to create $d1"; + ok( -d $d1, "Created $d1 ok" ); + ok( -r $d1, "Created $d1 -r" ); + ok( -w $d1, "Created $d1 -w" ); + mkdir($d2,0777) or die "Failed to create $d2"; + ok( -d $d2, "Created $d2 ok" ); + ok( -r $d2, "Created $d2 -r" ); + ok( -w $d2, "Created $d2 -w" ); + # Copy in a known-readonly file (in this case, the File::Spec lib we are using + File::Copy::copy( $INC{'File/Spec.pm'} => $f3 ); + chmod( 0400, $f3 ); + ok( -f $f3, "Created $f3 ok" ); + ok( -r $f3, "Created $f3 -r" ); + SKIP: { + if ( $^O ne 'MSWin32' and ($< == 0 or $> == 0) ) { + skip("This test doesn't work as root", 1); + } + if ( $^O eq 'cygwin' ) { + skip("Fails on some cygwin and shouldn't prevent install",1); + } + ok( ! -w $f3, "Created $f3 ! -w" ); + }; +} + +sub clear_directory { + if ( -e $f3 ) { + chmod( 0700, $f3 ) or die "chmod 0700 $f3 failed"; + unlink( $f3 ) or die "unlink: $f3 failed"; + ! -e $f3 or die "unlink didn't work"; + } + if ( -e $d2 ) { + rmdir( $d2 ) or die "rmdir: $d2 failed"; + ! -e $d2 or die "rmdir didn't work"; + } + if ( -e $d1 ) { + rmdir( $d1 ) or die "rmdir: $d1 failed"; + ! -e $d1 or die "rmdir didn't work"; + } +} + +# Make sure there is no directory from a previous run +clear_directory(); + +# Create the directory +create_directory(); + +# Schedule cleanup +END { + clear_directory(); +} + + + + + +##################################################################### +# Main Testing + +# Call a recursive remove of the directory, nothing should be left after +ok( File::Remove::remove( \1, $d1 ), "remove('$d1') ok" ); +ok( ! -e $d1, "Removed the directory ok" ); diff --git a/t/04_can_delete.t b/t/04_can_delete.t new file mode 100644 index 0000000..2533c09 --- /dev/null +++ b/t/04_can_delete.t @@ -0,0 +1,91 @@ +#!/usr/bin/perl + +# Test that File::Remove can recursively remove a directory that +# deeply contains a readonly file that is owned by the current user. +use strict; +BEGIN { + $| = 1; + $^W = 1; +} + +use Test::More tests => 12; +use File::Spec::Functions ':ALL'; +use File::Copy (); +use File::Remove (); + + + + + +##################################################################### +# Set up for the test + +my $in = catdir( curdir(), 't', "04_can_delete-t.tmp" ); +mkdir($in); +ok( -d $in, 'Found t dir' ); +my $d1 = catdir( $in, 'd1' ); +my $d2 = catdir( $d1, 'd2' ); +my $f3 = catfile( $d2, 'f3.txt' ); + +sub create_directory { + mkdir($d1,0777) or die "Failed to create $d1"; + ok( -d $d1, "Created $d1 ok" ); + ok( -r $d1, "Created $d1 -r" ); + ok( -w $d1, "Created $d1 -w" ); + mkdir($d2,0777) or die "Failed to create $d2"; + ok( -d $d2, "Created $d2 ok" ); + ok( -r $d2, "Created $d2 -r" ); + ok( -w $d2, "Created $d2 -w" ); + # Copy in a known-readonly file (in this case, the File::Spec lib we are using + File::Copy::copy( $INC{'File/Spec.pm'} => $f3 ); + chmod( 0400, $f3 ); + ok( -f $f3, "Created $f3 ok" ); + ok( -r $f3, "Created $f3 -r" ); + SKIP: { + if ( $^O ne 'MSWin32' and $< == 0 ) { + skip("This test doesn't work as root", 1); + } + if ( $^O eq 'cygwin' ) { + skip("Fails on some cygwin and shouldn't prevent install",1); + } + ok( ! -w $f3, "Created $f3 ! -w" ); + }; +} + +sub clear_directory { + if ( -e $f3 ) { + chmod( 0700, $f3 ) or die "chmod 0700 $f3 failed"; + unlink( $f3 ) or die "unlink: $f3 failed"; + ! -e $f3 or die "unlink didn't work"; + } + if ( -e $d2 ) { + rmdir( $d2 ) or die "rmdir: $d2 failed"; + ! -e $d2 or die "rmdir didn't work"; + } + if ( -e $d1 ) { + rmdir( $d1 ) or die "rmdir: $d1 failed"; + ! -e $d1 or die "rmdir didn't work"; + } +} + +# Make sure there is no directory from a previous run +clear_directory(); + +# Create the directory +create_directory(); + +# Schedule cleanup +END { + clear_directory(); +} + + + + + +##################################################################### +# Main Testing + +# Call a recursive remove of the directory, nothing should be left after +is_deeply( [ File::Remove::remove( $f3 ) ], [ $f3 ], "remove('$f3') ok" ); +ok( ! -e $f3, "Removed the file ok" ); diff --git a/t/05_links.t b/t/05_links.t new file mode 100644 index 0000000..7f4a438 --- /dev/null +++ b/t/05_links.t @@ -0,0 +1,64 @@ +#!/usr/bin/perl + +use strict; +BEGIN { + $| = 1; + $^W = 1; +} + +use Test::More; +use File::Spec::Functions ':ALL'; +use File::Remove (); + +unless( eval { symlink("",""); 1 } ) { + plan("skip_all" => "No Unix-like symlinks"); + exit(0); +} + +plan( tests => 8 ); + +# Set up the tests +my $testdir = catdir( 't', 'linktest' ); +if ( -d $testdir ) { + File::Remove::remove( \1, $testdir ); + die "Failed to clear test directory '$testdir'" if -d $testdir; +} +ok( ! -d $testdir, 'Cleared testdir' ); +unless( mkdir($testdir, 0777) ) { + die("Cannot create test directory '$testdir': $!"); +} +ok( -d $testdir, 'Created testdir' ); +my %links = ( + l_ex => curdir(), +# l_ex_a => rootdir(), + l_nex => 'does_not_exist' +); +my $errs = 0; +foreach my $link (keys %links) { + my $path = catdir( $testdir, $link ); + unless( symlink($links{$link}, $path )) { + diag("Cannot create symlink $link -> $links{$link}: $!"); + $errs++; + } +} +if ( $errs ) { + die("Could not create test links"); +} + +ok( File::Remove::remove(\1, map { catdir($testdir, $_) } keys %links), "remove \\1: all links" ); + +my @entries; + +ok( opendir(DIR, $testdir) ); +foreach my $dir ( readdir(DIR) ) { + next if $dir eq curdir(); + next if $dir eq updir(); + push @entries, $dir; +} +ok( closedir(DIR) ); + +ok( @entries == 0, "no links remained in directory; found @entries" ); + +ok( File::Remove::remove(\1, $testdir), "remove \\1: $testdir" ); + +ok( ! -e $testdir, "!-e: $testdir" ); diff --git a/t/06_curly.t b/t/06_curly.t new file mode 100644 index 0000000..645ecfa --- /dev/null +++ b/t/06_curly.t @@ -0,0 +1,37 @@ +#!/usr/bin/perl + +# Regression test for rt.cpan.org #30251. + +# Test that a directory called '{1234}' is deleted correctly. + +use strict; +BEGIN { + $| = 1; + $^W = 1; +} + +use Test::More tests => 6; +use File::Spec::Functions ':ALL'; +use File::Remove (); + +# Create the test directory +my $dir = '{1234}'; +my $path = catdir( 't', '{1234}' ); +unless ( -e $path ) { + mkdir($path,0777); +} +ok( -e $path, "Test directory $path exists" ); + +# Delete the test directory +my @removed = File::Remove::remove( \1, $path ); +is_deeply( \@removed, [ $path ], 'remove returns as expected' ); +ok( ! -e $path, "remove deletes the $path directory" ); + +# Repeat the tests on a dir named {1234} in the root path +unless ( -e $dir ) { + mkdir($dir,0777); +} +ok( -e $dir, "Test directory $dir exists" ); +@removed = File::Remove::remove( \1, $dir ); +is_deeply( \@removed, [ $dir ], 'remove returns as expected' ); +ok( ! -e $path, "remove delete the $dir directory" ); diff --git a/t/07_cwd.t b/t/07_cwd.t new file mode 100644 index 0000000..180b356 --- /dev/null +++ b/t/07_cwd.t @@ -0,0 +1,89 @@ +#!/usr/bin/perl + +use strict; +BEGIN { + $| = 1; + $^W = 1; +} + +use Test::More tests => 13; +use File::Spec::Functions ':ALL'; +use File::Remove (); +use Cwd (); + +# Create the test directories +my $base = Cwd::abs_path(Cwd::cwd()); +my $cwd = rel2abs(catdir('t', 'cwd')); +my $foo = rel2abs(catdir('t', 'cwd', 'foo')); +my $file = rel2abs(catdir('t', 'cwd', 'foo', 'bar.txt')); +File::Remove::clear($cwd); +mkdir($cwd,0777) or die "mkdir($cwd): $!"; +mkdir($foo,0777) or die "mkdir($foo): $!"; +open( FILE, ">$file" ) or die "open($file): $!"; +print FILE "blah\n"; +close( FILE ) or die "close($file): $!"; +ok( -d $cwd, "$cwd directory exists" ); +ok( -d $foo, "$foo directory exists" ); +ok( -f $file, "$file file exists" ); + +# Test that _moveto behaves as expected +SCOPE: { + is( + File::Remove::_moveto( + File::Spec->catdir($base, 't'), # remove + File::Spec->catdir($base), # cwd + ), + '', + '_moveto returns correct for normal case', + ); + + my $moveto1 = File::Remove::_moveto( + File::Spec->catdir($base, 't'), # remove + File::Spec->catdir($base, 't'), # cwd + ); + $moveto1 =~ s/\\/\//g; + is( $moveto1, $base, '_moveto returns correct for normal case' ); + + my $moveto2 = File::Remove::_moveto( + File::Spec->catdir($base, 't'), # remove + File::Spec->catdir($base, 't', 'cwd'), # cwd + ); + $moveto2 =~ s/\\/\//g; + is( $moveto2, $base, '_moveto returns correct for normal case' ); + + # Regression: _moveto generates false positives + # cwd: /tmp/cpan2/PITA-Image/PITA-Image-0.50 + # remove: /tmp/eBtQxTPGHC + # moveto: /tmp + # expected: '' + is( + File::Remove::_moveto( + File::Spec->catdir($base, 't'), # remove + File::Spec->catdir($base, 'lib', 'File'), # cwd + ), + '', + '_moveto returns null as expected', + ); +} + +# Change the current working directory into the first +# test directory and store the absolute path. +chdir($cwd) or die "chdir($cwd): $!"; +my $cwdabs = Cwd::abs_path(Cwd::cwd()); +ok( $cwdabs =~ /\bcwd$/, "Expected abs path is $cwdabs" ); + +# Change into the directory that should be deleted +chdir('foo') or die "chdir($foo): $!"; +my $fooabs = Cwd::abs_path(Cwd::cwd()); +ok( $fooabs =~ /\bfoo$/, "Deleting from abs path is $fooabs" ); + +# Delete the foo directory +ok( File::Remove::remove(\1, $foo), "remove($foo) ok" ); + +# We should now be in the bottom directory again +is( Cwd::abs_path(Cwd::cwd()), $cwdabs, "We are now back in the original directory" ); + +# Move back to the base dir and confirm everything was deleted. +chdir($base) or die "chdir($base): $!"; +ok( ! -e $foo, "$foo does not exist" ); +ok( ! -e $file, "$file does not exist" ); diff --git a/t/08_spaces.t b/t/08_spaces.t new file mode 100644 index 0000000..7e47232 --- /dev/null +++ b/t/08_spaces.t @@ -0,0 +1,87 @@ +#!/usr/bin/perl + +# Test that File::Remove (with or without globbing) supports the use of +# spaces in the path to delete. + +use strict; +BEGIN { + $| = 1; + $^W = 1; +} + +use Test::More qw(no_plan); +use File::Spec::Functions ':ALL'; +use File::Copy (); +use File::Remove (); + + + + + +##################################################################### +# Set up for the test + +my $t = catdir( curdir(), 't' ); +my $s = catdir( $t, 'spaced path' ); +my $f1 = catfile( $s, 'foo1.txt' ); +my $f2 = catfile( $s, 'foo2.txt' ); +my $f3 = catfile( $s, 'bar.txt' ); + +sub create_directory { + mkdir($s,0777) or die "Failed to create $s"; + ok( -d $s, "Created $s ok" ); + ok( -r $s, "Created $s -r" ); + ok( -w $s, "Created $s -w" ); + open( FILE, ">$f1" ) or die "Failed to create $f1"; + print FILE "Test\n"; + close FILE; + open( FILE, ">$f2" ) or die "Failed to create $f2"; + print FILE "Test\n"; + close FILE; + open( FILE, ">$f3" ) or die "Failed to create $f3"; + print FILE "Test\n"; + close FILE; +} + +sub clear_directory { + if ( -e $f1 ) { + unlink( $f1 ) or die "unlink: $f1 failed"; + ! -e $f1 or die "unlink didn't work"; + } + if ( -e $f2 ) { + unlink( $f2 ) or die "unlink: $f2 failed"; + ! -e $f2 or die "unlink didn't work"; + } + if ( -e $f3 ) { + unlink( $f3 ) or die "unlink: $f3 failed"; + ! -e $f3 or die "unlink didn't work"; + } + if ( -e $s ) { + rmdir( $s ) or die "rmdir: $s failed"; + ! -e $s or die "rmdir didn't work"; + } +} + +# Make sure there is no directory from a previous run +clear_directory(); + +# Create the directory +create_directory(); + +# Schedule cleanup +END { + clear_directory(); +} + + + + + +##################################################################### +# Main Testing + +# Expand a glob that should match the foo files +my @match = File::Remove::expand('t/spaced path/foo*'); +is( scalar(@match), 2, 'Found two results' ); +ok( $match[0] =~ /foo1.txt/, 'Found foo1' ); +ok( $match[1] =~ /foo2.txt/, 'Found foo2' ); diff --git a/t/09_fork.t b/t/09_fork.t new file mode 100644 index 0000000..029cfb3 --- /dev/null +++ b/t/09_fork.t @@ -0,0 +1,47 @@ +#!/usr/bin/perl + +# Ensure that we don't prematurely END-time delete due to forking + +use strict; +BEGIN { + $| = 1; + $^W = 1; +} + +use Test::More tests => 8; +use File::Spec::Functions ':ALL'; +use File::Remove (); + +# Create a directory +my $parent = catdir( 't', '09_fork_parent' ); +my $child = catdir( 't', '09_fork_child' ); +File::Remove::clear($parent); +File::Remove::remove($child); +ok( ! -d $parent, 'Parent directory does not exist' ); +ok( ! -d $child, 'Child directory does not exist' ); +ok( mkdir( $parent, 0777 ), 'Created directory' ); +ok( -d $parent, 'Directory exists' ); + +# Fork the test +my $pid = fork(); +unless ( $pid ) { + # Create a child-owned directory and flag for deletion + File::Remove::clear($child); + mkdir( $child, 0777 ); + sleep(2); + + # Exit from the child to stimulate END-time code + exit(0); +} + +# In the parent, wait 1 second for process to spawn +# and create the child directory +sleep(1); +ok( -d $child, 'Child directory created (by forked child)' ); + +# Wait for the child to exit +my $caught = wait(); +is( $pid, $caught, 'The child exited' ); +sleep(1); # Give a chance for flakey windows to delete directory +ok( -d $parent, 'Parent directory still exists' ); +ok( ! -d $child, 'Child directory is removed' ); diff --git a/t/10_noglob.t b/t/10_noglob.t new file mode 100644 index 0000000..8590e27 --- /dev/null +++ b/t/10_noglob.t @@ -0,0 +1,73 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use 5.006; + +use File::Spec (); +use Cwd (qw/getcwd/); + +use File::Path qw/rmtree/; + +use Test::More tests => 3; + +use File::Remove qw/remove/; + +{ + my $dir = File::Spec->rel2abs( + File::Spec->catdir( + File::Spec->curdir(), "t", "10_noglob_dir", + ) + ); + + mkdir($dir); + + my $file_path = sub { + my ($bn) = @_; + return File::Spec->catfile($dir, $bn); + }; + + my $create_file = sub { + my ($bn, $contents) = @_; + + open my $fh, '>', $file_path->($bn) + or die "Cannot create basename '$bn'"; + print {$fh} $contents; + close ($fh); + + return; + }; + + $create_file->("a", "a contents\n"); + $create_file->("b", "b contents\n"); + $create_file->("c", "c contents\n"); + + my $cur_dir = getcwd(); + + chdir ($dir); + + remove(\0, +{ glob => 0 }, '*'); + + my $is_file = sub { + my ($bn) = @_; + + local $Test::Builder::Level = $Test::Builder::Level + 1; + + return ok (scalar(-e $file_path->($bn)), "$bn was not deleted."); + }; + + # TEST + $is_file->('a'); + + # TEST + $is_file->('b'); + + # TEST + $is_file->('c'); + + chdir ($cur_dir); + + rmtree ($dir); +} + diff --git a/t/author-pod-coverage.t b/t/author-pod-coverage.t new file mode 100644 index 0000000..094d8f5 --- /dev/null +++ b/t/author-pod-coverage.t @@ -0,0 +1,15 @@ +#!perl + +BEGIN { + unless ($ENV{AUTHOR_TESTING}) { + require Test::More; + Test::More::plan(skip_all => 'these tests are for testing by the author'); + } +} + +# This file was automatically generated by Dist::Zilla::Plugin::PodCoverageTests. + +use Test::Pod::Coverage 1.08; +use Pod::Coverage::TrustPod; + +all_pod_coverage_ok({ coverage_class => 'Pod::Coverage::TrustPod' }); diff --git a/t/author-pod-syntax.t b/t/author-pod-syntax.t new file mode 100644 index 0000000..35fb1b9 --- /dev/null +++ b/t/author-pod-syntax.t @@ -0,0 +1,15 @@ +#!perl + +BEGIN { + unless ($ENV{AUTHOR_TESTING}) { + require Test::More; + Test::More::plan(skip_all => 'these tests are for testing by the author'); + } +} + +# 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(); diff --git a/t/release-cpan-changes.t b/t/release-cpan-changes.t new file mode 100644 index 0000000..214650f --- /dev/null +++ b/t/release-cpan-changes.t @@ -0,0 +1,19 @@ +#!perl + +BEGIN { + unless ($ENV{RELEASE_TESTING}) { + require Test::More; + Test::More::plan(skip_all => 'these tests are for release candidate testing'); + } +} + + +use strict; +use warnings; + +use Test::More 0.96 tests => 2; +use_ok('Test::CPAN::Changes'); +subtest 'changes_ok' => sub { + changes_file_ok('Changes'); +}; +done_testing(); diff --git a/t/release-kwalitee.t b/t/release-kwalitee.t new file mode 100644 index 0000000..e641ee8 --- /dev/null +++ b/t/release-kwalitee.t @@ -0,0 +1,19 @@ +#!perl + +BEGIN { + unless ($ENV{RELEASE_TESTING}) { + require Test::More; + Test::More::plan(skip_all => 'these tests are for release candidate testing'); + } +} + + +# This test is generated by Dist::Zilla::Plugin::Test::Kwalitee::Extra +use strict; +use warnings; +use Test::More; # needed to provide plan. + +eval { require Test::Kwalitee::Extra }; +plan skip_all => "Test::Kwalitee::Extra required for testing kwalitee: $@" if $@; + +eval "use Test::Kwalitee::Extra"; diff --git a/t/release-trailing-space.t b/t/release-trailing-space.t new file mode 100644 index 0000000..55df58a --- /dev/null +++ b/t/release-trailing-space.t @@ -0,0 +1,38 @@ +#!perl + +BEGIN { + unless ($ENV{RELEASE_TESTING}) { + require Test::More; + Test::More::plan(skip_all => 'these tests are for release candidate testing'); + } +} + + +use strict; +use warnings; + +use Test::More; + +eval "use Test::TrailingSpace"; +if ($@) +{ + plan skip_all => "Test::TrailingSpace required for trailing space test."; +} +else +{ + plan tests => 1; +} + +# TODO: add .pod, .PL, the README/Changes/TODO/etc. documents and possibly +# some other stuff. +my $finder = Test::TrailingSpace->new( + { + root => '.', + filename_regex => qr#(?:\.(?:t|pm|pl|xs|c|h|txt|pod|PL)|README|Changes|TODO|LICENSE)\z#, + }, +); + +# TEST +$finder->no_trailing_space( + "No trailing space was found." +); diff --git a/weaver.ini b/weaver.ini new file mode 100644 index 0000000..19caafa --- /dev/null +++ b/weaver.ini @@ -0,0 +1,37 @@ +[@CorePrep] + +[Generic / NAME] + +[Version] + +[Region / prelude] + + +[Generic / SYNOPSIS] +[Generic / DESCRIPTION] +[Generic / OVERVIEW] + +[Collect / ATTRIBUTES] +command = attr + +[Collect / METHODS] +command = method + +[Leftovers] + +[Region / postlude] + +[Authors] +[Legal] + +; [Generic / DESCRIPTION] +; required = 1 + +; [Generic / BUGS] + +; [Generic / Section::Bugs] +; [Generic / Section::License] +; +[Bugs] +[Support] +all_modules = 1