Path-Tiny-0.052/000755 000765 000024 00000000000 12265322344 013572 5ustar00davidstaff000000 000000 Path-Tiny-0.052/Changes000644 000765 000024 00000027475 12265322344 015104 0ustar00davidstaff000000 000000 Revision history for Path-Tiny 0.052 2014-01-14 15:58:03-05:00 America/New_York [FIXED] - Backslash-to-slash conversion now only happens on Windows (since backslash is legal on Unix, we must allow it) 0.051 2013-12-20 07:34:14 America/New_York [FIXED] - Fixed file order bug in the new test file 0.050 2013-12-20 07:27:20 America/New_York [FIXED] - Recursive iteration won't throw an exception if a directory is removed or unreadable during iteration. 0.049 2013-12-12 00:48:01 America/New_York [FIXED] - Generates filename for atomic writes independent of thread-ID. Fixes crashing bug on Win32 when fork() is called. 0.048 2013-12-11 21:56:23 America/New_York [ADDED] - Added 'subsumes' method [CHANGED] - The 'chomp' option for 'lines' will remove any end-of-line sequences fully instead of just chomping the last character - The 'flock' package will no longer indexed by PAUSE [FIXED] - Hides warnings and fixes possible fatal errors from pure-perl Cwd, particularly on MSWin32 0.047 2013-11-26 15:11:13 America/New_York [FIXED] - Previous lock testing fixes broke on Windows (sigh); now fixed, I hope. 0.046 2013-11-22 17:07:24 America/New_York [FIXED] - Revised locking tests for portability again: locks are now tested from a separate process 0.045 2013-11-22 15:28:50 America/New_York [FIXED] - Fixed locking test on AIX 0.044 2013-10-17 17:00:41 America/New_York [FIXED] - Fixed child path construction against the root path. - Fixed path construction when a relative volume is provided as the first argument on Windows; e.g. path("C:", "lib") must be like path("C:lib"), not path("C:/lib"). - On AIX, shared locking is replaced by exclusive locking on a R/W filehandle, as locking read handles is not supported 0.043 2013-10-14 06:24:06 America/New_York [CHANGED] - Calling 'absolute' on Windows will add the volume if it is missing (E.g. "/foo" will become "C:/foo"). This matches the behavior of File::Spec->rel2abs. [FIXED] - Fixed t/00-report-prereqs.t for use with older versions of CPAN::Meta::Requirements 0.042 2013-10-13 11:02:02 America/New_York [FIXED] - When 'realpath' can't be resolved (because intermediate directories don't exist), the exception now explains the error clearly instead of complaining about path() needing a defined, positive-length argument. - On Windows, fixed resolution of relative paths with a volume. E.g. "C:foo" is now correctly translated into getdcwd on "C:" plus "foo". 0.041 2013-10-11 08:56:31 America/New_York [FIXES] - Removes duplicate test dependency on File::Spec that triggers a CPAN.pm bug 0.040 2013-10-08 22:01:50 America/New_York [FIXES] - Fixed broken locking test on *bsd - When using 'filehandle' to request a locked handle that truncates an existing file and has a binmode starting with ":unix", this fixes a bug where pseudo-layers weren't being cleared properly. 0.039 2013-10-08 16:39:23 America/New_York [ADDITIONS] - The 'filehandle' method now offers an option to return locked handles based on the file mode. Input-output methods now rely on this feature internally. Truncating file modes defer truncation until after an exclusive lock is acquired. [FIXES] - The 'filehandle' method now respects default encoding set by the caller's open pragma. 0.038 2013-10-01 18:20:05 America/New_York [ADDITIONS] - Added 'is_rootdir' method to simplify testing if a path is the root directory 0.037 2013-09-25 13:00:25 America/New_York [FIXES] - Fixed for v5.8 0.036 2013-09-25 09:34:28 America/New_York [PREREQS] - No longer lists 'threads' as a prerequisite. If you have a threaded perl, you have it and if you're not, Path::Tiny doesn't care. 0.035 2013-09-24 07:21:55 America/New_York [FIXED] - Fixed flock warning on BSD that was broken with the autodie removal; now also applies to all BSD flavors 0.034 2013-09-23 16:16:36 America/New_York [INCOMPATIBLE CHANGE] - Exceptions are now Path::Tiny::Error objects, not autodie exceptions; this removes the last dependency on autodie, which allows us to support Perls as far back as v5.8.1 [FIXED] - BSD/NFS flock fix was not backwards compatible before v5.14. This fixes it harder. [PREREQS] - dropped autodie - lowered ExtUtils::MakeMaker configure_requires version to 6.17 0.033 2013-09-12 08:54:30 America/New_York [FIXED] - Perl on BSD may not support locking on an NFS filesystem. If this is detected, Path::Tiny warns and continues in an unsafe mode. The 'flock' warning category may be fatalized to die instead. [DOCUMENTED] - Added 'iterator' example showing defaults 0.032 2013-09-06 17:52:48 America/New_York [PREREQS] - Removed several test dependencies. Path::Tiny now only needs core modules, though some must be upgraded on old Perls 0.031 2013-08-27 10:03:57 America/New_York [FIXED] - parent() on paths with internal double dots (e.g. /foo..bar.txt) now works correctly 0.030 2013-08-20 16:10:04 America/New_York [FIXED] - t/zzz-spec.t used getcwd() instead of getdcwd(), which breaks on Windows if the build directory isn't on the 'C' drive 0.029 2013-08-19 11:52:24 America/New_York [FIXED] - On Win32, "C:/" no longer is changed to "C:". Also, "C:" is converted to the absolute path of cwd on the "C:" volume. UNC paths ("//server/share/") now retain their trailing slash to correctly distinguish volume and directory paths when split 0.028 2013-08-14 13:12:49 America/New_York [ADDED] - The 'children()' method now takes an optional regular expression to filter the results 0.027 2013-07-25 19:38:44 America/New_York [ADDED] - Added the 'digest' method to produce a hexadecimal SHA-256 (or user-specified) digest of a file 0.026 2013-07-14 21:25:22 America/New_York [FIXED] - Fixed bug where lines() with a count longer than the file would return undef for the extra lines. Now returns only the lines in the file if the count is greater than the number of lines. 0.025 2013-07-10 09:32:13 America/New_York [FIXED] - Spew to an existing symlink now atomically replaces the resolved destination, not the symlink 0.024 2013-06-17 18:12:36 America/New_York [FIXED] - Win32 pseudo-forks don't load threads.pm, so we do that in CLONE to ensure we get the thread ID 0.023 2013-06-12 07:18:31 America/New_York [FIXED] - Removing dangling symlinks now works 0.022 2013-05-28 11:57:15 America/New_York [ADDED] - The 'touch' method can now take an epoch secs argument 0.021 2013-05-17 22:53:18 America/New_York [FIXED] - Fixed fatal bug with lines_utf8 using chomp [DOCS] - Pod typos fixed 0.020 2013-04-13 06:58:11 Europe/London [FIXED] - More descriptive error message if copy() fails 0.019 2013-04-12 06:58:18 Europe/London [FIXED] - Fixed warning about -l on dirhandle in iterator() 0.018 2013-04-08 12:44:31 America/New_York [ADDED] - cwd, rootdir, tempfile and tempdir can now be exported on request and used as functions instead of as methods [FIXED] - Fixed regression in lines() where it no longer returned count of lines in scalar context 0.017 2013-03-28 16:49:15 America/New_York [ADDED] - path() constructor now glob-expands tildes (~) [CHANGED] - Improved options validation; invalid options now throw errors 0.016 2013-03-26 14:59:36 America/New_York [ADDED] - The iterator now has an optional recursive mode [CHANGED] - We no longer use autodie directly, but we throw our own autodie::exceptions on error. This avoids the overhead of wrapping built-ins with function calls. - Most dependencies are now loaded on demand, reducing startup time. 0.015 2013-03-13 13:20:38 America/New_York [CHANGED] - touch and touchpath now return the object to allow easy chaining with spew 0.014 2013-03-09 08:54:26 America/New_York [ADDED] - parent now takes an optional argument to look upwards multiple times in one call. e.g. $path->parent(2) 0.013 2013-02-22 10:58:05 America/New_York [CHANGED] - remove_tree now defaults to safe mode and will not attempt to chmod and remove directories with insufficient permissions - Temporary files and directories are always created with an absolute path. [FIXED] - Failures from autodie are reported from our caller's location (as if we called croak()); bumped autodie prereq to 2.14 for this feature - Failures from mkpath and remove_tree are now trapped and thrown as exceptions. (Making an existing path or removing a non-existant path return false and are not errors); 0.012 2013-02-20 09:34:50 America/New_York [REMOVED] - The 'remove' function no longer works on directories. The new 'remove_tree' method should be used instead. [CHANGED] - path() now requires a defined, positive-length argument to keep you safe from subtle bugs in your code that pass an undef or empty argument to path suddenly having you operating in the current directory. [ADDED] - Added Path::Tiny->cwd as a constructor to give an absolute path to the current working directory - Added 'remove_tree' as a method for recursively removing a directory 0.011 2013-02-19 11:08:44 America/New_York [CHANGED] - slurp/spew/etc and openr/openw/etc now repect default layers set by -C or the open pragma - spew and append can now be given array references to output to avoid extra copying 0.010 2013-02-16 10:26:38 America/New_York [FIXED] - The 'tempdir' and 'tempfile' methods can now both take either leading templates or a TEMPLATE option, so you don't have to remember which one File::Temp wants 0.009 2013-02-15 16:05:39 America/New_York [CHANGED] - Dropped use of '//' to allow Path::Tiny to run on Perl 5.008 0.008 2013-02-15 13:49:54 America/New_York [ADDED] - Added 'touchpath' method combining 'mkpath' and 'touch' 0.007 2013-02-12 17:41:44 America/New_York [FIXED] - Unicode::UTF8 0.58 is necessary for optional faster Unicode processing 0.006 2013-02-11 13:22:18 America/New_York [FIXED] - t/parent.t is amended to work on Windows - new() now correctly takes multiple path arguments, like path() 0.005 2013-02-07 15:41:32 America/New_York [FIXED] - Fixed test for platforms with /sbin symlinked to /usr/sbin 0.004 2013-02-05 19:19:46 America/New_York [ADDED] - Added slurp_raw and other *_raw helper methods - Added realpath method (with thanks to ether) - Added canonpath method (with thanks to sjmiller) [FIXED] - slurp/lines/spew/append now do appropriate flocking - Fixed test that fails if run as root (bingos) - Fixed test that fails if cwd/getcwd don't agree [CHANGED] - internal optimizations 0.003 2013-01-31 06:59:50 America/New_York [FIXED] - lstat was calling the wrong stat [rt.cpan.org #83063] - make atomic writes thread-safe [rt.cpan.org #83064] [CHANGED] - updated bugtracker to point to github 0.002 2013-01-30 22:09:37 America/New_York [FIXED] - s/File::Stat/File::stat/; # OMG! I hate case insensitivity 0.001 2013-01-30 19:36:22 America/New_York - First release Path-Tiny-0.052/CONTRIBUTING000644 000765 000024 00000004234 12265322344 015427 0ustar00davidstaff000000 000000 ## HOW TO CONTRIBUTE Thank you for considering contributing to this distribution. This file contains instructions that will help you work with the source code. The distribution is managed with Dist::Zilla. This means than many of the usual files you might expect are not in the repository, but are generated at release time (e.g. Makefile.PL). ### Getting dependencies See the included `cpanfile` file for a list of dependencies. If you have App::cpanminus 1.6 or later installed, you can use `cpanm` to satisfy dependencies like this: $ cpanm --installdeps . Otherwise, you can install Module::CPANfile 1.0002 or later and then satisfy dependencies with the regular `cpan` client and `cpanfile-dump`: $ cpan `cpanfile-dump` ### Running tests You can run tests directly using the `prove` tool: $ prove -l $ prove -lv t/some_test_file.t For most distributions, `prove` is entirely sufficent for you to test any patches you have. ### Code style and tidying Please try to match any existing coding style. If there is a `.perltidyrc` file, please install Perl::Tidy and use perltidy before submitting patches. If there is a `tidyall.ini` file, you can also install Code::TidyAll and run `tidyall` on a file or `tidyall -a` to tidy all files. ### Patching documentation Much of the documentation Pod is generated at release time. Depending on the distribution, some documentation may be written in a Pod dialect called WikiDoc. (See Pod::WikiDoc on CPAN.) If you would like to submit a documentation edit, please limit yourself to the documentation you see. If you see typos or documentation issues in the generated docs, please email or open a bug ticket instead of patching. ### Learning Dist::Zilla Dist::Zilla is a very powerful authoring tool, but requires a number of author-specific plugins. If you would like to use it for contributing, install it from CPAN, then run one of the following commands, depending on your CPAN client: $ cpan `dzil authordeps` $ dzil authordeps | cpanm Once installed, here are some dzil commands you might try: $ dzil build $ dzil test $ dzil xtest You can learn more about Dist::Zilla at http://dzil.org/ Path-Tiny-0.052/cpanfile000644 000765 000024 00000003314 12265322344 015277 0ustar00davidstaff000000 000000 requires "Carp" => "0"; requires "Cwd" => "0"; requires "Digest" => "1.03"; requires "Digest::SHA" => "5.45"; requires "Exporter" => "5.57"; requires "Fcntl" => "0"; requires "File::Copy" => "0"; requires "File::Path" => "2.07"; requires "File::Spec" => "3.40"; requires "File::Temp" => "0.19"; requires "File::stat" => "0"; requires "constant" => "0"; requires "if" => "0"; requires "overload" => "0"; requires "perl" => "5.008001"; requires "strict" => "0"; requires "warnings" => "0"; recommends "Unicode::UTF8" => "0.58"; on 'test' => sub { requires "ExtUtils::MakeMaker" => "0"; requires "File::Basename" => "0"; requires "File::Spec::Functions" => "0"; requires "File::Spec::Unix" => "0"; requires "File::Temp" => "0.19"; requires "List::Util" => "0"; requires "Test::More" => "0.96"; requires "lib" => "0"; requires "open" => "0"; }; on 'test' => sub { recommends "CPAN::Meta" => "0"; recommends "CPAN::Meta::Requirements" => "0"; recommends "Test::FailWarnings" => "0"; }; on 'configure' => sub { requires "ExtUtils::MakeMaker" => "6.17"; }; on 'develop' => sub { requires "Dist::Zilla" => "5.011"; requires "Dist::Zilla::Plugin::MakeMaker" => "0"; requires "Dist::Zilla::Plugin::OnlyCorePrereqs" => "0"; requires "Dist::Zilla::Plugin::Prereqs" => "0"; requires "Dist::Zilla::Plugin::RemovePrereqs" => "0"; requires "Dist::Zilla::PluginBundle::DAGOLDEN" => "0.055"; requires "File::Spec" => "0"; requires "File::Temp" => "0"; requires "IO::Handle" => "0"; requires "IPC::Open3" => "0"; requires "Pod::Coverage::TrustPod" => "0"; requires "Test::CPAN::Meta" => "0"; requires "Test::More" => "0"; requires "Test::Pod" => "1.41"; requires "Test::Pod::Coverage" => "1.08"; }; Path-Tiny-0.052/dist.ini000644 000765 000024 00000002052 12265322344 015235 0ustar00davidstaff000000 000000 name = Path-Tiny author = David Golden license = Apache_2_0 copyright_holder = David Golden copyright_year = 2013 [@DAGOLDEN] :version = 0.055 -remove = MakeMaker stopwords = AIX stopwords = BENCHMARKING stopwords = CRLF stopwords = SHA stopwords = NFS stopwords = canonpath stopwords = codepoints stopwords = cwd stopwords = dirname stopwords = fatalize stopwords = lstat stopwords = mkpath stopwords = opena stopwords = openr stopwords = openrw stopwords = openw stopwords = realpath stopwords = stringifying stopwords = subclasses stopwords = touchpath stopwords = UNC stopwords = unlinked stopwords = utf MetaNoIndex.package = flock [MakeMaker] eumm_version = 6.17 [RemovePrereqs] remove = Unicode::UTF8 remove = Path::Class remove = Test::FailWarnings remove = threads ; Digest/Digest::SHA are fine in 5.10.0+ [Prereqs] Digest = 1.03 Digest::SHA = 5.45 File::Path = 2.07 File::Temp = 0.18 [Prereqs / Recommends] Unicode::UTF8 = 0.58 [Prereqs / TestRecommends] Test::FailWarnings = 0 [OnlyCorePrereqs] starting_version = current Path-Tiny-0.052/lib/000755 000765 000024 00000000000 12265322344 014340 5ustar00davidstaff000000 000000 Path-Tiny-0.052/LICENSE000644 000765 000024 00000026354 12265322344 014611 0ustar00davidstaff000000 000000 This software is Copyright (c) 2013 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 Apache License Version 2.0, January 2004 http://www.apache.org/licenses/ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 1. Definitions. "License" shall mean the terms and conditions for use, reproduction, and distribution as defined by Sections 1 through 9 of this document. "Licensor" shall mean the copyright owner or entity authorized by the copyright owner that is granting the License. "Legal Entity" shall mean the union of the acting entity and all other entities that control, are controlled by, or are under common control with that entity. For the purposes of this definition, "control" means (i) the power, direct or indirect, to cause the direction or management of such entity, whether by contract or otherwise, or (ii) ownership of fifty percent (50%) or more of the outstanding shares, or (iii) beneficial ownership of such entity. "You" (or "Your") shall mean an individual or Legal Entity exercising permissions granted by this License. "Source" form shall mean the preferred form for making modifications, including but not limited to software source code, documentation source, and configuration files. "Object" form shall mean any form resulting from mechanical transformation or translation of a Source form, including but not limited to compiled object code, generated documentation, and conversions to other media types. "Work" shall mean the work of authorship, whether in Source or Object form, made available under the License, as indicated by a copyright notice that is included in or attached to the work (an example is provided in the Appendix below). "Derivative Works" shall mean any work, whether in Source or Object form, that is based on (or derived from) the Work and for which the editorial revisions, annotations, elaborations, or other modifications represent, as a whole, an original work of authorship. For the purposes of this License, Derivative Works shall not include works that remain separable from, or merely link (or bind by name) to the interfaces of, the Work and Derivative Works thereof. "Contribution" shall mean any work of authorship, including the original version of the Work and any modifications or additions to that Work or Derivative Works thereof, that is intentionally submitted to Licensor for inclusion in the Work by the copyright owner or by an individual or Legal Entity authorized to submit on behalf of the copyright owner. For the purposes of this definition, "submitted" means any form of electronic, verbal, or written communication sent to the Licensor or its representatives, including but not limited to communication on electronic mailing lists, source code control systems, and issue tracking systems that are managed by, or on behalf of, the Licensor for the purpose of discussing and improving the Work, but excluding communication that is conspicuously marked or otherwise designated in writing by the copyright owner as "Not a Contribution." "Contributor" shall mean Licensor and any individual or Legal Entity on behalf of whom a Contribution has been received by Licensor and subsequently incorporated within the Work. 2. Grant of Copyright License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable copyright license to reproduce, prepare Derivative Works of, publicly display, publicly perform, sublicense, and distribute the Work and such Derivative Works in Source or Object form. 3. Grant of Patent License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except as stated in this section) patent license to make, have made, use, offer to sell, sell, import, and otherwise transfer the Work, where such license applies only to those patent claims licensable by such Contributor that are necessarily infringed by their Contribution(s) alone or by combination of their Contribution(s) with the Work to which such Contribution(s) was submitted. If You institute patent litigation against any entity (including a cross-claim or counterclaim in a lawsuit) alleging that the Work or a Contribution incorporated within the Work constitutes direct or contributory patent infringement, then any patent licenses granted to You under this License for that Work shall terminate as of the date such litigation is filed. 4. Redistribution. You may reproduce and distribute copies of the Work or Derivative Works thereof in any medium, with or without modifications, and in Source or Object form, provided that You meet the following conditions: (a) You must give any other recipients of the Work or Derivative Works a copy of this License; and (b) You must cause any modified files to carry prominent notices stating that You changed the files; and (c) You must retain, in the Source form of any Derivative Works that You distribute, all copyright, patent, trademark, and attribution notices from the Source form of the Work, excluding those notices that do not pertain to any part of the Derivative Works; and (d) If the Work includes a "NOTICE" text file as part of its distribution, then any Derivative Works that You distribute must include a readable copy of the attribution notices contained within such NOTICE file, excluding those notices that do not pertain to any part of the Derivative Works, in at least one of the following places: within a NOTICE text file distributed as part of the Derivative Works; within the Source form or documentation, if provided along with the Derivative Works; or, within a display generated by the Derivative Works, if and wherever such third-party notices normally appear. The contents of the NOTICE file are for informational purposes only and do not modify the License. You may add Your own attribution notices within Derivative Works that You distribute, alongside or as an addendum to the NOTICE text from the Work, provided that such additional attribution notices cannot be construed as modifying the License. You may add Your own copyright statement to Your modifications and may provide additional or different license terms and conditions for use, reproduction, or distribution of Your modifications, or for any such Derivative Works as a whole, provided Your use, reproduction, and distribution of the Work otherwise complies with the conditions stated in this License. 5. Submission of Contributions. Unless You explicitly state otherwise, any Contribution intentionally submitted for inclusion in the Work by You to the Licensor shall be under the terms and conditions of this License, without any additional terms or conditions. Notwithstanding the above, nothing herein shall supersede or modify the terms of any separate license agreement you may have executed with Licensor regarding such Contributions. 6. Trademarks. This License does not grant permission to use the trade names, trademarks, service marks, or product names of the Licensor, except as required for reasonable and customary use in describing the origin of the Work and reproducing the content of the NOTICE file. 7. Disclaimer of Warranty. Unless required by applicable law or agreed to in writing, Licensor provides the Work (and each Contributor provides its Contributions) on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied, including, without limitation, any warranties or conditions of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. You are solely responsible for determining the appropriateness of using or redistributing the Work and assume any risks associated with Your exercise of permissions under this License. 8. Limitation of Liability. In no event and under no legal theory, whether in tort (including negligence), contract, or otherwise, unless required by applicable law (such as deliberate and grossly negligent acts) or agreed to in writing, shall any Contributor be liable to You for damages, including any direct, indirect, special, incidental, or consequential damages of any character arising as a result of this License or out of the use or inability to use the Work (including but not limited to damages for loss of goodwill, work stoppage, computer failure or malfunction, or any and all other commercial damages or losses), even if such Contributor has been advised of the possibility of such damages. 9. Accepting Warranty or Additional Liability. While redistributing the Work or Derivative Works thereof, You may choose to offer, and charge a fee for, acceptance of support, warranty, indemnity, or other liability obligations and/or rights consistent with this License. However, in accepting such obligations, You may act only on Your own behalf and on Your sole responsibility, not on behalf of any other Contributor, and only if You agree to indemnify, defend, and hold each Contributor harmless for any liability incurred by, or claims asserted against, such Contributor by reason of your accepting any such warranty or additional liability. END OF TERMS AND CONDITIONS APPENDIX: How to apply the Apache License to your work. To apply the Apache License to your work, attach the following boilerplate notice, with the fields enclosed by brackets "[]" replaced with your own identifying information. (Don't include the brackets!) The text should be enclosed in the appropriate comment syntax for the file format. We also recommend that a file or class name and description of purpose be included on the same "printed page" as the copyright notice for easier identification within third-party archives. Copyright [yyyy] [name of copyright owner] Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. Path-Tiny-0.052/Makefile.PL000644 000765 000024 00000004022 12265322344 015542 0ustar00davidstaff000000 000000 # This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v5.011. use strict; use warnings; use 5.008001; use ExtUtils::MakeMaker 6.17; my %WriteMakefileArgs = ( "ABSTRACT" => "File path utility", "AUTHOR" => "David Golden ", "BUILD_REQUIRES" => {}, "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => "6.17" }, "DISTNAME" => "Path-Tiny", "EXE_FILES" => [], "LICENSE" => "apache", "NAME" => "Path::Tiny", "PREREQ_PM" => { "Carp" => 0, "Cwd" => 0, "Digest" => "1.03", "Digest::SHA" => "5.45", "Exporter" => "5.57", "Fcntl" => 0, "File::Copy" => 0, "File::Path" => "2.07", "File::Spec" => "3.40", "File::Temp" => "0.19", "File::stat" => 0, "constant" => 0, "if" => 0, "overload" => 0, "strict" => 0, "warnings" => 0 }, "TEST_REQUIRES" => { "ExtUtils::MakeMaker" => 0, "File::Basename" => 0, "File::Spec::Functions" => 0, "File::Spec::Unix" => 0, "File::Temp" => "0.19", "List::Util" => 0, "Test::More" => "0.96", "lib" => 0, "open" => 0 }, "VERSION" => "0.052", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "Carp" => 0, "Cwd" => 0, "Digest" => "1.03", "Digest::SHA" => "5.45", "Exporter" => "5.57", "ExtUtils::MakeMaker" => 0, "Fcntl" => 0, "File::Basename" => 0, "File::Copy" => 0, "File::Path" => "2.07", "File::Spec" => "3.40", "File::Spec::Functions" => 0, "File::Spec::Unix" => 0, "File::Temp" => "0.19", "File::stat" => 0, "List::Util" => 0, "Test::More" => "0.96", "constant" => 0, "if" => 0, "lib" => 0, "open" => 0, "overload" => 0, "strict" => 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); Path-Tiny-0.052/MANIFEST000644 000765 000024 00000001363 12265322344 014726 0ustar00davidstaff000000 000000 # This file was automatically generated by Dist::Zilla::Plugin::Manifest v5.011. CONTRIBUTING Changes LICENSE MANIFEST META.json META.yml Makefile.PL README cpanfile dist.ini lib/Path/Tiny.pm perlcritic.rc t/00-report-prereqs.t t/README t/basic.t t/children.t t/digest.t t/exception.t t/exports.t t/filesystem.t t/input_output.t t/input_output_no_UU.t t/lib/TestUtils.pm t/locking.t t/mkpath.t t/mutable_tree_while_iterating.t t/normalize.t t/overloading.t t/parent.t t/recurse.t t/rel-abs.t t/subsumes.t t/temp.t t/zzz-spec.t tidyall.ini xt/author/00-compile.t xt/author/critic.t xt/author/pod-spell.t xt/release/distmeta.t xt/release/minimum-version.t xt/release/pod-coverage.t xt/release/pod-syntax.t xt/release/portability.t xt/release/test-version.t Path-Tiny-0.052/META.json000644 000765 000024 00000007376 12265322344 015230 0ustar00davidstaff000000 000000 { "abstract" : "File path utility", "author" : [ "David Golden " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 5.011, CPAN::Meta::Converter version 2.133380", "license" : [ "apache_2_0" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Path-Tiny", "no_index" : { "directory" : [ "t", "xt", "examples", "corpus" ], "package" : [ "DB", "flock" ] }, "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "6.17" } }, "develop" : { "requires" : { "Dist::Zilla" : "5.011", "Dist::Zilla::Plugin::MakeMaker" : "0", "Dist::Zilla::Plugin::OnlyCorePrereqs" : "0", "Dist::Zilla::Plugin::Prereqs" : "0", "Dist::Zilla::Plugin::RemovePrereqs" : "0", "Dist::Zilla::PluginBundle::DAGOLDEN" : "0.055", "File::Spec" : "0", "File::Temp" : "0", "IO::Handle" : "0", "IPC::Open3" : "0", "Pod::Coverage::TrustPod" : "0", "Test::CPAN::Meta" : "0", "Test::More" : "0", "Test::Pod" : "1.41", "Test::Pod::Coverage" : "1.08" } }, "runtime" : { "recommends" : { "Unicode::UTF8" : "0.58" }, "requires" : { "Carp" : "0", "Cwd" : "0", "Digest" : "1.03", "Digest::SHA" : "5.45", "Exporter" : "5.57", "Fcntl" : "0", "File::Copy" : "0", "File::Path" : "2.07", "File::Spec" : "3.40", "File::Temp" : "0.19", "File::stat" : "0", "constant" : "0", "if" : "0", "overload" : "0", "perl" : "5.008001", "strict" : "0", "warnings" : "0" } }, "test" : { "recommends" : { "CPAN::Meta" : "0", "CPAN::Meta::Requirements" : "0", "Test::FailWarnings" : "0" }, "requires" : { "ExtUtils::MakeMaker" : "0", "File::Basename" : "0", "File::Spec::Functions" : "0", "File::Spec::Unix" : "0", "File::Temp" : "0.19", "List::Util" : "0", "Test::More" : "0.96", "lib" : "0", "open" : "0" } } }, "provides" : { "Path::Tiny" : { "file" : "lib/Path/Tiny.pm", "version" : "0.052" }, "Path::Tiny::Error" : { "file" : "lib/Path/Tiny.pm", "version" : "0.052" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/dagolden/Path-Tiny/issues" }, "homepage" : "https://github.com/dagolden/Path-Tiny", "repository" : { "type" : "git", "url" : "https://github.com/dagolden/Path-Tiny.git", "web" : "https://github.com/dagolden/Path-Tiny" } }, "version" : "0.052", "x_authority" : "cpan:DAGOLDEN", "x_contributors" : [ "Chris Williams ", "David Steinbrunner ", "Gabor Szabo ", "Gabriel Andrade ", "George Hartzell ", "Geraud Continsouzas ", "Goro Fuji ", "Karen Etheridge ", "Martin Kjeldsen ", "Michael G. Schwern ", "Toby Inkster ", "\uae40\ub3c4\ud615 - Keedi Kim " ] } Path-Tiny-0.052/META.yml000644 000765 000024 00000003377 12265322344 015055 0ustar00davidstaff000000 000000 --- abstract: 'File path utility' author: - 'David Golden ' build_requires: ExtUtils::MakeMaker: 0 File::Basename: 0 File::Spec::Functions: 0 File::Spec::Unix: 0 File::Temp: 0.19 List::Util: 0 Test::More: 0.96 lib: 0 open: 0 configure_requires: ExtUtils::MakeMaker: 6.17 dynamic_config: 0 generated_by: 'Dist::Zilla version 5.011, CPAN::Meta::Converter version 2.133380' license: apache meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Path-Tiny no_index: directory: - t - xt - examples - corpus package: - DB - flock provides: Path::Tiny: file: lib/Path/Tiny.pm version: 0.052 Path::Tiny::Error: file: lib/Path/Tiny.pm version: 0.052 recommends: Unicode::UTF8: 0.58 requires: Carp: 0 Cwd: 0 Digest: 1.03 Digest::SHA: 5.45 Exporter: 5.57 Fcntl: 0 File::Copy: 0 File::Path: 2.07 File::Spec: 3.40 File::Temp: 0.19 File::stat: 0 constant: 0 if: 0 overload: 0 perl: 5.008001 strict: 0 warnings: 0 resources: bugtracker: https://github.com/dagolden/Path-Tiny/issues homepage: https://github.com/dagolden/Path-Tiny repository: https://github.com/dagolden/Path-Tiny.git version: 0.052 x_authority: cpan:DAGOLDEN x_contributors: - 'Chris Williams ' - 'David Steinbrunner ' - 'Gabor Szabo ' - 'Gabriel Andrade ' - 'George Hartzell ' - 'Geraud Continsouzas ' - 'Goro Fuji ' - 'Karen Etheridge ' - 'Martin Kjeldsen ' - 'Michael G. Schwern ' - 'Toby Inkster ' - '김도형 - Keedi Kim ' Path-Tiny-0.052/perlcritic.rc000644 000765 000024 00000001072 12265322344 016260 0ustar00davidstaff000000 000000 severity = 5 verbose = 8 [Variables::ProhibitPunctuationVars] allow = $@ $! [TestingAndDebugging::ProhibitNoStrict] allow = refs # Turn these off [-BuiltinFunctions::ProhibitStringyEval] [-ControlStructures::ProhibitPostfixControls] [-ControlStructures::ProhibitUnlessBlocks] [-Documentation::RequirePodSections] [-InputOutput::ProhibitInteractiveTest] [-References::ProhibitDoubleSigils] [-RegularExpressions::RequireExtendedFormatting] [-InputOutput::ProhibitTwoArgOpen] [-Modules::ProhibitEvilModules] # Turn this on [Lax::ProhibitStringyEval::ExceptForRequire] Path-Tiny-0.052/README000644 000765 000024 00000060672 12265322344 014465 0ustar00davidstaff000000 000000 NAME Path::Tiny - File path utility VERSION version 0.052 SYNOPSIS use Path::Tiny; # creating Path::Tiny objects $dir = path("/tmp"); $foo = path("foo.txt"); $subdir = $dir->child("foo"); $bar = $subdir->child("bar.txt"); # stringifies as cleaned up path $file = path("./foo.txt"); print $file; # "foo.txt" # reading files $guts = $file->slurp; $guts = $file->slurp_utf8; @lines = $file->lines; @lines = $file->lines_utf8; $head = $file->lines( {count => 1} ); # writing files $bar->spew( @data ); $bar->spew_utf8( @data ); # reading directories for ( $dir->children ) { ... } $iter = $dir->iterator; while ( my $next = $iter->() ) { ... } DESCRIPTION This module attempts to provide a small, fast utility for working with file paths. It is friendlier to use than File::Spec and provides easy access to functions from several other core file handling modules. It doesn't attempt to be as full-featured as IO::All or Path::Class, nor does it try to work for anything except Unix-like and Win32 platforms. Even then, it might break if you try something particularly obscure or tortuous. (Quick! What does this mean: "///../../..//./././a//b/.././c/././"? And how does it differ on Win32?) All paths are forced to have Unix-style forward slashes. Stringifying the object gives you back the path (after some clean up). File input/output methods "flock" handles before reading or writing, as appropriate (if supported by the platform). The *_utf8 methods ("slurp_utf8", "lines_utf8", etc.) operate in raw mode without CRLF translation. Installing Unicode::UTF8 0.58 or later will speed up several of them and is highly recommended. CONSTRUCTORS path $path = path("foo/bar"); $path = path("/tmp", "file.txt"); # list $path = path("."); # cwd $path = path("~user/file.txt"); # tilde processing Constructs a "Path::Tiny" object. It doesn't matter if you give a file or directory path. It's still up to you to call directory-like methods only on directories and file-like methods only on files. This function is exported automatically by default. The first argument must be defined and have non-zero length or an exception will be thrown. This prevents subtle, dangerous errors with code like "path( maybe_undef() )->remove_tree". If the first component of the path is a tilde ('~') then the component will be replaced with the output of "glob('~')". If the first component of the path is a tilde followed by a user name then the component will be replaced with output of "glob('~username')". Behaviour for non-existent users depends on the output of "glob" on the system. On Windows, if the path consists of a drive identifier without a path component ("C:" or "D:"), it will be expanded to the absolute path of the current directory on that volume using "Cwd::getdcwd()". new $path = Path::Tiny->new("foo/bar"); This is just like "path", but with method call overhead. (Why would you do that?) cwd $path = Path::Tiny->cwd; # path( Cwd::getcwd ) $path = cwd; # optional export Gives you the absolute path to the current directory as a "Path::Tiny" object. This is slightly faster than "path(".")->absolute". "cwd" may be exported on request and used as a function instead of as a method. rootdir $path = Path::Tiny->rootdir; # / $path = rootdir; # optional export Gives you "File::Spec->rootdir" as a "Path::Tiny" object if you're too picky for "path("/")". "rootdir" may be exported on request and used as a function instead of as a method. tempfile, tempdir $temp = Path::Tiny->tempfile( @options ); $temp = Path::Tiny->tempdir( @options ); $temp = tempfile( @options ); # optional export $temp = tempdir( @options ); # optional export "tempfile" passes the options to "File::Temp->new" and returns a "Path::Tiny" object with the file name. The "TMPDIR" option is enabled by default. The resulting "File::Temp" object is cached. When the "Path::Tiny" object is destroyed, the "File::Temp" object will be as well. "File::Temp" annoyingly requires you to specify a custom template in slightly different ways depending on which function or method you call, but "Path::Tiny" lets you ignore that and can take either a leading template or a "TEMPLATE" option and does the right thing. $temp = Path::Tiny->tempfile( "customXXXXXXXX" ); # ok $temp = Path::Tiny->tempfile( TEMPLATE => "customXXXXXXXX" ); # ok The tempfile path object will normalized to have an absolute path, even if created in a relative directory using "DIR". "tempdir" is just like "tempfile", except it calls "File::Temp->newdir" instead. Both "tempfile" and "tempdir" may be exported on request and used as functions instead of as methods. METHODS absolute $abs = path("foo/bar")->absolute; $abs = path("foo/bar")->absolute("/tmp"); Returns a new "Path::Tiny" object with an absolute path (or itself if already absolute). Unless an argument is given, the current directory is used as the absolute base path. The argument must be absolute or you won't get an absolute result. This will not resolve upward directories ("foo/../bar") unless "canonpath" in File::Spec would normally do so on your platform. If you need them resolved, you must call the more expensive "realpath" method instead. On Windows, an absolute path without a volume component will have it added based on the current drive. append, append_raw, append_utf8 path("foo.txt")->append(@data); path("foo.txt")->append(\@data); path("foo.txt")->append({binmode => ":raw"}, @data); path("foo.txt")->append_raw(@data); path("foo.txt")->append_utf8(@data); Appends data to a file. The file is locked with "flock" prior to writing. An optional hash reference may be used to pass options. The only option is "binmode", which is passed to "binmode()" on the handle used for writing. "append_raw" is like "append" with a "binmode" of ":unix" for fast, unbuffered, raw write. "append_utf8" is like "append" with a "binmode" of ":unix:encoding(UTF-8)". If Unicode::UTF8 0.58+ is installed, a raw append will be done instead on the data encoded with "Unicode::UTF8". basename $name = path("foo/bar.txt")->basename; # bar.txt Returns the file portion or last directory portion of a path. canonpath $canonical = path("foo/bar")->canonpath; # foo\bar on Windows Returns a string with the canonical format of the path name for the platform. In particular, this means directory separators will be "\" on Windows. child $file = path("/tmp")->child("foo.txt"); # "/tmp/foo.txt" $file = path("/tmp")->child(@parts); Returns a new "Path::Tiny" object relative to the original. Works like "catfile" or "catdir" from File::Spec, but without caring about file or directories. children @paths = path("/tmp")->children; @paths = path("/tmp")->children( qr/\.txt$/ ); Returns a list of "Path::Tiny" objects for all files and directories within a directory. Excludes "." and ".." automatically. If an optional "qr//" argument is provided, it only returns objects for child names that match the given regular expression. Only the base name is used for matching: @paths = path("/tmp")->children( qr/^foo/ ); # matches children like the glob foo* copy path("/tmp/foo.txt")->copy("/tmp/bar.txt"); Copies a file using File::Copy's "copy" function. digest $obj = path("/tmp/foo.txt")->digest; # SHA-256 $obj = path("/tmp/foo.txt")->digest("MD5"); # user-selected Returns a hexadecimal digest for a file. Any arguments are passed to the constructor for Digest to select an algorithm. If no arguments are given, the default is SHA-256. dirname $name = path("/tmp/foo.txt")->dirname; # "/tmp/" Returns the directory name portion of the path. This is roughly equivalent to what File::Spec would give from "splitpath" and thus usually has the trailing slash. If that's not desired, stringify directories or call "parent" on files. exists, is_file, is_dir if ( path("/tmp")->exists ) { ... } if ( path("/tmp")->is_file ) { ... } if ( path("/tmp")->is_dir ) { ... } Just like "-e", "-f" or "-d". This means the file or directory actually has to exist on the filesystem. Until then, it's just a path. filehandle $fh = path("/tmp/foo.txt")->filehandle($mode, $binmode); $fh = path("/tmp/foo.txt")->filehandle({ locked => 1 }, $mode, $binmode); Returns an open file handle. The $mode argument must be a Perl-style read/write mode string ("<" ,">", "<<", etc.). If a $binmode is given, it is set during the "open" call. An optional hash reference may be used to pass options. The only option is "locked". If true, handles opened for writing, appending or read-write are locked with "LOCK_EX"; otherwise, they are locked with "LOCK_SH". When using "locked", ">" or "+>" modes will delay truncation until after the lock is acquired. See "openr", "openw", "openrw", and "opena" for sugar. is_absolute, is_relative if ( path("/tmp")->is_absolute ) { ... } if ( path("/tmp")->is_relative ) { ... } Booleans for whether the path appears absolute or relative. is_rootdir while ( ! $path->is_rootdir ) { $path = $path->parent; ... } Boolean for whether the path is the root directory of the volume. I.e. the "dirname" is "q[/]" and the "basename" is "q[]". This works even on "MSWin32" with drives and UNC volumes: path("C:/")->is_rootdir; # true path("//server/share/")->is_rootdir; #true iterator $iter = path("/tmp")->iterator( \%options ); Returns a code reference that walks a directory lazily. Each invocation returns a "Path::Tiny" object or undef when the iterator is exhausted. $iter = path("/tmp")->iterator; while ( $path = $iter->() ) { ... } The current and parent directory entries ("." and "..") will not be included. If the "recurse" option is true, the iterator will walk the directory recursively, breadth-first. If the "follow_symlinks" option is also true, directory links will be followed recursively. There is no protection against loops when following links. If a directory is not readable, it will not be followed. The default is the same as: $iter = path("/tmp")->iterator( { recurse => 0, follow_symlinks => 0, } ); For a more powerful, recursive iterator with built-in loop avoidance, see Path::Iterator::Rule. lines, lines_raw, lines_utf8 @contents = path("/tmp/foo.txt")->lines; @contents = path("/tmp/foo.txt")->lines(\%options); @contents = path("/tmp/foo.txt")->lines_raw; @contents = path("/tmp/foo.txt")->lines_utf8; @contents = path("/tmp/foo.txt")->lines( { chomp => 1, count => 4 } ); Returns a list of lines from a file. Optionally takes a hash-reference of options. Valid options are "binmode", "count" and "chomp". If "binmode" is provided, it will be set on the handle prior to reading. If "count" is provided, up to that many lines will be returned. If "chomp" is set, any end-of-line character sequences ("CR", "CRLF", or "LF") will be removed from the lines returned. Because the return is a list, "lines" in scalar context will return the number of lines (and throw away the data). $number_of_lines = path("/tmp/foo.txt")->lines; "lines_raw" is like "lines" with a "binmode" of ":raw". We use ":raw" instead of ":unix" so PerlIO buffering can manage reading by line. "lines_utf8" is like "lines" with a "binmode" of ":raw:encoding(UTF-8)". If Unicode::UTF8 0.58+ is installed, a raw UTF-8 slurp will be done and then the lines will be split. This is actually faster than relying on ":encoding(UTF-8)", though a bit memory intensive. If memory use is a concern, consider "openr_utf8" and iterating directly on the handle. mkpath path("foo/bar/baz")->mkpath; path("foo/bar/baz")->mkpath( \%options ); Like calling "make_path" from File::Path. An optional hash reference is passed through to "make_path". Errors will be trapped and an exception thrown. Returns the list of directories created or an empty list if the directories already exist, just like "make_path". move path("foo.txt")->move("bar.txt"); Just like "rename". openr, openw, openrw, opena $fh = path("foo.txt")->openr($binmode); # read $fh = path("foo.txt")->openr_raw; $fh = path("foo.txt")->openr_utf8; $fh = path("foo.txt")->openw($binmode); # write $fh = path("foo.txt")->openw_raw; $fh = path("foo.txt")->openw_utf8; $fh = path("foo.txt")->opena($binmode); # append $fh = path("foo.txt")->opena_raw; $fh = path("foo.txt")->opena_utf8; $fh = path("foo.txt")->openrw($binmode); # read/write $fh = path("foo.txt")->openrw_raw; $fh = path("foo.txt")->openrw_utf8; Returns a file handle opened in the specified mode. The "openr" style methods take a single "binmode" argument. All of the "open*" methods have "open*_raw" and "open*_utf8" equivalents that use ":raw" and ":raw:encoding(UTF-8)", respectively. An optional hash reference may be used to pass options. The only option is "locked". If true, handles opened for writing, appending or read-write are locked with "LOCK_EX"; otherwise, they are locked for "LOCK_SH". $fh = path("foo.txt")->openrw_utf8( { locked => 1 } ); See "filehandle" for more on locking. parent $parent = path("foo/bar/baz")->parent; # foo/bar $parent = path("foo/wibble.txt")->parent; # foo $parent = path("foo/bar/baz")->parent(2); # foo Returns a "Path::Tiny" object corresponding to the parent directory of the original directory or file. An optional positive integer argument is the number of parent directories upwards to return. "parent" by itself is equivalent to parent(1). realpath $real = path("/baz/foo/../bar")->realpath; $real = path("foo/../bar")->realpath; Returns a new "Path::Tiny" object with all symbolic links and upward directory parts resolved using Cwd's "realpath". Compared to "absolute", this is more expensive as it must actually consult the filesystem. If the path can't be resolved (e.g. if it includes directories that don't exist), an exception will be thrown: $real = path("doesnt_exist/foo")->realpath; # dies relative $rel = path("/tmp/foo/bar")->relative("/tmp"); # foo/bar Returns a "Path::Tiny" object with a relative path name. Given the trickiness of this, it's a thin wrapper around "File::Spec->abs2rel()". remove path("foo.txt")->remove; Note: as of 0.012, remove only works on files. This is just like "unlink", except if the path does not exist, it returns false rather than throwing an exception. remove_tree # directory path("foo/bar/baz")->remove_tree; path("foo/bar/baz")->remove_tree( \%options ); path("foo/bar/baz")->remove_tree( { safe => 0 } ); # force remove Like calling "remove_tree" from File::Path, but defaults to "safe" mode. An optional hash reference is passed through to "remove_tree". Errors will be trapped and an exception thrown. Returns the number of directories deleted, just like "remove_tree". If you want to remove a directory only if it is empty, use the built-in "rmdir" function instead. rmdir path("foo/bar/baz/"); slurp, slurp_raw, slurp_utf8 $data = path("foo.txt")->slurp; $data = path("foo.txt")->slurp( {binmode => ":raw"} ); $data = path("foo.txt")->slurp_raw; $data = path("foo.txt")->slurp_utf8; Reads file contents into a scalar. Takes an optional hash reference may be used to pass options. The only option is "binmode", which is passed to "binmode()" on the handle used for reading. "slurp_raw" is like "slurp" with a "binmode" of ":unix" for a fast, unbuffered, raw read. "slurp_utf8" is like "slurp" with a "binmode" of ":unix:encoding(UTF-8)". If Unicode::UTF8 0.58+ is installed, a raw slurp will be done instead and the result decoded with "Unicode::UTF8". This is just as strict and is roughly an order of magnitude faster than using ":encoding(UTF-8)". spew, spew_raw, spew_utf8 path("foo.txt")->spew(@data); path("foo.txt")->spew(\@data); path("foo.txt")->spew({binmode => ":raw"}, @data); path("foo.txt")->spew_raw(@data); path("foo.txt")->spew_utf8(@data); Writes data to a file atomically. The file is written to a temporary file in the same directory, then renamed over the original. An optional hash reference may be used to pass options. The only option is "binmode", which is passed to "binmode()" on the handle used for writing. "spew_raw" is like "spew" with a "binmode" of ":unix" for a fast, unbuffered, raw write. "spew_utf8" is like "spew" with a "binmode" of ":unix:encoding(UTF-8)". If Unicode::UTF8 0.58+ is installed, a raw spew will be done instead on the data encoded with "Unicode::UTF8". stat, lstat $stat = path("foo.txt")->stat; $stat = path("/some/symlink")->lstat; Like calling "stat" or "lstat" from File::stat. stringify $path = path("foo.txt"); say $path->stringify; # same as "$path" Returns a string representation of the path. Unlike "canonpath", this method returns the path standardized with Unix-style "/" directory separators. subsumes path("foo/bar")->subsumes("foo/bar/baz"); # true path("/foo/bar")->subsumes("/foo/baz"); # false Returns true if the first path is a prefix of the second path at a directory boundary. This does not resolve parent directory entries ("..") or symlinks: path("foo/bar")->subsumes("foo/bar/../baz"); # true If such things are important to you, ensure that both paths are resolved to the filesystem with "realpath": my $p1 = path("foo/bar")->realpath; my $p2 = path("foo/bar/../baz")->realpath; if ( $p1->subsumes($p2) ) { ... } touch path("foo.txt")->touch; path("foo.txt")->touch($epoch_secs); Like the Unix "touch" utility. Creates the file if it doesn't exist, or else changes the modification and access times to the current time. If the first argument is the epoch seconds then it will be used. Returns the path object so it can be easily chained with spew: path("foo.txt")->touch->spew( $content ); touchpath path("bar/baz/foo.txt")->touchpath; Combines "mkpath" and "touch". Creates the parent directory if it doesn't exist, before touching the file. Returns the path object like "touch" does. volume $vol = path("/tmp/foo.txt")->volume; # "" $vol = path("C:/tmp/foo.txt")->volume; # "C:" Returns the volume portion of the path. This is equivalent equivalent to what File::Spec would give from "splitpath" and thus usually is the empty string on Unix-like operating systems or the drive letter for an absolute path on "MSWin32". EXCEPTION HANDLING Failures will be thrown as exceptions in the class "Path::Tiny::Error". The object will be a hash reference with the following fields: * "op" — a description of the operation, usually function call and any extra info * "file" — the file or directory relating to the error * "err" — hold $! at the time the error was thrown * "msg" — a string combining the above data and a Carp-like short stack trace Exception objects will stringify as the "msg" field. CAVEATS File locking If flock is not supported on a platform, it will not be used, even if locking is requested. See additional caveats below. NFS and BSD On BSD, Perl's flock implementation may not work to lock files on an NFS filesystem. Path::Tiny has some heuristics to detect this and will warn once and let you continue in an unsafe mode. If you want this failure to be fatal, you can fatalize the 'flock' warnings category: use warnings FATAL => 'flock'; AIX and locking AIX requires a write handle for locking. Therefore, calls that normally open a read handle and take a shared lock instead will open a read-write handle and take an exclusive lock. utf8 vs UTF-8 All the *_utf8 methods use ":encoding(UTF-8)" -- either as ":unix:encoding(UTF-8)" (unbuffered) or ":raw:encoding(UTF-8)" (buffered) -- which is strict against the Unicode spec and disallows illegal Unicode codepoints or UTF-8 sequences. Unfortunately, ":encoding(UTF-8)" is very, very slow. If you install Unicode::UTF8 0.58 or later, that module will be used by some *_utf8 methods to encode or decode data after a raw, binary input/output operation, which is much faster. If you need the performance and can accept the security risk, "slurp({binmode => ":unix:utf8"})" will be faster than ":unix:encoding(UTF-8)" (but not as fast as "Unicode::UTF8"). Note that the *_utf8 methods read in raw mode. There is no CRLF translation on Windows. If you must have CRLF translation, use the regular input/output methods with an appropriate binmode: $path->spew_utf8($data); # raw $path->spew({binmode => ":encoding(UTF-8)"}, $data; # LF -> CRLF Consider PerlIO::utf8_strict for a faster PerlIO layer alternative to ":encoding(UTF-8)", though it does not appear to be as fast as the "Unicode::UTF8" approach. Default IO layers and the open pragma If you have Perl 5.10 or later, file input/output methods ("slurp", "spew", etc.) and high-level handle opening methods ( "filehandle", "openr", "openw", etc. ) respect default encodings set by the "-C" switch or lexical open settings of the caller. For UTF-8, this is almost certainly slower than using the dedicated "_utf8" methods if you have Unicode::UTF8. TYPE CONSTRAINTS AND COERCION A standard MooseX::Types library is available at MooseX::Types::Path::Tiny. A Type::Tiny equivalent is available as Types::Path::Tiny. SEE ALSO These are other file/path utilities, which may offer a different feature set than "Path::Tiny". * File::Fu * IO::All * Path::Class These iterators may be slightly faster than the recursive iterator in "Path::Tiny": * Path::Iterator::Rule * File::Next There are probably comparable, non-Tiny tools. Let me know if you want me to add a module to the list. This module was featured in the 2013 Perl Advent Calendar . SUPPORT Bugs / Feature Requests Please report any bugs or feature requests through the issue tracker at . You will be notified automatically of any progress on your issue. Source Code This is open source software. The code repository is available for public review and contribution under the terms of the license. git clone https://github.com/dagolden/Path-Tiny.git AUTHOR David Golden CONTRIBUTORS * Chris Williams * David Steinbrunner * Gabor Szabo * Gabriel Andrade * George Hartzell * Geraud Continsouzas * Goro Fuji * Karen Etheridge * Martin Kjeldsen * Michael G. Schwern * Toby Inkster * 김도형 - Keedi Kim COPYRIGHT AND LICENSE This software is Copyright (c) 2013 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 Path-Tiny-0.052/t/000755 000765 000024 00000000000 12265322344 014035 5ustar00davidstaff000000 000000 Path-Tiny-0.052/tidyall.ini000644 000765 000024 00000000240 12265322344 015731 0ustar00davidstaff000000 000000 ; Install Code::TidyAll ; run "tidyall -a" to tidy all files ; run "tidyall -g" to tidy only files modified from git [PerlTidy] select = {lib,t}/**/*.{pl,pm,t} Path-Tiny-0.052/xt/000755 000765 000024 00000000000 12265322344 014225 5ustar00davidstaff000000 000000 Path-Tiny-0.052/xt/author/000755 000765 000024 00000000000 12265322344 015527 5ustar00davidstaff000000 000000 Path-Tiny-0.052/xt/release/000755 000765 000024 00000000000 12265322344 015645 5ustar00davidstaff000000 000000 Path-Tiny-0.052/xt/release/distmeta.t000644 000765 000024 00000000332 12265322344 017642 0ustar00davidstaff000000 000000 #!perl # This file was automatically generated by Dist::Zilla::Plugin::MetaTests. use Test::More; eval "use Test::CPAN::Meta"; plan skip_all => "Test::CPAN::Meta required for testing META.yml" if $@; meta_yaml_ok(); Path-Tiny-0.052/xt/release/minimum-version.t000644 000765 000024 00000000266 12265322344 021174 0ustar00davidstaff000000 000000 #!perl use Test::More; eval "use Test::MinimumVersion"; plan skip_all => "Test::MinimumVersion required for testing minimum versions" if $@; all_minimum_version_ok( qq{5.010} ); Path-Tiny-0.052/xt/release/pod-coverage.t000644 000765 000024 00000000651 12265322344 020407 0ustar00davidstaff000000 000000 #!perl # This file was automatically generated by Dist::Zilla::Plugin::PodCoverageTests. use Test::More; eval "use Test::Pod::Coverage 1.08"; plan skip_all => "Test::Pod::Coverage 1.08 required for testing POD coverage" if $@; eval "use Pod::Coverage::TrustPod"; plan skip_all => "Pod::Coverage::TrustPod required for testing POD coverage" if $@; all_pod_coverage_ok({ coverage_class => 'Pod::Coverage::TrustPod' }); Path-Tiny-0.052/xt/release/pod-syntax.t000644 000765 000024 00000000332 12265322344 020136 0ustar00davidstaff000000 000000 #!perl # This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. use Test::More; eval "use Test::Pod 1.41"; plan skip_all => "Test::Pod 1.41 required for testing POD" if $@; all_pod_files_ok(); Path-Tiny-0.052/xt/release/portability.t000644 000765 000024 00000000332 12265322344 020372 0ustar00davidstaff000000 000000 #!perl use strict; use warnings; use Test::More; eval 'use Test::Portability::Files'; plan skip_all => 'Test::Portability::Files required for testing portability' if $@; options(test_one_dot => 0); run_tests(); Path-Tiny-0.052/xt/release/test-version.t000644 000765 000024 00000000643 12265322344 020477 0ustar00davidstaff000000 000000 use strict; use warnings; use Test::More; # generated by Dist::Zilla::Plugin::Test::Version 0.002004 BEGIN { eval "use Test::Version; 1;" or die $@; } my @imports = ( 'version_all_ok' ); my $params = { is_strict => 0, has_version => 1, }; push @imports, $params if version->parse( $Test::Version::VERSION ) >= version->parse('1.002'); Test::Version->import(@imports); version_all_ok; done_testing; Path-Tiny-0.052/xt/author/00-compile.t000644 000765 000024 00000002033 12265322344 017557 0ustar00davidstaff000000 000000 use 5.006; use strict; use warnings; # this test was generated with Dist::Zilla::Plugin::Test::Compile 2.039 use Test::More tests => 1 + ($ENV{AUTHOR_TESTING} ? 1 : 0); my @module_files = ( 'Path/Tiny.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"); if (@_warnings) { warn @_warnings; push @warnings, @_warnings; } } is(scalar(@warnings), 0, 'no warnings found') if $ENV{AUTHOR_TESTING}; Path-Tiny-0.052/xt/author/critic.t000644 000765 000024 00000000435 12265322344 017173 0ustar00davidstaff000000 000000 #!perl use strict; use warnings; use Test::More; use English qw(-no_match_vars); eval "use Test::Perl::Critic"; plan skip_all => 'Test::Perl::Critic required to criticise code' if $@; Test::Perl::Critic->import( -profile => "perlcritic.rc" ) if -e "perlcritic.rc"; all_critic_ok(); Path-Tiny-0.052/xt/author/pod-spell.t000644 000765 000024 00000001305 12265322344 017612 0ustar00davidstaff000000 000000 use strict; use warnings; use Test::More; # generated by Dist::Zilla::Plugin::Test::PodSpelling 2.006002 use Test::Spelling 0.12; use Pod::Wordlist; add_stopwords(); all_pod_files_spelling_ok( qw( bin lib ) ); __DATA__ AIX BENCHMARKING CRLF SHA NFS canonpath codepoints cwd dirname fatalize lstat mkpath opena openr openrw openw realpath stringifying subclasses touchpath UNC unlinked utf David Golden dagolden Chris Williams bingos Steinbrunner dsteinbrunner Gabor Szabo szabgab Gabriel Andrade gabiruh George Hartzell hartzell Geraud Continsouzas geraud Goro Fuji gfuji Karen Etheridge ether Martin Kjeldsen mk Michael Schwern mschwern Toby Inkster tobyink 김도형 Keedi Kim keedi lib Path Tiny Path-Tiny-0.052/t/00-report-prereqs.t000644 000765 000024 00000007131 12265322344 017433 0ustar00davidstaff000000 000000 #!perl use strict; use warnings; # This test was generated by Dist::Zilla::Plugin::Test::ReportPrereqs 0.012 use Test::More tests => 1; use ExtUtils::MakeMaker; use File::Spec::Functions; use List::Util qw/max/; my @modules = qw( CPAN::Meta CPAN::Meta::Requirements Carp Cwd Digest Digest::SHA Exporter ExtUtils::MakeMaker Fcntl File::Basename File::Copy File::Path File::Spec File::Spec::Functions File::Spec::Unix File::Temp File::stat List::Util Test::FailWarnings Test::More Unicode::UTF8 constant if lib open overload perl strict warnings ); my %exclude = map {; $_ => 1 } qw( ); my ($source) = grep { -f $_ } qw/MYMETA.json MYMETA.yml META.json/; $source = "META.yml" unless defined $source; # replace modules with dynamic results from MYMETA.json if we can # (hide CPAN::Meta from prereq scanner) my $cpan_meta = "CPAN::Meta"; my $cpan_meta_req = "CPAN::Meta::Requirements"; my $all_requires; if ( -f $source && eval "require $cpan_meta" ) { ## no critic if ( my $meta = eval { CPAN::Meta->load_file($source) } ) { # Get ALL modules mentioned in META (any phase/type) my $prereqs = $meta->prereqs; delete $prereqs->{develop} if not $ENV{AUTHOR_TESTING}; my %uniq = map {$_ => 1} map { keys %$_ } map { values %$_ } values %$prereqs; $uniq{$_} = 1 for @modules; # don't lose any static ones @modules = sort grep { ! $exclude{$_} } keys %uniq; # If verifying, merge 'requires' only for major phases if ( 1 ) { $prereqs = $meta->effective_prereqs; # get the object, not the hash if (eval "require $cpan_meta_req; 1") { ## no critic $all_requires = $cpan_meta_req->new; for my $phase ( qw/configure build test runtime develop/ ) { $all_requires->add_requirements( $prereqs->requirements_for($phase, 'requires') ); } } } } } my @reports = [qw/Version Module/]; my @dep_errors; my $req_hash = defined($all_requires) ? $all_requires->as_string_hash : {}; for my $mod ( @modules ) { next if $mod eq 'perl'; my $file = $mod; $file =~ s{::}{/}g; $file .= ".pm"; my ($prefix) = grep { -e catfile($_, $file) } @INC; if ( $prefix ) { my $ver = MM->parse_version( catfile($prefix, $file) ); $ver = "undef" unless defined $ver; # Newer MM should do this anyway push @reports, [$ver, $mod]; if ( 1 && $all_requires ) { my $req = $req_hash->{$mod}; if ( defined $req && length $req ) { if ( ! defined eval { version->parse($ver) } ) { push @dep_errors, "$mod version '$ver' cannot be parsed (version '$req' required)"; } elsif ( ! $all_requires->accepts_module( $mod => $ver ) ) { push @dep_errors, "$mod version '$ver' is not in required range '$req'"; } } } } else { push @reports, ["missing", $mod]; if ( 1 && $all_requires ) { my $req = $req_hash->{$mod}; if ( defined $req && length $req ) { push @dep_errors, "$mod is not installed (version '$req' required)"; } } } } if ( @reports ) { my $vl = max map { length $_->[0] } @reports; my $ml = max map { length $_->[1] } @reports; splice @reports, 1, 0, ["-" x $vl, "-" x $ml]; diag "\nVersions for all modules listed in $source (including optional ones):\n", map {sprintf(" %*s %*s\n",$vl,$_->[0],-$ml,$_->[1])} @reports; } if ( @dep_errors ) { diag join("\n", "\n*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ***\n", "The following REQUIRED prerequisites were not satisfied:\n", @dep_errors, "\n" ); } pass; # vim: ts=2 sts=2 sw=2 et: Path-Tiny-0.052/t/basic.t000644 000765 000024 00000007722 12265322344 015313 0ustar00davidstaff000000 000000 use 5.008001; use strict; use warnings; use Test::More 0.96; use File::Spec; use Path::Tiny; use Cwd; use lib 't/lib'; use TestUtils qw/exception/; my $file1 = path('foo.txt'); isa_ok( $file1, "Path::Tiny" ); ok $file1->isa('Path::Tiny'); is $file1, 'foo.txt'; ok $file1->is_relative; is $file1->dirname, '.'; is $file1->basename, 'foo.txt'; my $file2 = path( 'dir', 'bar.txt' ); is $file2, 'dir/bar.txt'; ok !$file2->is_absolute; is $file2->dirname, 'dir/'; is $file2->basename, 'bar.txt'; my $dir = path('tmp'); is $dir, 'tmp'; ok !$dir->is_absolute; is $dir->basename, 'tmp'; my $dir2 = path('/tmp'); is $dir2, '/tmp'; ok $dir2->is_absolute; my $cat = path( $dir, 'foo' ); is $cat, 'tmp/foo'; $cat = $dir->child('foo'); is $cat, 'tmp/foo'; is $cat->dirname, 'tmp/'; is $cat->basename, 'foo'; $cat = path( $dir2, 'foo' ); is $cat, '/tmp/foo'; $cat = $dir2->child('foo'); is $cat, '/tmp/foo'; isa_ok $cat, 'Path::Tiny'; is $cat->dirname, '/tmp/'; $cat = $dir2->child('foo'); is $cat, '/tmp/foo'; isa_ok $cat, 'Path::Tiny'; is $cat->basename, 'foo'; my $file = path('/foo//baz/./foo'); is $file, '/foo/baz/foo'; is $file->dirname, '/foo/baz/'; is $file->parent, '/foo/baz'; { my $file = path("foo/bar/baz"); is( $file->canonpath, File::Spec->canonpath("$file"), "canonpath" ); } { my $dir = path('/foo/bar/baz'); is $dir->parent, '/foo/bar'; is $dir->parent->parent, '/foo'; is $dir->parent->parent->parent, '/'; is $dir->parent->parent->parent->parent, '/'; $dir = path('foo/bar/baz'); is $dir->parent, 'foo/bar'; is $dir->parent->parent, 'foo'; is $dir->parent->parent->parent, '.'; is $dir->parent->parent->parent->parent, '..'; is $dir->parent->parent->parent->parent->parent, '../..'; } { my $dir = path("foo/"); is $dir, 'foo'; is $dir->parent, '.'; } { # Special cases for my $bad ( [''], [undef], [], [ '', 'var', 'tmp' ] ) { like( exception { path(@$bad) }, qr/positive-length/, "exception" ); } is( Path::Tiny->cwd, path( Cwd::getcwd() ) ); is( path('.')->absolute, path( Cwd::getcwd() ) ); } { my $file = path('/tmp/foo/bar.txt'); is $file->relative('/tmp'), 'foo/bar.txt'; is $file->relative('/tmp/foo'), 'bar.txt'; is $file->relative('/tmp/'), 'foo/bar.txt'; is $file->relative('/tmp/foo/'), 'bar.txt'; $file = path('one/two/three'); is $file->relative('one'), 'two/three'; } { my $file = Path::Tiny->new( File::Spec->rootdir ); my $root = Path::Tiny->rootdir; is( $file, $root, "rootdir is like path('/')" ); is( $file->child("lib"), "/lib", "child of rootdir is correct" ); } # constructor { is( path(qw/foo bar baz/), Path::Tiny->new(qw/foo bar baz/), "path() vs new" ); is( path(qw/foo bar baz/), path("foo/bar/baz"), "path(a,b,c) vs path('a/b/c')" ); } # tilde processing { my ($homedir) = glob('~'); my $dir = path('~'); is( $dir, $homedir, 'Test my homedir' ); $dir = path('~/'); is( $dir, $homedir, 'Test my homedir with trailing "/"' ); $dir = path('~/foo/bar'); is( $dir, $homedir . '/foo/bar', 'Test my homedir with longer path' ); $dir = path('~/foo/bar/'); is( $dir, $homedir . '/foo/bar', 'Test my homedir, longer path and trailing "/"' ); my ($root_homedir) = glob('~root'); $dir = path('~root'); is( $dir, $root_homedir, 'Test root homedir' ); $dir = path('~root'); is( $dir, $root_homedir, 'Test root homedir with trailing /' ); $dir = path('~root/foo/bar'); is( $dir, $root_homedir . '/foo/bar', 'Test root homedir with longer path' ); $dir = path('~root/foo/bar/'); is( $dir, $root_homedir . '/foo/bar', 'Test root homedir, longer path and trailing "/"' ); my ($missing_homedir) = glob('~idontthinkso'); $dir = path('~idontthinkso'); is( $dir, '~idontthinkso', 'Test homedir of nonexistant user' ); is( $dir, $missing_homedir, 'Test homedir of nonexistant user (via glob)' ); } done_testing(); Path-Tiny-0.052/t/children.t000644 000765 000024 00000002154 12265322344 016014 0ustar00davidstaff000000 000000 use 5.008001; use strict; use warnings; use Test::More 0.96; use File::Basename (); use File::Temp (); use File::Spec::Unix; use lib 't/lib'; use TestUtils qw/exception/; use Path::Tiny; my $tempdir = File::Temp->newdir; my @kids = qw/apple banana carrot/; path($tempdir)->child($_)->touch for @kids; my @expected = map { path( File::Spec::Unix->catfile( $tempdir, $_ ) ) } @kids; is_deeply( [ sort { $a cmp $b } path($tempdir)->children ], [ sort @expected ], "children correct" ); my $regexp = qr/.a/; is_deeply( [ sort { $a cmp $b } path($tempdir)->children($regexp) ], [ sort grep { my $child = File::Basename::basename($_); $child =~ /$regexp/ } @expected ], "children correct with Regexp argument" ); my $arrayref = []; eval { path($tempdir)->children($arrayref) }; like $@, qr/Invalid argument '\Q$arrayref\E' for children()/, 'children with invalid argument'; done_testing; # # This file is part of Path-Tiny # # This software is Copyright (c) 2013 by David Golden. # # This is free software, licensed under: # # The Apache License, Version 2.0, January 2004 # Path-Tiny-0.052/t/digest.t000644 000765 000024 00000002000 12265322344 015471 0ustar00davidstaff000000 000000 use 5.008001; use strict; use warnings; use Test::More 0.96; use lib 't/lib'; use TestUtils qw/exception/; use Path::Tiny; use Digest; my $dir = Path::Tiny->tempdir; my $file = $dir->child('foo.bin'); my $chunk = pack( "Z*", "Hello Path::Tiny\nThis is packed binary string\n" ); ok( $file->spew_raw($chunk), "created test file with packed binary string" ); is( $file->digest, 'a98e605049836e8adb36d351abb95a09e9e5e200703576ecdaec0e697d17d626', 'digest SHA-256 (hardcoded)', ); my $sha = Digest->new('SHA-256'); $sha->add($chunk); is( $file->digest, $sha->hexdigest, 'digest SHA-256', ); is( $file->digest('MD5'), 'ce05aca61c0e58d7396073b668bcafd0', 'digest MD5 (hardcoded)', ); my $md5 = Digest->new('MD5'); $md5->add($chunk); is( $file->digest('MD5'), $md5->hexdigest, 'digest MD5', ); done_testing; # # This file is part of Path-Tiny # # This software is Copyright (c) 2013 by David Golden. # # This is free software, licensed under: # # The Apache License, Version 2.0, January 2004 # Path-Tiny-0.052/t/exception.t000644 000765 000024 00000001742 12265322344 016224 0ustar00davidstaff000000 000000 use 5.008001; use strict; use warnings; use Test::More 0.96; use lib 't/lib'; use TestUtils qw/exception/; use Path::Tiny; my $err; $err = exception { path("aljfakdlfadks")->slurp }; like( $err, qr/at \Q$0\E/, "exception reported at caller's package" ); for my $m (qw/append iterator lines lines_raw lines_utf8 slurp spew/) { $err = exception { path("foo")->$m( { wibble => 1 } ) }; like( $err, qr/Invalid option\(s\) for $m: wibble/, "$m bad args" ); } # exclude append/spew because they handle hash/not-hash themselves for my $m (qw/iterator lines lines_raw lines_utf8 slurp/) { my $scalar = [qw/array ref/]; $err = exception { path("foo")->$m($scalar) }; like( $err, qr/Options for $m must be a hash reference/, "$m not hashref" ); } done_testing; # # This file is part of Path-Tiny # # This software is Copyright (c) 2013 by David Golden. # # This is free software, licensed under: # # The Apache License, Version 2.0, January 2004 # # vim: ts=4 sts=4 sw=4 et: Path-Tiny-0.052/t/exports.t000644 000765 000024 00000001242 12265322344 015725 0ustar00davidstaff000000 000000 use 5.008001; use strict; use warnings; use Test::More 0.96; use lib 't/lib'; use TestUtils qw/exception/; use Path::Tiny qw/path cwd rootdir tempdir tempfile/; isa_ok( path("."), 'Path::Tiny', 'path' ); isa_ok( cwd, 'Path::Tiny', 'cwd' ); isa_ok( rootdir, 'Path::Tiny', 'rootdir' ); isa_ok( tempfile( TEMPLATE => 'tempXXXXXXX' ), 'Path::Tiny', 'tempfile' ); isa_ok( tempdir( TEMPLATE => 'tempXXXXXXX' ), 'Path::Tiny', 'tempdir' ); done_testing; # # This file is part of Path-Tiny # # This software is Copyright (c) 2013 by David Golden. # # This is free software, licensed under: # # The Apache License, Version 2.0, January 2004 # # vim: ts=4 sts=4 sw=4 et: Path-Tiny-0.052/t/filesystem.t000644 000765 000024 00000022216 12265322344 016411 0ustar00davidstaff000000 000000 use 5.008001; use strict; use warnings; use Test::More 0.96; use File::Temp qw(tmpnam tempdir); use File::Spec; use Cwd; use lib 't/lib'; use TestUtils qw/exception/; use Path::Tiny; # Tests adapted from Path::Class t/basic.t my $file = path( scalar tmpnam() ); ok $file, "Got a filename via tmpnam()"; { my $fh = $file->openw; ok $fh, "Opened $file for writing"; ok print( $fh "Foo\n" ), "Printed to $file"; } ok -e $file, "$file should exist"; ok $file->is_file, "it's a file!"; my ( $volume, $dirname, $basename ) = map { s{\\}{/}; $_ } File::Spec->splitpath($file); is( $file->volume, $volume, "volume correct" ); is( $file->volume, $volume, "volume cached " ); # for coverage is( $file->dirname, $dirname, "dirname correct" ); is( $file->basename, $basename, "basename correct" ); { my $fh = $file->openr; is scalar <$fh>, "Foo\n", "Read contents of $file correctly"; } note "stat"; { my $stat = $file->stat; ok $stat; cmp_ok $stat->mtime, '>', time() - 20; # Modified within last 20 seconds $stat = $file->parent->stat; ok $stat; } note "stat/lstat with no file"; { my $file = "i/do/not/exist"; ok exception { path($file)->stat }; ok exception { path($file)->lstat }; } 1 while unlink $file; ok not -e $file; my $dir = path( tempdir( TMPDIR => 1, CLEANUP => 1 ) ); ok $dir; ok -d $dir; ok $dir->is_dir, "It's a directory!"; $file = $dir->child('foo.x'); $file->touch; ok -e $file; my $epoch = time - 10; utime $epoch, $epoch, $file; $file->touch; ok( $file->stat->mtime > $epoch, "touch sets utime as current time" ); $file->touch($epoch); ok( $file->stat->mtime == $epoch, "touch sets utime as 10 secs before" ); { my @files = $dir->children; is scalar @files, 1 or diag explain \@files; ok scalar grep { /foo\.x/ } @files; } ok $dir->remove_tree, "Removed $dir"; ok !-e $dir, "$dir no longer exists"; ok !$dir->remove_tree, "Removing non-existent dir returns false"; my $tmpdir = Path::Tiny->tempdir; { $dir = path( $tmpdir, 'foo', 'bar' ); $dir->parent->remove_tree if -e $dir->parent; ok $dir->mkpath, "Created $dir"; ok -d $dir, "$dir is a directory"; $dir = $dir->parent; ok $dir->remove_tree( { safe => 1 } ); # check that we pass through args ok !-e $dir; } { $dir = path( $tmpdir, 'foo' ); ok $dir->mkpath; ok $dir->child('dir')->mkpath; ok -d $dir->child('dir'); ok $dir->child('file.x')->touch; ok $dir->child('0')->touch; ok $dir->child('foo/bar/baz.txt')->touchpath; my @contents; my $iter = $dir->iterator; while ( my $file = $iter->() ) { push @contents, $file; } is scalar @contents, 4 or diag explain \@contents; is( $iter->(), undef, "exhausted iterator is undef" ); my $joined = join ' ', sort map $_->basename, grep { -f $_ } @contents; is $joined, '0 file.x' or diag explain \@contents; my ($subdir) = grep { $_ eq $dir->child('dir') } @contents; ok $subdir; is -d $subdir, 1; my ($file) = grep { $_ eq $dir->child('file.x') } @contents; ok $file; is -d $file, ''; ok $dir->remove_tree; ok !-e $dir; # Try again with directory called '0', in curdir my $orig = Path::Tiny->cwd; ok $dir->mkpath; ok chdir($dir); my $dir2 = path("."); ok $dir2->child('0')->mkpath; ok -d $dir2->child('0'); @contents = (); $iter = $dir2->iterator; while ( my $file = $iter->() ) { push @contents, $file; } ok grep { $_ eq '0' } @contents; ok chdir($orig); ok $dir->remove_tree; ok !-e $dir; } { my $file = path( $tmpdir, 'slurp' ); ok $file; my $fh = $file->openw or die "Can't create $file: $!"; print $fh "Line1\nLine2\n"; close $fh; ok -e $file; my $content = $file->slurp; is $content, "Line1\nLine2\n"; my @content = $file->lines; is_deeply \@content, [ "Line1\n", "Line2\n" ]; @content = $file->lines( { chomp => 1 } ); is_deeply \@content, [ "Line1", "Line2" ]; ok( $file->remove, "removing file" ); ok !-e $file, "file is gone"; ok !$file->remove, "removing file again returns false"; } { my $file = path( $tmpdir, 'slurp' ); ok $file; my $fh = $file->openw(':raw') or die "Can't create $file: $!"; print $fh "Line1\r\nLine2\r\n\302\261\r\n"; close $fh; ok -e $file; my $content = $file->slurp( { binmode => ':raw' } ); is $content, "Line1\r\nLine2\r\n\302\261\r\n", "slurp raw"; my $line3 = "\302\261\n"; utf8::decode($line3); $content = $file->slurp( { binmode => ':crlf:utf8' } ); is $content, "Line1\nLine2\n" . $line3, "slurp+crlf+utf8"; my @content = $file->lines( { binmode => ':crlf:utf8' } ); is_deeply \@content, [ "Line1\n", "Line2\n", $line3 ], "lines+crlf+utf8"; chop($line3); @content = $file->lines( { chomp => 1, binmode => ':crlf:utf8' } ); is_deeply \@content, [ "Line1", "Line2", $line3 ], "lines+chomp+crlf+utf8"; $file->remove; ok not -e $file; } { my $file = path( $tmpdir, 'spew' ); $file->remove() if $file->exists; $file->spew( { binmode => ':raw' }, "Line1\r\n" ); $file->append( { binmode => ':raw' }, "Line2" ); my $content = $file->slurp( { binmode => ':raw' } ); is( $content, "Line1\r\nLine2" ); } { # Make sure we can make an absolute/relative roundtrip my $cwd = path("."); is $cwd, $cwd->absolute->relative, "from $cwd to " . $cwd->absolute . " to " . $cwd->absolute->relative; } { # realpath should resolve .. my $lib = path("t/../lib"); my $real = $lib->realpath; unlike $real, qr/\.\./, "updir gone from realpath"; my $abs_lib = $lib->absolute; my $abs_t = path("t")->absolute; my $case = $abs_t->child("../lib"); is( $case->realpath, $lib->realpath, "realpath on absolute" ); # non-existent realpath should throw error eval { path("lkajdfak/djslakdj")->realpath }; like( $@, qr/Error resolving realpath/, "caught error from realpath on non-existent file" ); } { my $file = $tmpdir->child("foo.txt"); $file->spew("Hello World\n"); my $copy = $tmpdir->child("bar.txt"); $file->copy($copy); is( $copy->slurp, "Hello World\n", "file copied" ); chmod 0400, $copy; # read only SKIP: { skip "No exception if run as root", 1 if $> == 0; skip "No exception writing to read-only file", 1 unless exception { open my $fh, ">", "$copy" or die }; # probe if actually read-only my $error = exception { $file->copy($copy) }; ok( $error, "copy throws error if permission denied" ); like( $error, qr/\Q$file/, "error messages includes the source file name" ); like( $error, qr/\Q$copy/, "error messages includes the destination file name" ); } } { $tmpdir->child( "subdir", "touched.txt" )->touchpath->spew("Hello World\n"); is( $tmpdir->child( "subdir", "touched.txt" )->slurp, "Hello World\n", "touch can chain" ); } SKIP: { my $newtmp = Path::Tiny->tempdir; my $file = $newtmp->child("foo.txt"); my $link = $newtmp->child("bar.txt"); $file->spew("Hello World\n"); eval { symlink $file => $link }; skip "symlink unavailable", 1 if $@; ok( $link->lstat->size, "lstat" ); ok $link->remove, 'remove symbolic link'; ok $file->remove; $file = $newtmp->child("foo.txt"); $link = $newtmp->child("bar.txt"); $file->spew("Hello World\n"); ok symlink $file => $link; ok $file->remove; ok $link->remove, 'remove broken symbolic link'; my $dir = $newtmp->child('foo'); $link = $newtmp->child("bar"); ok $dir->mkpath; ok -d $dir; $file = $dir->child("baz.txt"); $file->spew("Hello World\n"); ok symlink $dir => $link; ok $link->remove_tree, 'remove_tree symbolic link'; ok $dir->remove_tree; $dir = $newtmp->child('foo'); $link = $newtmp->child("bar"); ok $dir->mkpath; ok -d $dir; $file = $dir->child("baz.txt"); $file->spew("Hello World\n"); ok symlink $dir => $link; ok $dir->remove_tree; ok $link->remove_tree, 'remove_tree broken symbolic link'; $file = $newtmp->child("foo.txt"); $link = $newtmp->child("bar.txt"); my $link2 = $newtmp->child("baz.txt"); $file->spew("Hello World\n"); ok symlink $file => $link; ok symlink $link => $link2; $link2->spew("Hello Perl\n"); ok -l $link2, 'path is still symbolic link after spewing'; is readlink($link2), $link, 'symbolic link is available after spewing'; is readlink($link), $file, 'symbolic link is available after spewing'; is $file->slurp, "Hello Perl\n", 'spewing follows the link and replace the destination instead'; } # We don't have subsume so comment these out. Keep in case we # implement it later ##{ ## my $t = path( 't'); ## my $foo_bar = $t->child('foo','bar'); ## $foo_bar->remove; # Make sure it doesn't exist ## ## ok $t->subsumes($foo_bar), "t subsumes t/foo/bar"; ## ok !$t->contains($foo_bar), "t doesn't contain t/foo/bar"; ## ## $foo_bar->mkpath; ## ok $t->subsumes($foo_bar), "t still subsumes t/foo/bar"; ## ok $t->contains($foo_bar), "t now contains t/foo/bar"; ## ## $t->child('foo')->remove; ##} done_testing; Path-Tiny-0.052/t/input_output.t000644 000765 000024 00000027075 12265322344 017014 0ustar00davidstaff000000 000000 use 5.008001; use strict; use warnings; use Test::More 0.96; use lib 't/lib'; use TestUtils qw/exception/; use Path::Tiny; my $tmp = Path::Tiny->tempdir; sub _lines { return ( "Line1\r\n", "Line2\n" ); } sub _utf8_lines { my $line3 = "\302\261\n"; utf8::decode($line3); return ( _lines(), $line3 ); } subtest "spew -> slurp" => sub { my $file = Path::Tiny->tempfile; ok( $file->spew(_lines), "spew" ); is( $file->slurp, join( '', _lines ), "slurp" ); }; subtest "spew -> slurp (empty)" => sub { my $file = Path::Tiny->tempfile; ok( $file->spew, "spew" ); is( $file->slurp, '', "slurp" ); }; subtest "spew -> slurp (arrayref)" => sub { my $file = Path::Tiny->tempfile; ok( $file->spew( [_lines] ), "spew" ); is( $file->slurp, join( '', _lines ), "slurp" ); }; subtest "spew -> slurp (binmode)" => sub { my $file = Path::Tiny->tempfile; ok( $file->spew( { binmode => ":utf8" }, _utf8_lines ), "spew" ); is( $file->slurp( { binmode => ":utf8" } ), join( '', _utf8_lines ), "slurp" ); }; subtest "spew -> slurp (open hint)" => sub { plan skip_all => "Needs 5.10" unless $] >= 5.010; use open IO => ":utf8"; my $file = Path::Tiny->tempfile; ok( $file->spew(_utf8_lines), "spew" ); my $got = $file->slurp(); is( $got, join( '', _utf8_lines ), "slurp" ); ok( utf8::is_utf8($got), "is UTF8" ); }; subtest "spew -> slurp (UTF-8)" => sub { my $file = Path::Tiny->tempfile; ok( $file->spew_utf8(_utf8_lines), "spew" ); my $got = $file->slurp_utf8(); is( $got, join( '', _utf8_lines ), "slurp" ); ok( utf8::is_utf8($got), "is UTF8" ); }; subtest "spew -> slurp (raw)" => sub { my $file = Path::Tiny->tempfile; ok( $file->spew_raw(_lines), "spew" ); is( $file->slurp_raw, join( '', _lines ), "slurp" ); }; subtest "spew -> lines" => sub { my $file = Path::Tiny->tempfile; ok( $file->spew(_lines), "spew" ); is( join( '', $file->lines ), join( '', _lines ), "lines" ); is( scalar $file->lines, my $cnt =()= _lines, "lines (scalar)" ); }; subtest "spew -> lines (open hint)" => sub { plan skip_all => "Needs 5.10" unless $] >= 5.010; use open IO => ":utf8"; my $file = Path::Tiny->tempfile; ok( $file->spew(_utf8_lines), "spew" ); my $got = join( '', $file->lines() ); is( $got, join( '', _utf8_lines ), "slurp" ); ok( utf8::is_utf8($got), "is UTF8" ); }; subtest "spew -> lines (UTF-8)" => sub { my $file = Path::Tiny->tempfile; ok( $file->spew_utf8(_utf8_lines), "spew" ); my $got = join( '', $file->lines_utf8() ); is( $got, join( '', _utf8_lines ), "slurp" ); ok( utf8::is_utf8($got), "is UTF8" ); is( scalar $file->lines, my $cnt =()= _utf8_lines, "lines (scalar)" ); }; subtest "spew -> lines (raw)" => sub { my $file = Path::Tiny->tempfile; ok( $file->spew_raw(_lines), "spew" ); is( join( '', $file->lines_raw ), join( '', _lines ), "lines" ); }; subtest "spew -> lines (count)" => sub { my $file = Path::Tiny->tempfile; ok( $file->spew(_lines), "spew" ); my @exp = _lines; is( join( '', $file->lines( { count => 2 } ) ), join( '', @exp[ 0 .. 1 ] ), "lines" ); }; subtest "spew -> lines (count, less than)" => sub { my $file = Path::Tiny->tempfile; ok( $file->spew(_lines), "spew" ); my @exp = _lines; is( join( '', $file->lines( { count => 1 } ) ), $exp[0], "lines" ); }; subtest "spew -> lines (count, more than)" => sub { my $file = Path::Tiny->tempfile; ok( $file->spew(_lines), "spew" ); my @exp = _lines; is( join( '|', $file->lines( { count => 3 } ) ), join( "|", @exp ), "lines" ); }; subtest "spew -> lines (count, chomp)" => sub { my $file = Path::Tiny->tempfile; ok( $file->spew(_lines), "spew" ); my @exp = map { s/[\r\n]+//; $_ } _lines; is( join( '', $file->lines( { chomp => 1, count => 2 } ) ), join( '', @exp[ 0 .. 1 ] ), "lines" ); }; subtest "spew -> lines (count, UTF-8)" => sub { my $file = Path::Tiny->tempfile; ok( $file->spew_utf8(_utf8_lines), "spew" ); my @exp = _utf8_lines; is( join( '', $file->lines_utf8( { count => 3 } ) ), join( '', @exp ), "lines" ); }; subtest "spew -> lines (count, chomp, UTF-8)" => sub { my $file = Path::Tiny->tempfile; ok( $file->spew_utf8(_utf8_lines), "spew" ); my @exp = map { s/[\r\n]+//; $_ } _utf8_lines; is( join( '', $file->lines_utf8( { chomp => 1, count => 2 } ) ), join( '', @exp[ 0 .. 1 ] ), "lines" ); }; subtest "spew -> lines (chomp, UTF-8)" => sub { my $file = Path::Tiny->tempfile; ok( $file->spew_utf8(_utf8_lines), "spew" ); my @exp = map { s/[\r\n]+//; $_ } _utf8_lines; is( join( '', $file->lines_utf8( { chomp => 1 } ) ), join( '', @exp ), "lines" ); }; subtest "spew -> lines (count, raw)" => sub { my $file = Path::Tiny->tempfile; ok( $file->spew_raw(_lines), "spew" ); my @exp = _lines; is( join( '', $file->lines_raw( { count => 2 } ) ), join( '', @exp ), "lines" ); }; subtest "append -> slurp" => sub { my $file = Path::Tiny->tempfile; ok( $file->append(_lines), "append" ); is( $file->slurp, join( '', _lines ), "slurp" ); }; subtest "append -> slurp (empty)" => sub { my $file = Path::Tiny->tempfile; ok( $file->append, "append" ); is( $file->slurp, "", "slurp" ); }; subtest "append -> slurp (arrayref)" => sub { my $file = Path::Tiny->tempfile; ok( $file->append( [_lines] ), "append" ); is( $file->slurp, join( '', _lines ), "slurp" ); }; subtest "append -> slurp (piecemeal)" => sub { my $file = Path::Tiny->tempfile; ok( $file->append($_), "piecemeal append" ) for _lines; is( $file->slurp, join( '', _lines ), "slurp" ); }; subtest "append -> slurp (binmode)" => sub { my $file = Path::Tiny->tempfile; ok( $file->append( { binmode => ":utf8" }, _utf8_lines ), "append" ); is( $file->slurp( { binmode => ":utf8" } ), join( '', _utf8_lines ), "slurp" ); }; subtest "append -> slurp (open hint)" => sub { plan skip_all => "Needs 5.10" unless $] >= 5.010; use open IO => ':utf8'; my $file = Path::Tiny->tempfile; ok( $file->append(_utf8_lines), "append" ); is( $file->slurp, join( '', _utf8_lines ), "slurp" ); }; subtest "append -> slurp (UTF-8)" => sub { my $file = Path::Tiny->tempfile; ok( $file->append_utf8(_utf8_lines), "append" ); is( $file->slurp_utf8, join( '', _utf8_lines ), "slurp" ); }; subtest "append -> slurp (raw)" => sub { my $file = Path::Tiny->tempfile; ok( $file->append_raw(_lines), "append" ); is( $file->slurp_raw, join( '', _lines ), "slurp" ); }; subtest "openw -> openr" => sub { my $file = Path::Tiny->tempfile; { my $fh = $file->openw; ok( ( print {$fh} _lines ), "openw & print" ); } { my $fh = $file->openr; my $got = do { local $/, <$fh> }; is( $got, join( '', _lines ), "openr & read" ); } }; subtest "openw -> openr (open hint)" => sub { plan skip_all => "Needs 5.10" unless $] >= 5.010; use open IO => ':utf8'; my $file = Path::Tiny->tempfile; { my $fh = $file->openw; ok( ( print {$fh} _utf8_lines ), "openw & print" ); } { my $fh = $file->openr; my $got = do { local $/, <$fh> }; is( $got, join( '', _utf8_lines ), "openr & read" ); ok( utf8::is_utf8($got), "is UTF8" ); } }; subtest "openw -> openr (UTF-8)" => sub { my $file = Path::Tiny->tempfile; { my $fh = $file->openw_utf8; ok( ( print {$fh} _utf8_lines ), "openw & print" ); } { my $fh = $file->openr_utf8; my $got = do { local $/, <$fh> }; is( $got, join( '', _utf8_lines ), "openr & read" ); ok( utf8::is_utf8($got), "is UTF8" ); } }; subtest "openw -> openr (raw)" => sub { my $file = Path::Tiny->tempfile; { my $fh = $file->openw_raw; ok( ( print {$fh} _lines ), "openw & print" ); } { my $fh = $file->openr_raw; my $got = do { local $/, <$fh> }; is( $got, join( '', _lines ), "openr & read" ); } }; subtest "opena -> openr" => sub { my $file = Path::Tiny->tempfile; my @lines = _lines; { my $fh = $file->openw; ok( ( print {$fh} shift @lines ), "openw & print one line" ); } { my $fh = $file->opena; ok( ( print {$fh} @lines ), "opena & print rest of lines" ); } { my $fh = $file->openr; my $got = do { local $/, <$fh> }; is( $got, join( '', _lines ), "openr & read" ); } }; subtest "opena -> openr (open hint)" => sub { plan skip_all => "Needs 5.10" unless $] >= 5.010; use open IO => ':utf8'; my $file = Path::Tiny->tempfile; my @lines = _utf8_lines; { my $fh = $file->openw; ok( ( print {$fh} shift @lines ), "openw & print one line" ); } { my $fh = $file->opena; ok( ( print {$fh} @lines ), "opena & print rest of lines" ); } { my $fh = $file->openr; my $got = do { local $/, <$fh> }; is( $got, join( '', _utf8_lines ), "openr & read" ); ok( utf8::is_utf8($got), "is UTF8" ); } }; subtest "opena -> openr (UTF-8)" => sub { my $file = Path::Tiny->tempfile; my @lines = _utf8_lines; { my $fh = $file->openw_utf8; ok( ( print {$fh} shift @lines ), "openw & print one line" ); } { my $fh = $file->opena_utf8; ok( ( print {$fh} @lines ), "opena & print rest of lines" ); } { my $fh = $file->openr_utf8; my $got = do { local $/, <$fh> }; is( $got, join( '', _utf8_lines ), "openr & read" ); ok( utf8::is_utf8($got), "is UTF8" ); } }; subtest "opena -> openr (raw)" => sub { my $file = Path::Tiny->tempfile; my @lines = _lines; { my $fh = $file->openw_raw; ok( ( print {$fh} shift @lines ), "openw & print one line" ); } { my $fh = $file->opena_raw; ok( ( print {$fh} @lines ), "opena & print rest of lines" ); } { my $fh = $file->openr_raw; my $got = do { local $/, <$fh> }; is( $got, join( '', _lines ), "openr & read" ); } }; subtest "openrw" => sub { my $file = Path::Tiny->tempfile; my $fh = $file->openrw; ok( ( print {$fh} _lines ), "openrw & print" ); ok( seek( $fh, 0, 0 ), "seek back to start" ); my $got = do { local $/, <$fh> }; is( $got, join( '', _lines ), "openr & read" ); }; subtest "openrw (open hint)" => sub { plan skip_all => "Needs 5.10" unless $] >= 5.010; use open IO => ':utf8'; my $file = Path::Tiny->tempfile; my $fh = $file->openrw; ok( ( print {$fh} _utf8_lines ), "openrw & print" ); ok( seek( $fh, 0, 0 ), "seek back to start" ); my $got = do { local $/, <$fh> }; is( $got, join( '', _utf8_lines ), "openr & read" ); ok( utf8::is_utf8($got), "is UTF8" ); }; subtest "openrw (UTF-8)" => sub { my $file = Path::Tiny->tempfile; my $fh = $file->openrw_utf8; ok( ( print {$fh} _utf8_lines ), "openrw & print" ); ok( seek( $fh, 0, 0 ), "seek back to start" ); my $got = do { local $/, <$fh> }; is( $got, join( '', _utf8_lines ), "openr & read" ); ok( utf8::is_utf8($got), "is UTF8" ); }; subtest "openrw (raw)" => sub { my $file = Path::Tiny->tempfile; my $fh = $file->openrw_raw; ok( ( print {$fh} _lines ), "openrw & print" ); ok( seek( $fh, 0, 0 ), "seek back to start" ); my $got = do { local $/, <$fh> }; is( $got, join( '', _lines ), "openr & read" ); }; done_testing; # # This file is part of Path-Tiny # # This software is Copyright (c) 2013 by David Golden. # # This is free software, licensed under: # # The Apache License, Version 2.0, January 2004 # Path-Tiny-0.052/t/input_output_no_UU.t000644 000765 000024 00000000602 12265322344 020104 0ustar00davidstaff000000 000000 use 5.008001; use strict; use warnings; use Test::More 0.96; # Tiny equivalent of Devel::Hide BEGIN { $INC{'Unicode/UTF8.pm'} = undef; } note "Hiding Unicode::UTF8"; do "t/input_output.t"; # # This file is part of Path-Tiny # # This software is Copyright (c) 2013 by David Golden. # # This is free software, licensed under: # # The Apache License, Version 2.0, January 2004 # Path-Tiny-0.052/t/lib/000755 000765 000024 00000000000 12265322344 014603 5ustar00davidstaff000000 000000 Path-Tiny-0.052/t/locking.t000644 000765 000024 00000002121 12265322344 015644 0ustar00davidstaff000000 000000 use 5.008001; use strict; use warnings; use Test::More 0.96; use File::Spec; use Cwd; use lib 't/lib'; use TestUtils qw/exception/; use Fcntl ':flock'; use Path::Tiny; my $IS_BSD = $^O =~ /bsd$/; if ($IS_BSD) { # is temp partition lockable? my $file = Path::Tiny->tempfile; open my $fh, ">>", $file; flock $fh, LOCK_EX or plan skip_all => "Can't lock tempfiles on this OS/filesystem"; } subtest 'write locks blocks read lock' => sub { my $file = Path::Tiny->tempfile; ok $file, "Got a tempfile"; my $fh = $file->openw( { locked => 1 } ); ok $fh, "Opened file for writing with lock"; $fh->autoflush(1); print {$fh} "hello"; # check if a different process can get a lock; use RW mode for AIX my $locktester = Path::Tiny->tempfile; $locktester->spew(<<"HERE"); use strict; use warnings; use Fcntl ':flock'; open my \$fh, "+<", "$file"; exit flock( \$fh, LOCK_SH|LOCK_NB ); HERE my $rc = system( $^X, $locktester ); isnt( $rc, -1, "ran process to try to get lock" ); is( $rc >> 8, 0, "process failed to get lock" ); }; done_testing; Path-Tiny-0.052/t/mkpath.t000644 000765 000024 00000001616 12265322344 015512 0ustar00davidstaff000000 000000 use 5.008001; use strict; use warnings; use Test::More 0.96; use File::Temp (); use lib 't/lib'; use TestUtils qw/exception/; use Path::Tiny; my $tempdir = File::Temp->newdir; my $path = path($tempdir)->child("foo"); ok( !-e $path, "target directory not created yet" ); ok( $path->mkpath, "mkpath on directory returned true" ); ok( -d $path, "target directory created" ); if ( $^O ne 'MSWin32' ) { my $path2 = path($tempdir)->child("bar"); ok( !-e $path2, "target directory not created yet" ); ok( $path2->mkpath( { mode => 0700 } ), "mkpath on directory with mode" ); is( $path2->stat->mode & 0777, 0700, "correct mode" ); ok( -d $path2, "target directory created" ); } done_testing; # # This file is part of Path-Tiny # # This software is Copyright (c) 2013 by David Golden. # # This is free software, licensed under: # # The Apache License, Version 2.0, January 2004 # Path-Tiny-0.052/t/mutable_tree_while_iterating.t000644 000765 000024 00000001447 12265322344 022136 0ustar00davidstaff000000 000000 use strict; use warnings; use Test::More 0.88; use Path::Tiny; use lib 't/lib'; use TestUtils qw/exception tempd/; use Path::Tiny; my $wd = tempd; my @tree = qw( base/Bethlehem/XDG/gift_list.txt base/Vancouver/ETHER/.naughty base/Vancouver/ETHER/gift_list.txt base/New_York/XDG/gift_list.txt ); path($_)->touchpath for @tree; my @files; my $iter = path('base')->iterator( { recurse => 1 } ); my $exception = exception { while ( my $path = $iter->() ) { $path->remove_tree if $path->child('.naughty')->is_file; push @files, $path if $path->is_file; } }; is( $exception, '', 'can remove directories while traversing' ); is_deeply( [ sort @files ], [ 'base/Bethlehem/XDG/gift_list.txt', 'base/New_York/XDG/gift_list.txt' ], 'remaining files', ); done_testing; Path-Tiny-0.052/t/normalize.t000644 000765 000024 00000001602 12265322344 016221 0ustar00davidstaff000000 000000 use 5.008001; use strict; use warnings; use Test::More 0.96; use lib 't/lib'; use TestUtils qw/exception/; use Path::Tiny; my @cases = ( #<<< [ '.' => '.' ], [ './' => '.' ], [ '/' => '/' ], [ '/.' => '/' ], [ '..' => '..' ], [ '/..' => '/' ], [ '../' => '..' ], [ '../..' => '../..' ], [ '/./' => '/' ], [ '/foo/' => '/foo' ], [ 'foo/' => 'foo' ], [ './foo' => 'foo' ], [ 'foo/.' => 'foo' ], #>>> ); for my $c (@cases) { my ( $in, $out ) = @$c; my $label = defined($in) ? $in : "undef"; $label = "empty" unless length $label; is( path($in)->stringify, $out, sprintf( "%5s -> %-5s", $label, $out ) ); } done_testing; # # This file is part of Path-Tiny # # This software is Copyright (c) 2013 by David Golden. # # This is free software, licensed under: # # The Apache License, Version 2.0, January 2004 # Path-Tiny-0.052/t/overloading.t000644 000765 000024 00000001026 12265322344 016532 0ustar00davidstaff000000 000000 use 5.008001; use strict; use warnings; use Test::More 0.96; use lib 't/lib'; use TestUtils qw/exception/; use Path::Tiny; my $path = path("t/stringify.t"); is( "$path", "t/stringify.t", "stringify via overloading" ); is( $path->stringify, "t/stringify.t", "stringify via method" ); ok( $path, "boolifies to true" ); done_testing; # # This file is part of Path-Tiny # # This software is Copyright (c) 2013 by David Golden. # # This is free software, licensed under: # # The Apache License, Version 2.0, January 2004 # Path-Tiny-0.052/t/parent.t000644 000765 000024 00000006100 12265322344 015510 0ustar00davidstaff000000 000000 use 5.008001; use strict; use warnings; use Test::More 0.96; use lib 't/lib'; use TestUtils qw/exception/; my $DEBUG; BEGIN { $DEBUG = 0 } BEGIN { if ($DEBUG) { require Path::Class; Path::Class->import } } my $IS_WIN32 = $^O eq 'MSWin32'; use Path::Tiny; use File::Spec::Functions qw/canonpath/; sub canonical { my $d = canonpath(shift); $d =~ s{\\}{/}g; $d .= "/" if $d =~ m{//[^/]+/[^/]+$}; return $d; } my @cases = ( #<<< No perltidy "absolute" => [ "/foo/bar" => "/foo" => "/" => "/" ], "relative" => [ "foo/bar/baz" => "foo/bar" => "foo" => "." => ".." => "../.." => "../../.." ], "absolute with .." => [ "/foo/bar/../baz" => "/foo/bar/.." => "/foo/bar/../.." => "/foo/bar/../../.." ], "relative with .." => [ "foo/bar/../baz" => "foo/bar/.." => "foo/bar/../.." => "foo/bar/../../.." ], "relative with leading .." => [ "../foo/bar" => "../foo" => ".." => "../.." ], "absolute with internal dots" => [ "/foo..bar/baz..bam" => "/foo..bar" => "/" ], "relative with internal dots" => [ "foo/bar..baz/wib..wob" => "foo/bar..baz" => "foo" => "." => ".." ], "absolute with leading dots" => [ "/..foo/..bar" => "/..foo" => "/" ], "relative with leading dots" => [ "..foo/..bar/..wob" => "..foo/..bar" => "..foo" => "." => ".." ], "absolute with trailing dots" => [ "/foo../bar.." => "/foo.." => "/" ], "relative with trailing dots" => [ "foo../bar../wob.." => "foo../bar.." => "foo.." => "." => ".." ], #>>> ); my @win32_cases = ( #<<< No perltidy "absolute with drive" => [ "C:/foo/bar" => "C:/foo" => "C:/" => "C:/" ], "absolute with drive and .." => [ "C:/foo/bar/../baz" => "C:/foo" => "C:/" ], "absolute with UNC" => [ "//server/share/foo/bar" => "//server/share/foo" => "//server/share/" => "//server/share/" ], "absolute with drive, UNC and .." => [ "//server/share/foo/bar/../baz" => "//server/share/foo" => "//server/share/" ], #>>> ); push @cases, @win32_cases if $IS_WIN32; while (@cases) { my ( $label, $list ) = splice( @cases, 0, 2 ); subtest $label => sub { my $path = path( shift @$list ); while (@$list) { for my $i ( undef, 0, 1 .. @$list ) { my $n = ( defined $i && $i > 0 ) ? $i : 1; my $expect = $list->[ $n - 1 ]; my $got = $path->parent($i); my $s = defined($i) ? $i : "undef"; is( $got, canonical($expect), "parent($s): $path -> $got" ); is( dir("$path")->parent, canonical($expect), "Path::Class agrees" ) if $DEBUG; } $path = $path->parent; shift @$list; } if ( $path !~ m{\Q..\E} ) { ok( $path->is_rootdir, "final path is root directory" ); } }; } done_testing; # # This file is part of Path-Tiny # # This software is Copyright (c) 2013 by David Golden. # # This is free software, licensed under: # # The Apache License, Version 2.0, January 2004 # Path-Tiny-0.052/t/README000644 000765 000024 00000000326 12265322344 014716 0ustar00davidstaff000000 000000 Some test files are adapted from those in Path::Class. Path::Tiny isn't API compatible so some adjustments have been made. For the most part, these tests are here to see if it handles special cases the same way. Path-Tiny-0.052/t/recurse.t000644 000765 000024 00000004633 12265322344 015700 0ustar00davidstaff000000 000000 use 5.006; use strict; use warnings; use Test::More 0.92; use File::Temp; use Config; use lib 't/lib'; use TestUtils qw/exception tempd/; use Path::Tiny; #--------------------------------------------------------------------------# subtest 'no symlinks' => sub { my $wd = tempd; my @tree = qw( aaaa.txt bbbb.txt cccc/dddd.txt cccc/eeee/ffff.txt gggg.txt ); my @breadth = qw( aaaa.txt bbbb.txt cccc gggg.txt cccc/dddd.txt cccc/eeee cccc/eeee/ffff.txt ); path($_)->touchpath for @tree; my $iter = path(".")->iterator( { recurse => 1 } ); my @files; while ( my $f = $iter->() ) { push @files, "$f"; } is_deeply( [ sort @files ], [ sort @breadth ], "Breadth first iteration" ) or diag explain \@files; }; subtest 'with symlinks' => sub { plan skip_all => "No symlink support" unless $Config{d_symlink}; my $wd = tempd; my @tree = qw( aaaa.txt bbbb.txt cccc/dddd.txt cccc/eeee/ffff.txt gggg.txt ); my @follow = qw( aaaa.txt bbbb.txt cccc gggg.txt pppp qqqq.txt cccc/dddd.txt cccc/eeee cccc/eeee/ffff.txt pppp/ffff.txt ); my @nofollow = qw( aaaa.txt bbbb.txt cccc gggg.txt pppp qqqq.txt cccc/dddd.txt cccc/eeee cccc/eeee/ffff.txt ); path($_)->touchpath for @tree; symlink path( 'cccc', 'eeee' ), path('pppp'); symlink path('aaaa.txt'), path('qqqq.txt'); subtest 'no follow' => sub { # no-follow my $iter = path(".")->iterator( { recurse => 1 } ); my @files; while ( my $f = $iter->() ) { push @files, "$f"; } is_deeply( [ sort @files ], [ sort @nofollow ], "Don't follow symlinks" ) or diag explain \@files; }; subtest 'follow' => sub { my $iter = path(".")->iterator( { recurse => 1, follow_symlinks => 1 } ); my @files; while ( my $f = $iter->() ) { push @files, "$f"; } is_deeply( [ sort @files ], [ sort @follow ], "Follow symlinks" ) or diag explain \@files; }; }; done_testing; # # This file is part of Path-Tiny # # This software is Copyright (c) 2013 by David Golden. # # This is free software, licensed under: # # The Apache License, Version 2.0, January 2004 # Path-Tiny-0.052/t/rel-abs.t000644 000765 000024 00000001063 12265322344 015547 0ustar00davidstaff000000 000000 use 5.008001; use strict; use warnings; use Test::More 0.96; use lib 't/lib'; use TestUtils qw/exception/; use Path::Tiny; my $rel1 = path("."); my $abs1 = $rel1->absolute; is( $abs1->absolute, $abs1, "absolute of absolute is identity" ); my $rel2 = $rel1->child("t"); my $abs2 = $rel2->absolute; is( $rel2->absolute($abs1), $abs2, "absolute on base" ); done_testing; # # This file is part of Path-Tiny # # This software is Copyright (c) 2013 by David Golden. # # This is free software, licensed under: # # The Apache License, Version 2.0, January 2004 # Path-Tiny-0.052/t/subsumes.t000644 000765 000024 00000006242 12265322344 016074 0ustar00davidstaff000000 000000 use 5.008001; use strict; use warnings; use Test::More 0.96; use lib 't/lib'; use TestUtils qw/exception/; use Path::Tiny; use Cwd; my $IS_WIN32 = $^O eq 'MSWin32'; my @cases = ( # path1 => path2 => path1->subsumes(path2) "identity always subsumes" => [ [ '.' => '.' => 1 ], [ '/' => '/' => 1 ], [ '..' => '..' => 1 ], [ '../..' => '../..' => 1 ], [ '/foo/' => '/foo' => 1 ], [ 'foo/' => 'foo' => 1 ], [ './foo' => 'foo' => 1 ], [ 'foo/.' => 'foo' => 1 ], ], "absolute v. absolute" => [ [ '/foo' => '/foo/bar' => 1 ], [ '/foo' => '/foo/bar/baz' => 1 ], [ '/foo' => '/foo/bar/baz/' => 1 ], [ '/' => '/foo' => 1 ], [ '/foo' => '/bar' => 0 ], [ '/foo/bar' => '/foo/baz' => 0 ], ], "relative v. relative" => [ [ '.' => 'foo' => 1 ], [ 'foo' => 'foo/baz' => 1 ], [ './foo/bar' => 'foo/bar/baz' => 1 ], [ './foo/bar' => './foo/bar' => 1 ], [ './foo/bar' => 'foo/bar' => 1 ], [ 'foo/bar' => './foo/bar' => 1 ], [ 'foo/bar' => 'foo/baz' => 0 ], ], "relative v. absolute" => [ [ path(".")->absolute => 't' => 1 ], [ "." => path('t')->absolute => 1 ], [ "foo" => path('t')->absolute => 0 ], [ path("..")->realpath => 't' => 1 ], [ path("lib")->absolute => 't' => 0 ], ], "updirs in paths" => [ [ '/foo' => '/foo/bar/baz/..' => 1 ], [ '/foo/bar' => '/foo/bar/../baz' => $IS_WIN32 ? 0 : 1 ], [ '/foo/../bar' => '/bar' => $IS_WIN32 ? 1 : 0 ], [ '..' => '../bar' => 1 ], ], ); if ($IS_WIN32) { my $vol = path( Win32::GetCwd() )->volume . "/"; my $other = $vol ne 'Z:/' ? 'Z:/' : 'Y:/'; push @cases, 'Win32 cases', [ [ "C:/foo" => "C:/foo" => 1 ], [ "C:/foo" => "C:/bar" => 0 ], [ "C:/" => "C:/foo" => 1 ], [ "C:/" => "D:/" => 0 ], [ "${vol}foo" => "/foo" => 1 ], [ $vol => "/foo" => 1 ], [ $vol => $other => 0 ], [ "/" => $vol => 1 ], [ "/" => $other => 0 ], [ "/foo" => "${vol}foo" => 1 ], ]; } while (@cases) { my ( $subtest, $tests ) = splice( @cases, 0, 2 ); subtest $subtest => sub { for my $t (@$tests) { my ( $path1, $path2, $subsumes ) = @$t; my $label = join( " ", $path1, ( $subsumes ? "subsumes" : "does not subsume" ), $path2 ); ok( !!path($path1)->subsumes($path2) eq !!$subsumes, $label ) or diag "PATH 1:\n", explain( path($path1) ), "\nPATH2:\n", explain( path($path2) ); } }; } done_testing; # # This file is part of Path-Tiny # # This software is Copyright (c) 2013 by David Golden. # # This is free software, licensed under: # # The Apache License, Version 2.0, January 2004 # Path-Tiny-0.052/t/temp.t000644 000765 000024 00000003520 12265322344 015167 0ustar00davidstaff000000 000000 use 5.008001; use strict; use warnings; use Test::More 0.96; use File::Spec::Unix; use lib 't/lib'; use TestUtils qw/exception tempd/; use Path::Tiny; subtest "tempdir" => sub { my $tempdir = Path::Tiny->tempdir; my $string = $tempdir->stringify; ok( $tempdir->exists, "tempdir exists" ); undef $tempdir; ok( !-e $string, "tempdir destroyed" ); }; subtest "tempfile" => sub { my $tempfile = Path::Tiny->tempfile; my $string = $tempfile->stringify; ok( $tempfile->exists, "tempfile exists" ); undef $tempfile; ok( !-e $string, "tempfile destroyed" ); }; subtest "tempdir w/ TEMPLATE" => sub { my $tempdir = Path::Tiny->tempdir( TEMPLATE => "helloXXXXX" ); like( $tempdir, qr/hello/, "found template" ); }; subtest "tempfile w/ TEMPLATE" => sub { my $tempfile = Path::Tiny->tempfile( TEMPLATE => "helloXXXXX" ); like( $tempfile, qr/hello/, "found template" ); }; subtest "tempdir w/ leading template" => sub { my $tempdir = Path::Tiny->tempdir("helloXXXXX"); like( $tempdir, qr/hello/, "found template" ); }; subtest "tempfile w/ leading template" => sub { my $tempfile = Path::Tiny->tempfile("helloXXXXX"); like( $tempfile, qr/hello/, "found template" ); }; subtest "tempfile handle" => sub { my $tempfile = Path::Tiny->tempfile; my $fh = $tempfile->filehandle; is( ref $tempfile->[5], 'File::Temp', "cached File::Temp object" ); is( fileno $tempfile->[5], undef, "cached handle is closed" ); }; subtest "survives absolute" => sub { my $wd = tempd; my $tempdir = Path::Tiny->tempdir( DIR => '.' )->absolute; ok( -d $tempdir, "exists" ); }; done_testing; # # This file is part of Path-Tiny # # This software is Copyright (c) 2013 by David Golden. # # This is free software, licensed under: # # The Apache License, Version 2.0, January 2004 # Path-Tiny-0.052/t/zzz-spec.t000644 000765 000024 00000026067 12265322344 016022 0ustar00davidstaff000000 000000 use 5.008001; use strict; use warnings; use Test::More 0.96; use lib 't/lib'; use TestUtils qw/exception/; use Path::Tiny; use Cwd; my $IS_WIN32 = $^O eq 'MSWin32'; # tests adapted from File::Spec's t/Spec.t test # Each element in this array is a single test. Storing them this way makes # maintenance easy, and should be OK since perl should be pretty functional # before these tests are run. # the third column has Win32 specific alternative output; this appears to be # collapsing of foo/../bar type structures since Win32 has no symlinks and # doesn't need to keep the '..' part. -- xdg, 2013-01-30 my @tests = ( # [ Function , Expected , Win32-different ] [ "path('a','b','c')", 'a/b/c' ], [ "path('a','b','./c')", 'a/b/c' ], [ "path('./a','b','c')", 'a/b/c' ], [ "path('c')", 'c' ], [ "path('./c')", 'c' ], [ "path('/')", '/' ], [ "path('d1','d2','d3','')", 'd1/d2/d3' ], [ "path('d1','d2','d3')", 'd1/d2/d3' ], [ "path('/','d2/d3')", '/d2/d3' ], [ "path('/.')", '/' ], [ "path('/./')", '/' ], [ "path('/a/./')", '/a' ], [ "path('/a/.')", '/a' ], [ "path('/../../')", '/' ], [ "path('/../..')", '/' ], [ "path('/t1/t2/t4')->relative('/t1/t2/t3')", '../t4' ], [ "path('/t1/t2')->relative('/t1/t2/t3')", '..' ], [ "path('/t1/t2/t3/t4')->relative('/t1/t2/t3')", 't4' ], [ "path('/t4/t5/t6')->relative('/t1/t2/t3')", '../../../t4/t5/t6' ], [ "path('/')->relative('/t1/t2/t3')", '../../..' ], [ "path('///')->relative('/t1/t2/t3')", '../../..' ], [ "path('/.')->relative('/t1/t2/t3')", '../../..' ], [ "path('/./')->relative('/t1/t2/t3')", '../../..' ], [ "path('/t1/t2/t3')->relative( '/')", 't1/t2/t3' ], [ "path('/t1/t2/t3')->relative( '/t1')", 't2/t3' ], [ "path('t1/t2/t3')->relative( 't1')", 't2/t3' ], [ "path('t1/t2/t3')->relative( 't4')", '../t1/t2/t3' ], [ "path('.')->relative( '.')", '.' ], [ "path('/')->relative( '/')", '.' ], [ "path('../t1')->relative( 't2/t3')", '../../../t1' ], [ "path('t1')->relative( 't2/../t3')", '../t1' ], [ "path('t4')->absolute('/t1/t2/t3')", '/t1/t2/t3/t4' ], [ "path('t4/t5')->absolute('/t1/t2/t3')", '/t1/t2/t3/t4/t5' ], [ "path('.')->absolute('/t1/t2/t3')", '/t1/t2/t3' ], [ "path('///../../..//./././a//b/.././c/././')", '/a/b/../c', '/a/c' ], [ "path('a/../../b/c')", 'a/../../b/c', '../b/c' ], [ "path('..')->absolute('/t1/t2/t3')", '/t1/t2/t3/..', '/t1/t2' ], [ "path('../t4')->absolute('/t1/t2/t3')", '/t1/t2/t3/../t4', '/t1/t2/t4' ], # need to wash through rootdir->absolute->child to pick up volume on Windows [ "path('/t1')->absolute('/t1/t2/t3')", Path::Tiny->rootdir->absolute->child("t1") ], ); my @win32_tests; # this is lazy so we don't invoke any calls unless we're on Windows if ($IS_WIN32) { @win32_tests = ( [ "path('/')", '/' ], [ "path('/', '../')", '/' ], [ "path('/', '..\\')", '/' ], [ "path('\\', '../')", '/' ], [ "path('\\', '..\\')", '/' ], [ "path('\\d1\\','d2')", '/d1/d2' ], [ "path('\\d1','d2')", '/d1/d2' ], [ "path('\\d1','\\d2')", '/d1/d2' ], [ "path('\\d1','\\d2\\')", '/d1/d2' ], [ "path('d1','d2','d3','')", 'd1/d2/d3' ], [ "path('d1','d2','d3')", 'd1/d2/d3' ], [ "path('A:/d1','d2','d3')", 'A:/d1/d2/d3' ], [ "path('A:/d1','d2','d3','')", 'A:/d1/d2/d3' ], #[ "path('A:/d1','B:/d2','d3','')", 'A:/d1/d2/d3' ], [ "path('A:/d1','B:/d2','d3','')", 'A:/d1/B:/d2/d3' ], [ "path('A:/')", 'A:/' ], [ "path('\\', 'foo')", '/foo' ], [ "path('A:', 'foo')", 'A:/foo' ], [ "path('a','b','c')", 'a/b/c' ], [ "path('a','b','.\\c')", 'a/b/c' ], [ "path('.\\a','b','c')", 'a/b/c' ], [ "path('c')", 'c' ], [ "path('.\\c')", 'c' ], [ "path('a/..','../b')", '../b' ], [ "path('A:', 'foo')", 'A:/foo' ], [ "path('a:/')", 'A:/' ], [ "path('A:f')", 'A:/f' ], [ "path('A:/')", 'A:/' ], [ "path('a\\..\\..\\b\\c')", '../b/c' ], [ "path('//a\\b//c')", '//a/b/c' ], [ "path('/a/..../c')", '/a/..../c' ], [ "path('//a/b\\c')", '//a/b/c' ], [ "path('////')", '/' ], [ "path('//')", '/' ], [ "path('/.')", '/' ], [ "path('//a/b/../../c')", '//a/b/c' ], [ "path('//a/b/c/../d')", '//a/b/d' ], [ "path('//a/b/c/../../d')", '//a/b/d' ], [ "path('//a/b/c/.../d')", '//a/b/d' ], [ "path('/a/b/c/../../d')", '/a/d' ], [ "path('/a/b/c/.../d')", '/a/d' ], [ "path('\\../temp\\')", '/temp' ], [ "path('\\../')", '/' ], [ "path('\\..\\')", '/' ], [ "path('/../')", '/' ], [ "path('/../')", '/' ], [ "path('d1/../foo')", 'foo' ], # if there's no C drive, getdcwd will probably return '', so fake it [ "path('C:')", path( eval { Cwd::getdcwd("C:") } || "C:/" ) ], [ "path('\\\\server\\share\\')", '//server/share/' ], [ "path('\\\\server\\share')", '//server/share/' ], [ "path('//server/share/')", '//server/share/' ], [ "path('//server/share')", '//server/share/' ], [ "path('//d1','d2')", '//d1/d2/' ], ); } # XXX not sure how to adapt this sanely for use with Path::Tiny testing, so # I'll punt for now ## ### FakeWin32 subclass (see below) just sets CWD to C:\one\two and getdcwd('D') to D:\alpha\beta ## ##[ "FakeWin32->abs2rel('/t1/t2/t3','/t1/t2/t3')", '.' ], ##[ "FakeWin32->abs2rel('/t1/t2/t4','/t1/t2/t3')", '..\\t4' ], ##[ "FakeWin32->abs2rel('/t1/t2','/t1/t2/t3')", '..' ], ##[ "FakeWin32->abs2rel('/t1/t2/t3/t4','/t1/t2/t3')", 't4' ], ##[ "FakeWin32->abs2rel('/t4/t5/t6','/t1/t2/t3')", '..\\..\\..\\t4\\t5\\t6' ], ##[ "FakeWin32->abs2rel('../t4','/t1/t2/t3')", '..\\..\\..\\one\\t4' ], # Uses _cwd() ##[ "FakeWin32->abs2rel('/','/t1/t2/t3')", '..\\..\\..' ], ##[ "FakeWin32->abs2rel('///','/t1/t2/t3')", '..\\..\\..' ], ##[ "FakeWin32->abs2rel('/.','/t1/t2/t3')", '..\\..\\..' ], ##[ "FakeWin32->abs2rel('/./','/t1/t2/t3')", '..\\..\\..' ], ##[ "FakeWin32->abs2rel('\\\\a/t1/t2/t4','/t2/t3')", '\\\\a\\t1\\t2\\t4' ], ##[ "FakeWin32->abs2rel('//a/t1/t2/t4','/t2/t3')", '\\\\a\\t1\\t2\\t4' ], ##[ "FakeWin32->abs2rel('A:/t1/t2/t3','A:/t1/t2/t3')", '.' ], ##[ "FakeWin32->abs2rel('A:/t1/t2/t3/t4','A:/t1/t2/t3')", 't4' ], ##[ "FakeWin32->abs2rel('A:/t1/t2/t3','A:/t1/t2/t3/t4')", '..' ], ##[ "FakeWin32->abs2rel('A:/t1/t2/t3','B:/t1/t2/t3')", 'A:\\t1\\t2\\t3' ], ##[ "FakeWin32->abs2rel('A:/t1/t2/t3/t4','B:/t1/t2/t3')", 'A:\\t1\\t2\\t3\\t4' ], ##[ "FakeWin32->abs2rel('E:/foo/bar/baz')", 'E:\\foo\\bar\\baz' ], ##[ "FakeWin32->abs2rel('C:/one/two/three')", 'three' ], ##[ "FakeWin32->abs2rel('C:\\Windows\\System32', 'C:\\')", 'Windows\System32' ], ##[ "FakeWin32->abs2rel('\\\\computer2\\share3\\foo.txt', '\\\\computer2\\share3')", 'foo.txt' ], ##[ "FakeWin32->abs2rel('C:\\one\\two\\t\\asd1\\', 't\\asd\\')", '..\\asd1' ], ##[ "FakeWin32->abs2rel('\\one\\two', 'A:\\foo')", 'C:\\one\\two' ], ## ##[ "FakeWin32->rel2abs('temp','C:/')", 'C:\\temp' ], ##[ "FakeWin32->rel2abs('temp','C:/a')", 'C:\\a\\temp' ], ##[ "FakeWin32->rel2abs('temp','C:/a/')", 'C:\\a\\temp' ], ##[ "FakeWin32->rel2abs('../','C:/')", 'C:\\' ], ##[ "FakeWin32->rel2abs('../','C:/a')", 'C:\\' ], ##[ "FakeWin32->rel2abs('\\foo','C:/a')", 'C:\\foo' ], ##[ "FakeWin32->rel2abs('temp','//prague_main/work/')", '\\\\prague_main\\work\\temp' ], ##[ "FakeWin32->rel2abs('../temp','//prague_main/work/')", '\\\\prague_main\\work\\temp' ], ##[ "FakeWin32->rel2abs('temp','//prague_main/work')", '\\\\prague_main\\work\\temp' ], ##[ "FakeWin32->rel2abs('../','//prague_main/work')", '\\\\prague_main\\work' ], ##[ "FakeWin32->rel2abs('D:foo.txt')", 'D:\\alpha\\beta\\foo.txt' ], ## ##can_ok('File::Spec::Win32', '_cwd'); ## ##{ ## package File::Spec::FakeWin32; ## use vars qw(@ISA); ## @ISA = qw(File::Spec::Win32); ## ## sub _cwd { 'C:\\one\\two' } ## ## # Some funky stuff to override Cwd::getdcwd() for testing purposes, ## # in the limited scope of the rel2abs() method. ## if ($Cwd::VERSION && $Cwd::VERSION gt '2.17') { # Avoid a 'used only once' warning ## local $^W; ## *rel2abs = sub { ## my $self = shift; ## local $^W; ## local *Cwd::getdcwd = sub { ## return 'D:\alpha\beta' if $_[0] eq 'D:'; ## return 'C:\one\two' if $_[0] eq 'C:'; ## return; ## }; ## *Cwd::getdcwd = *Cwd::getdcwd; # Avoid a 'used only once' warning ## return $self->SUPER::rel2abs(@_); ## }; ## *rel2abs = *rel2abs; # Avoid a 'used only once' warning ## } ##} # Tries a named function with the given args and compares the result against # an expected result. Works with functions that return scalars or arrays. for ( @tests, $IS_WIN32 ? @win32_tests : () ) { my ( $function, $expected, $win32case ) = @$_; $expected = $win32case if $IS_WIN32 && $win32case; $function =~ s#\\#\\\\#g; my $got = join ',', eval $function; if ($@) { is( $@, '', $function ); } else { is( $got, $expected, $function ); } } done_testing; # # This file is part of Path-Tiny # # This software is Copyright (c) 2013 by David Golden. # # This is free software, licensed under: # # The Apache License, Version 2.0, January 2004 # Path-Tiny-0.052/t/lib/TestUtils.pm000644 000765 000024 00000001653 12265322344 017106 0ustar00davidstaff000000 000000 use 5.008001; use strict; use warnings; package TestUtils; use Carp; use Cwd qw/getcwd/; use File::Temp 0.19 (); use Exporter; our @ISA = qw/Exporter/; our @EXPORT = qw( exception tempd ); # If we have Test::FailWarnings, use it BEGIN { eval { require Test::FailWarnings; 1 } and do { Test::FailWarnings->import }; } sub exception(&) { my $code = shift; my $success = eval { $code->(); 1 }; my $err = $@; return '' if $success; croak "Execution died, but the error was lost" unless $@; return $@; } sub tempd { my $guard = TestUtils::_Guard->new( { temp => File::Temp->newdir, origin => getcwd(), code => sub { chdir $_[0]{origin} }, } ); chdir $guard->{temp} or croak("Couldn't chdir: $!"); return $guard; } package TestUtils::_Guard; sub new { bless $_[1], $_[0] } sub DESTROY { $_[0]{code}->( $_[0] ) } 1; Path-Tiny-0.052/lib/Path/000755 000765 000024 00000000000 12265322344 015234 5ustar00davidstaff000000 000000 Path-Tiny-0.052/lib/Path/Tiny.pm000644 000765 000024 00000140177 12265322344 016527 0ustar00davidstaff000000 000000 use 5.008001; use strict; use warnings; package Path::Tiny; # ABSTRACT: File path utility our $VERSION = '0.052'; # VERSION # Dependencies use Config; use Exporter 5.57 (qw/import/); use File::Spec 3.40 (); use Carp (); our @EXPORT = qw/path/; our @EXPORT_OK = qw/cwd rootdir tempfile tempdir/; use constant { PATH => 0, CANON => 1, VOL => 2, DIR => 3, FILE => 4, TEMP => 5, IS_BSD => ( scalar $^O =~ /bsd$/ ), IS_WIN32 => ( $^O eq 'MSWin32' ), }; use overload ( q{""} => sub { $_[0]->[PATH] }, bool => sub () { 1 }, fallback => 1, ); my $HAS_UU; # has Unicode::UTF8; lazily populated sub _check_UU { eval { require Unicode::UTF8; Unicode::UTF8->VERSION(0.58); 1 }; } my $HAS_FLOCK = $Config{d_flock} || $Config{d_fcntl_can_lock} || $Config{d_lockf}; # notions of "root" directories differ on Win32: \\server\dir\ or C:\ or \ my $SLASH = qr{[\\/]}; my $NOTSLASH = qr{[^\\/]}; my $DRV_VOL = qr{[a-z]:}i; my $UNC_VOL = qr{$SLASH $SLASH $NOTSLASH+ $SLASH $NOTSLASH+}x; my $WIN32_ROOT = qr{(?: $UNC_VOL $SLASH | $DRV_VOL $SLASH | $SLASH )}x; sub _win32_vol { my ( $path, $drv ) = @_; require Cwd; my $dcwd = eval { Cwd::getdcwd($drv) }; # C: -> C:\some\cwd # getdcwd on non-existent drive returns empty string # so just use the original drive Z: -> Z: $dcwd = "$drv" unless defined $dcwd && length $dcwd; # normalize dwcd to end with a slash: might be C:\some\cwd or D:\ or Z: $dcwd =~ s{$SLASH?$}{/}; # make the path absolute with dcwd $path =~ s{^$DRV_VOL}{$dcwd}; return $path; } # This is a string test for before we have the object; see is_rootdir for well-formed # object test sub _is_root { return IS_WIN32() ? ( $_[0] =~ /^$WIN32_ROOT$/ ) : ( $_[0] eq '/' ); } # flock doesn't work on NFS on BSD. Since program authors often can't control # or detect that, we warn once instead of being fatal if we can detect it and # people who need it strict can fatalize the 'flock' category #<<< No perltidy { package flock; use if Path::Tiny::IS_BSD(), 'warnings::register' } #>>> my $WARNED_BSD_NFS = 0; sub _throw { my ( $self, $function, $file ) = @_; if ( IS_BSD() && $function =~ /^flock/ && $! =~ /operation not supported/i && !warnings::fatal_enabled('flock') ) { if ( !$WARNED_BSD_NFS ) { warnings::warn( flock => "No flock for NFS on BSD: continuing in unsafe mode" ); $WARNED_BSD_NFS++; } } else { Path::Tiny::Error->throw( $function, ( defined $file ? $file : $self->[PATH] ), $! ); } return; } # cheapo option validation sub _get_args { my ( $raw, @valid ) = @_; if ( defined($raw) && ref($raw) ne 'HASH' ) { my ( undef, undef, undef, $called_as ) = caller(1); $called_as =~ s{^.*::}{}; Carp::croak("Options for $called_as must be a hash reference"); } my $cooked = {}; for my $k (@valid) { $cooked->{$k} = delete $raw->{$k} if exists $raw->{$k}; } if ( keys %$raw ) { my ( undef, undef, undef, $called_as ) = caller(1); $called_as =~ s{^.*::}{}; Carp::croak( "Invalid option(s) for $called_as: " . join( ", ", keys %$raw ) ); } return $cooked; } #--------------------------------------------------------------------------# # Constructors #--------------------------------------------------------------------------# sub path { my $path = shift; Carp::croak("path() requires a defined, positive-length argument") unless defined $path && length $path; # stringify initial path $path = "$path"; # expand relative volume paths on windows; put trailing slash on UNC root if ( IS_WIN32() ) { $path = _win32_vol( $path, $1 ) if $path =~ m{^($DRV_VOL)(?:$NOTSLASH|$)}; $path .= "/" if $path =~ m{^$UNC_VOL$}; } # concatenate more arguments (stringifies any objects, too) if (@_) { $path .= ( _is_root($path) ? "" : "/" ) . join( "/", @_ ); } # canonicalize paths my $cpath = $path = File::Spec->canonpath($path); # ugh, but probably worth it $path =~ tr[\\][/] if IS_WIN32(); # unix convention enforced $path .= "/" if IS_WIN32() && $path =~ m{^$UNC_VOL$}; # canonpath strips it # hack to make splitpath give us a basename; root paths must always have # a trailing slash, but other paths must not if ( _is_root($path) ) { $path =~ s{/?$}{/}; } else { $path =~ s{/$}{}; } # do any tilde expansions if ( $path =~ m{^(~[^/]*).*} ) { my ($homedir) = glob($1); # glob without list context == heisenbug! $path =~ s{^(~[^/]*)}{$homedir}; } # and we're finally done bless [ $path, $cpath ], __PACKAGE__; } sub new { shift; path(@_) } sub cwd { require Cwd; return path( Cwd::getcwd() ); } sub rootdir { path( File::Spec->rootdir ) } sub tempfile { shift if $_[0] eq 'Path::Tiny'; # called as method my ( $maybe_template, $args ) = _parse_file_temp_args(@_); # File::Temp->new demands TEMPLATE $args->{TEMPLATE} = $maybe_template->[0] if @$maybe_template; require File::Temp; my $temp = File::Temp->new( TMPDIR => 1, %$args ); close $temp; my $self = path($temp)->absolute; $self->[TEMP] = $temp; # keep object alive while we are return $self; } sub tempdir { shift if $_[0] eq 'Path::Tiny'; # called as method my ( $maybe_template, $args ) = _parse_file_temp_args(@_); # File::Temp->newdir demands leading template require File::Temp; my $temp = File::Temp->newdir( @$maybe_template, TMPDIR => 1, %$args ); my $self = path($temp)->absolute; $self->[TEMP] = $temp; # keep object alive while we are return $self; } # normalize the various ways File::Temp does templates sub _parse_file_temp_args { my $leading_template = ( scalar(@_) % 2 == 1 ? shift(@_) : '' ); my %args = @_; %args = map { uc($_), $args{$_} } keys %args; my @template = ( exists $args{TEMPLATE} ? delete $args{TEMPLATE} : $leading_template ? $leading_template : () ); return ( \@template, \%args ); } #--------------------------------------------------------------------------# # Private methods #--------------------------------------------------------------------------# sub _splitpath { my ($self) = @_; @{$self}[ VOL, DIR, FILE ] = File::Spec->splitpath( $self->[PATH] ); } #--------------------------------------------------------------------------# # Public methods #--------------------------------------------------------------------------# sub absolute { my ( $self, $base ) = @_; # absolute paths handled differently by OS if (IS_WIN32) { return $self if length $self->volume; # add missing volume if ( $self->is_absolute ) { require Cwd; # use Win32::GetCwd not Cwd::getdcwd because we're sure # to have the former but not necessarily the latter my ($drv) = Win32::GetCwd() =~ /^($DRV_VOL | $UNC_VOL)/x; return path( $drv . $self->[PATH] ); } } else { return $self if $self->is_absolute; } # relative path on any OS require Cwd; return path( ( defined($base) ? $base : Cwd::getcwd() ), $_[0]->[PATH] ); } sub append { my ( $self, @data ) = @_; my $args = ( @data && ref $data[0] eq 'HASH' ) ? shift @data : {}; $args = _get_args( $args, qw/binmode/ ); my $binmode = $args->{binmode}; $binmode = ( ( caller(0) )[10] || {} )->{'open>'} unless defined $binmode; my $fh = $self->filehandle( { locked => 1 }, ">>", $binmode ); print {$fh} map { ref eq 'ARRAY' ? @$_ : $_ } @data; close $fh or $self->_throw('close'); } sub append_raw { splice @_, 1, 0, { binmode => ":unix" }; goto &append } sub append_utf8 { if ( defined($HAS_UU) ? $HAS_UU : $HAS_UU = _check_UU() ) { my $self = shift; append( $self, { binmode => ":unix" }, map { Unicode::UTF8::encode_utf8($_) } @_ ); } else { splice @_, 1, 0, { binmode => ":unix:encoding(UTF-8)" }; goto &append; } } sub basename { my ($self) = @_; $self->_splitpath unless defined $self->[FILE]; return $self->[FILE]; } sub canonpath { $_[0]->[CANON] } sub child { my ( $self, @parts ) = @_; return path( $self->[PATH], @parts ); } sub children { my ( $self, $filter ) = @_; my $dh; opendir $dh, $self->[PATH] or $self->_throw('opendir'); my @children = readdir $dh; closedir $dh or $self->_throw('closedir'); if ( not defined $filter ) { @children = grep { $_ ne '.' && $_ ne '..' } @children; } elsif ( $filter && ref($filter) eq 'Regexp' ) { @children = grep { $_ ne '.' && $_ ne '..' && $_ =~ $filter } @children; } else { Carp::croak("Invalid argument '$filter' for children()"); } return map { path( $self->[PATH], $_ ) } @children; } # XXX do recursively for directories? sub copy { my ( $self, $dest ) = @_; require File::Copy; File::Copy::copy( $self->[PATH], $dest ) or Carp::croak("copy failed for $self to $dest: $!"); } sub digest { my ( $self, $alg, @args ) = @_; $alg = 'SHA-256' unless defined $alg; require Digest; return Digest->new( $alg, @args )->add( $self->slurp_raw )->hexdigest; } sub dirname { my ($self) = @_; $self->_splitpath unless defined $self->[DIR]; return length $self->[DIR] ? $self->[DIR] : "."; } sub exists { -e $_[0]->[PATH] } sub is_file { -f $_[0]->[PATH] } sub is_dir { -d $_[0]->[PATH] } # Note: must put binmode on open line, not subsequent binmode() call, so things # like ":unix" actually stop perlio/crlf from being added sub filehandle { my ( $self, @args ) = @_; my $args = ( @args && ref $args[0] eq 'HASH' ) ? shift @args : {}; $args = _get_args( $args, qw/locked/ ); my ( $opentype, $binmode ) = @args; $opentype = "<" unless defined $opentype; Carp::croak("Invalid file mode '$opentype'") unless grep { $opentype eq $_ } qw/< +< > +> >> +>>/; $binmode = ( ( caller(0) )[10] || {} )->{ 'open' . substr( $opentype, -1, 1 ) } unless defined $binmode; $binmode = "" unless defined $binmode; my ( $fh, $lock, $trunc ); if ( $HAS_FLOCK && $args->{locked} ) { require Fcntl; # truncating file modes shouldn't truncate until lock acquired if ( grep { $opentype eq $_ } qw( > +> ) ) { # sysopen in write mode without truncation my $flags = $opentype eq ">" ? Fcntl::O_WRONLY() : Fcntl::O_RDWR(); $flags |= Fcntl::O_CREAT(); sysopen( $fh, $self->[PATH], $flags ) or $self->_throw("sysopen"); # fix up the binmode since sysopen() can't specify layers like # open() and binmode() can't start with just :unix like open() if ( $binmode =~ s/^:unix// ) { # eliminate pseudo-layers binmode( $fh, ":raw" ) or $self->_throw("binmode (:raw)"); # strip off real layers until only :unix is left while ( 1 < ( my $layers =()= PerlIO::get_layers( $fh, output => 1 ) ) ) { binmode( $fh, ":pop" ) or $self->_throw("binmode (:pop)"); } } # apply any remaining binmode layers if ( length $binmode ) { binmode( $fh, $binmode ) or $self->_throw("binmode ($binmode)"); } # ask for lock and truncation $lock = Fcntl::LOCK_EX(); $trunc = 1; } elsif ( $^O eq 'aix' && $opentype eq "<" ) { # AIX can only lock write handles, so upgrade to RW and LOCK_EX $opentype = "+<"; $lock = Fcntl::LOCK_EX(); } else { $lock = $opentype eq "<" ? Fcntl::LOCK_SH() : Fcntl::LOCK_EX(); } } unless ($fh) { my $mode = $opentype . $binmode; open $fh, $mode, $self->[PATH] or $self->_throw("open ($mode)"); } do { flock( $fh, $lock ) or $self->_throw("flock ($lock)") } if $lock; do { truncate( $fh, 0 ) or $self->_throw("truncate") } if $trunc; return $fh; } sub is_absolute { substr( $_[0]->dirname, 0, 1 ) eq '/' } sub is_relative { substr( $_[0]->dirname, 0, 1 ) ne '/' } sub is_rootdir { my ($self) = @_; $self->_splitpath unless defined $self->[DIR]; return $self->[DIR] eq '/' && $self->[FILE] eq ''; } sub iterator { my $self = shift; my $args = _get_args( shift, qw/recurse follow_symlinks/ ); my @dirs = $self; my $current; return sub { my $next; while (@dirs) { if ( ref $dirs[0] eq 'Path::Tiny' ) { if ( !-r $dirs[0] ) { # Directory is missing or not readable, so skip it. There # is still a race condition possible between the check and # the opendir, but we can't easily differentiate between # error cases that are OK to skip and those that we want # to be exceptions, so we live with the race and let opendir # be fatal. shift @dirs and next; } $current = $dirs[0]; my $dh; opendir( $dh, $current->[PATH] ) or $self->_throw( 'opendir', $current->[PATH] ); $dirs[0] = $dh; if ( -l $current->[PATH] && !$args->{follow_symlinks} ) { # Symlink attack! It was a real dir, but is now a symlink! # N.B. we check *after* opendir so the attacker has to win # two races: replace dir with symlink before opendir and # replace symlink with dir before -l check above shift @dirs and next; } } while ( defined( $next = readdir $dirs[0] ) ) { next if $next eq '.' || $next eq '..'; my $path = $current->child($next); push @dirs, $path if $args->{recurse} && -d $path && !( !$args->{follow_symlinks} && -l $path ); return $path; } shift @dirs; } return; }; } sub lines { my $self = shift; my $args = _get_args( shift, qw/binmode chomp count/ ); my $binmode = $args->{binmode}; $binmode = ( ( caller(0) )[10] || {} )->{'open<'} unless defined $binmode; my $fh = $self->filehandle( { locked => 1 }, "<", $binmode ); my $chomp = $args->{chomp}; # XXX more efficient to read @lines then chomp(@lines) vs map? if ( $args->{count} ) { my ( @result, $counter ); while ( my $line = <$fh> ) { $line =~ s/(?:\x{0d}?\x{0a}|\x{0d})$// if $chomp; push @result, $line; last if ++$counter == $args->{count}; } return @result; } elsif ($chomp) { return map { s/(?:\x{0d}?\x{0a}|\x{0d})$//; $_ } <$fh>; ## no critic } else { return wantarray ? <$fh> : ( my $count =()= <$fh> ); } } sub lines_raw { my $self = shift; my $args = _get_args( shift, qw/binmode chomp count/ ); if ( $args->{chomp} && !$args->{count} ) { return split /\n/, slurp_raw($self); ## no critic } else { $args->{binmode} = ":raw"; return lines( $self, $args ); } } sub lines_utf8 { my $self = shift; my $args = _get_args( shift, qw/binmode chomp count/ ); if ( ( defined($HAS_UU) ? $HAS_UU : $HAS_UU = _check_UU() ) && $args->{chomp} && !$args->{count} ) { return split /(?:\x{0d}?\x{0a}|\x{0d})/, slurp_utf8($self); ## no critic } else { $args->{binmode} = ":raw:encoding(UTF-8)"; return lines( $self, $args ); } } sub mkpath { my ( $self, $args ) = @_; $args = {} unless ref $args eq 'HASH'; my $err; $args->{err} = \$err unless defined $args->{err}; require File::Path; my @dirs = File::Path::make_path( $self->[PATH], $args ); if ( $err && @$err ) { my ( $file, $message ) = %{ $err->[0] }; Carp::croak("mkpath failed for $file: $message"); } return @dirs; } sub move { my ( $self, $dst ) = @_; return rename( $self->[PATH], $dst ) || $self->_throw( 'rename', $self->[PATH] . "' -> '$dst'" ); } # map method names to corresponding open mode my %opens = ( opena => ">>", openr => "<", openw => ">", openrw => "+<" ); while ( my ( $k, $v ) = each %opens ) { no strict 'refs'; # must check for lexical IO mode hint *{$k} = sub { my ( $self, @args ) = @_; my $args = ( @args && ref $args[0] eq 'HASH' ) ? shift @args : {}; $args = _get_args( $args, qw/locked/ ); my ($binmode) = @args; $binmode = ( ( caller(0) )[10] || {} )->{ 'open' . substr( $v, -1, 1 ) } unless defined $binmode; $self->filehandle( $args, $v, $binmode ); }; *{ $k . "_raw" } = sub { my ( $self, @args ) = @_; my $args = ( @args && ref $args[0] eq 'HASH' ) ? shift @args : {}; $args = _get_args( $args, qw/locked/ ); $self->filehandle( $args, $v, ":raw" ); }; *{ $k . "_utf8" } = sub { my ( $self, @args ) = @_; my $args = ( @args && ref $args[0] eq 'HASH' ) ? shift @args : {}; $args = _get_args( $args, qw/locked/ ); $self->filehandle( $args, $v, ":raw:encoding(UTF-8)" ); }; } # XXX this is ugly and coverage is incomplete. I think it's there for windows # so need to check coverage there and compare sub parent { my ( $self, $level ) = @_; $level = 1 unless defined $level && $level > 0; $self->_splitpath unless defined $self->[FILE]; my $parent; if ( length $self->[FILE] ) { if ( $self->[FILE] eq '.' || $self->[FILE] eq ".." ) { $parent = path( $self->[PATH] . "/.." ); } else { $parent = path( _non_empty( $self->[VOL] . $self->[DIR] ) ); } } elsif ( length $self->[DIR] ) { # because of symlinks, any internal updir requires us to # just add more updirs at the end if ( $self->[DIR] =~ m{(?:^\.\./|/\.\./|/\.\.$)} ) { $parent = path( $self->[VOL] . $self->[DIR] . "/.." ); } else { ( my $dir = $self->[DIR] ) =~ s{/[^\/]+/$}{/}; $parent = path( $self->[VOL] . $dir ); } } else { $parent = path( _non_empty( $self->[VOL] ) ); } return $level == 1 ? $parent : $parent->parent( $level - 1 ); } sub _non_empty { my ($string) = shift; return ( ( defined($string) && length($string) ) ? $string : "." ); } sub realpath { my $self = shift; require Cwd; my $realpath = eval { local $SIG{__WARN__} = sub { }; # (sigh) pure-perl CWD can carp Cwd::realpath( $self->[PATH] ); }; $self->_throw("resolving realpath") unless defined $realpath and length $realpath; return path($realpath); } # Easy to get wrong, so wash it through File::Spec (sigh) sub relative { path( File::Spec->abs2rel( $_[0]->[PATH], $_[1] ) ) } sub remove { my $self = shift; return 0 if !-e $self->[PATH] && !-l $self->[PATH]; return unlink $self->[PATH] || $self->_throw('unlink'); } sub remove_tree { my ( $self, $args ) = @_; return 0 if !-e $self->[PATH] && !-l $self->[PATH]; $args = {} unless ref $args eq 'HASH'; my $err; $args->{err} = \$err unless defined $args->{err}; $args->{safe} = 1 unless defined $args->{safe}; require File::Path; my $count = File::Path::remove_tree( $self->[PATH], $args ); if ( $err && @$err ) { my ( $file, $message ) = %{ $err->[0] }; Carp::croak("remove_tree failed for $file: $message"); } return $count; } sub slurp { my $self = shift; my $args = _get_args( shift, qw/binmode/ ); my $binmode = $args->{binmode}; $binmode = ( ( caller(0) )[10] || {} )->{'open<'} unless defined $binmode; my $fh = $self->filehandle( { locked => 1 }, "<", $binmode ); if ( ( defined($binmode) ? $binmode : "" ) eq ":unix" and my $size = -s $fh ) { my $buf; read $fh, $buf, $size; # File::Slurp in a nutshell return $buf; } else { local $/; return scalar <$fh>; } } sub slurp_raw { $_[1] = { binmode => ":unix" }; goto &slurp } sub slurp_utf8 { if ( defined($HAS_UU) ? $HAS_UU : $HAS_UU = _check_UU() ) { return Unicode::UTF8::decode_utf8( slurp( $_[0], { binmode => ":unix" } ) ); } else { $_[1] = { binmode => ":raw:encoding(UTF-8)" }; goto &slurp; } } # XXX add "unsafe" option to disable flocking and atomic? Check benchmarks on append() first. sub spew { my ( $self, @data ) = @_; my $args = ( @data && ref $data[0] eq 'HASH' ) ? shift @data : {}; $args = _get_args( $args, qw/binmode/ ); my $binmode = $args->{binmode}; # get default binmode from caller's lexical scope (see "perldoc open") $binmode = ( ( caller(0) )[10] || {} )->{'open>'} unless defined $binmode; my $temp = path( $self->[PATH] . $$ . int( rand( 2**31 ) ) ); my $fh = $temp->filehandle( { locked => 1 }, ">", $binmode ); print {$fh} map { ref eq 'ARRAY' ? @$_ : $_ } @data; close $fh or $self->_throw( 'close', $temp->[PATH] ); # spewing need to follow the link # and replace the destination instead my $resolved_path = $self->[PATH]; $resolved_path = readlink $resolved_path while -l $resolved_path; return $temp->move($resolved_path); } sub spew_raw { splice @_, 1, 0, { binmode => ":unix" }; goto &spew } sub spew_utf8 { if ( defined($HAS_UU) ? $HAS_UU : $HAS_UU = _check_UU() ) { my $self = shift; spew( $self, { binmode => ":unix" }, map { Unicode::UTF8::encode_utf8($_) } @_ ); } else { splice @_, 1, 0, { binmode => ":unix:encoding(UTF-8)" }; goto &spew; } } # XXX break out individual stat() components as subs? sub stat { my $self = shift; require File::stat; return File::stat::stat( $self->[PATH] ) || $self->_throw('stat'); } sub lstat { my $self = shift; require File::stat; return File::stat::lstat( $self->[PATH] ) || $self->_throw('lstat'); } sub stringify { $_[0]->[PATH] } sub subsumes { my $self = shift; Carp::croak("subsumes() requires a defined, positive-length argument") unless defined $_[0]; my $other = path(shift); # normalize absolute vs relative if ( $self->is_absolute && !$other->is_absolute ) { $other = $other->absolute; } elsif ( $other->is_absolute && !$self->is_absolute ) { $self = $self->absolute; } # normalize volume vs non-volume; do this after absolute path # adjustments above since that might add volumes already if ( length $self->volume && !length $other->volume ) { $other = $other->absolute; } elsif ( length $other->volume && !length $self->volume ) { $self = $self->absolute; } if ( $self->[PATH] eq '.' ) { return !!1; # cwd subsumes everything relative } elsif ( $self->is_rootdir ) { # a root directory ("/", "c:/") already ends with a separator return $other->[PATH] =~ m{^\Q$self->[PATH]\E}; } else { # exact match or prefix breaking at a separator return $other->[PATH] =~ m{^\Q$self->[PATH]\E(?:/|$)}; } } sub touch { my ( $self, $epoch ) = @_; if ( !-e $self->[PATH] ) { my $fh = $self->openw; close $fh or $self->_throw('close'); } $epoch = defined($epoch) ? $epoch : time(); utime $epoch, $epoch, $self->[PATH] or $self->_throw("utime ($epoch)"); return $self; } sub touchpath { my ($self) = @_; my $parent = $self->parent; $parent->mkpath unless $parent->exists; $self->touch; } sub volume { my ($self) = @_; $self->_splitpath unless defined $self->[VOL]; return $self->[VOL]; } package Path::Tiny::Error; our @CARP_NOT = qw/Path::Tiny/; use overload ( q{""} => sub { (shift)->{msg} }, fallback => 1 ); sub throw { my ( $class, $op, $file, $err ) = @_; chomp( my $trace = Carp::shortmess ); my $msg = "Error $op on '$file': $err$trace\n"; die bless { op => $op, file => $file, err => $err, msg => $msg }, $class; } 1; # vim: ts=4 sts=4 sw=4 et: __END__ =pod =encoding UTF-8 =head1 NAME Path::Tiny - File path utility =head1 VERSION version 0.052 =head1 SYNOPSIS use Path::Tiny; # creating Path::Tiny objects $dir = path("/tmp"); $foo = path("foo.txt"); $subdir = $dir->child("foo"); $bar = $subdir->child("bar.txt"); # stringifies as cleaned up path $file = path("./foo.txt"); print $file; # "foo.txt" # reading files $guts = $file->slurp; $guts = $file->slurp_utf8; @lines = $file->lines; @lines = $file->lines_utf8; $head = $file->lines( {count => 1} ); # writing files $bar->spew( @data ); $bar->spew_utf8( @data ); # reading directories for ( $dir->children ) { ... } $iter = $dir->iterator; while ( my $next = $iter->() ) { ... } =head1 DESCRIPTION This module attempts to provide a small, fast utility for working with file paths. It is friendlier to use than L and provides easy access to functions from several other core file handling modules. It doesn't attempt to be as full-featured as L or L, nor does it try to work for anything except Unix-like and Win32 platforms. Even then, it might break if you try something particularly obscure or tortuous. (Quick! What does this mean: C<< ///../../..//./././a//b/.././c/././ >>? And how does it differ on Win32?) All paths are forced to have Unix-style forward slashes. Stringifying the object gives you back the path (after some clean up). File input/output methods C handles before reading or writing, as appropriate (if supported by the platform). The C<*_utf8> methods (C, C, etc.) operate in raw mode without CRLF translation. Installing L 0.58 or later will speed up several of them and is highly recommended. =head1 CONSTRUCTORS =head2 path $path = path("foo/bar"); $path = path("/tmp", "file.txt"); # list $path = path("."); # cwd $path = path("~user/file.txt"); # tilde processing Constructs a C object. It doesn't matter if you give a file or directory path. It's still up to you to call directory-like methods only on directories and file-like methods only on files. This function is exported automatically by default. The first argument must be defined and have non-zero length or an exception will be thrown. This prevents subtle, dangerous errors with code like C<< path( maybe_undef() )->remove_tree >>. If the first component of the path is a tilde ('~') then the component will be replaced with the output of C. If the first component of the path is a tilde followed by a user name then the component will be replaced with output of C. Behaviour for non-existent users depends on the output of C on the system. On Windows, if the path consists of a drive identifier without a path component (C or C), it will be expanded to the absolute path of the current directory on that volume using C. =head2 new $path = Path::Tiny->new("foo/bar"); This is just like C, but with method call overhead. (Why would you do that?) =head2 cwd $path = Path::Tiny->cwd; # path( Cwd::getcwd ) $path = cwd; # optional export Gives you the absolute path to the current directory as a C object. This is slightly faster than C<< path(".")->absolute >>. C may be exported on request and used as a function instead of as a method. =head2 rootdir $path = Path::Tiny->rootdir; # / $path = rootdir; # optional export Gives you C<< File::Spec->rootdir >> as a C object if you're too picky for C. C may be exported on request and used as a function instead of as a method. =head2 tempfile, tempdir $temp = Path::Tiny->tempfile( @options ); $temp = Path::Tiny->tempdir( @options ); $temp = tempfile( @options ); # optional export $temp = tempdir( @options ); # optional export C passes the options to C<< File::Temp->new >> and returns a C object with the file name. The C option is enabled by default. The resulting C object is cached. When the C object is destroyed, the C object will be as well. C annoyingly requires you to specify a custom template in slightly different ways depending on which function or method you call, but C lets you ignore that and can take either a leading template or a C