File-Path-Tiny-1.0/000755 000771 000024 00000000000 14007051213 014320 5ustar00dmueystaff000000 000000 File-Path-Tiny-1.0/Changes000644 000771 000024 00000002601 14007051106 015613 0ustar00dmueystaff000000 000000 Revision history for File-Path-Tiny 1.0 2021-02-04 13:53:54 - rt 125502: fix empty_dir() fast-mode, thanks ishigaki! - f749173 Stop using bareword handle (still ::Tiny since perl is newer) 0.9 2017-12-29 16:17:42 - Do chdir() for security reasons by default - Stop emptying/removing a path if it is changed out from underneath us - rt 96843: Add SEE ALSO section - prereq and unit test fixups - Unit tests for symlink toggling protection 0.8 2016-01-26 14:44:57 - rt 88849: allow multiple processes to operate on the same paths (thanks HELENA!) - Add github to POD - rt 96842: Fix mk() to work correctly w/ UNC paths on windows (thanks MITHUN!) 0.7 2013-09-26 18:46:19 - add =encoding to POD due to test failure on certain boxes - add several perl, pkg, and pod tests 0.6 2013-09-24 05:51:54 add mk_parent() 0.5 2012-09-06 07:38:06 rt 79472 (thanks Lachlan!) fix absolute path bug introduced in 0.4 0.4 2012-09-03 17:50:41 rt 79345 (thanks Gian!): Failed to recursively create dir if the first part solves to false 0.3 2013-04-06 19:39:52 rt 76061 No LICENSE in META.yml rt 68950 break out rm() code into empty() type function, use it in rm() 0.2 2012-03-11 16:50:44 rt 51728 Missing colon in synopsis rt 75688 using deprecated for qw() in 00.load.t perltidy 0.1 2008 -11-17 20:09:59 Initial release. File-Path-Tiny-1.0/MANIFEST000644 000771 000024 00000000567 13221540434 015466 0ustar00dmueystaff000000 000000 Changes MANIFEST Makefile.PL README lib/File/Path/Tiny.pm lib/File/Path/Tiny.pod t/00.load.t t/01.symtogsafe.t t/perlcritic.t t/perltidy.t t/pkg-changes.t t/pkg-readme.t t/pod-coverage.t t/pod-spelling.t t/pod.t META.yml Module meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) File-Path-Tiny-1.0/t/000755 000771 000024 00000000000 14007051213 014563 5ustar00dmueystaff000000 000000 File-Path-Tiny-1.0/README000644 000771 000024 00000000720 14007051135 015202 0ustar00dmueystaff000000 000000 File-Path-Tiny version 1.0 DOCUMENTATION See POD for documentation. INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install DEPENDENCIES See DEPENDENCIES section in POD, 'requires' key in Build.PL, or 'PREREQ_PM' key in Makefile.PL COPYRIGHT AND LICENCE Copyright (C) 2008, Daniel Muey This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. File-Path-Tiny-1.0/META.yml000644 000771 000024 00000001166 14007051213 015575 0ustar00dmueystaff000000 000000 --- abstract: 'recursive versions of mkdir() and rmdir() without as much overhead as File::Path' author: - 'Daniel Muey ' build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150001' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: File-Path-Tiny no_index: directory: - t - inc requires: Carp: '0' Cwd: '0' File::Temp: '0' Test::Exception: '0' Test::More: '0' version: '1.0' File-Path-Tiny-1.0/lib/000755 000771 000024 00000000000 14007051213 015066 5ustar00dmueystaff000000 000000 File-Path-Tiny-1.0/Makefile.PL000644 000771 000024 00000001257 13221540434 016304 0ustar00dmueystaff000000 000000 use strict; use warnings; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'File::Path::Tiny', AUTHOR => 'Daniel Muey ', VERSION_FROM => 'lib/File/Path/Tiny.pm', ABSTRACT_FROM => 'lib/File/Path/Tiny.pod', PL_FILES => {}, LICENSE => 'perl', PREREQ_PM => { 'Test::More' => 0, # for unit tests 'File::Temp' => 0, # for unit tests 'Test::Exception' => 0, # for unit tests 'Cwd' => 0, 'Carp' => 0, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'File-Path-Tiny-*' }, ); File-Path-Tiny-1.0/META.json000644 000771 000024 00000002050 14007051213 015736 0ustar00dmueystaff000000 000000 { "abstract" : "recursive versions of mkdir() and rmdir() without as much overhead as File::Path", "author" : [ "Daniel Muey " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150001", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "File-Path-Tiny", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Carp" : "0", "Cwd" : "0", "File::Temp" : "0", "Test::Exception" : "0", "Test::More" : "0" } } }, "release_status" : "stable", "version" : "1.0" } File-Path-Tiny-1.0/lib/File/000755 000771 000024 00000000000 14007051213 015745 5ustar00dmueystaff000000 000000 File-Path-Tiny-1.0/lib/File/Path/000755 000771 000024 00000000000 14007051213 016641 5ustar00dmueystaff000000 000000 File-Path-Tiny-1.0/lib/File/Path/Tiny.pm000644 000771 000024 00000007020 14007051050 020120 0ustar00dmueystaff000000 000000 package File::Path::Tiny; use strict; use warnings; use Cwd qw(cwd chdir); use Carp (); $File::Path::Tiny::VERSION = "1.0"; sub mk { my ( $path, $mask ) = @_; return 2 if -d $path; if ( -e $path ) { $! = 20; return; } $mask ||= '0777'; # Perl::Critic == Integer with leading zeros at ... $mask = oct($mask) if substr( $mask, 0, 1 ) eq '0'; require File::Spec; my ( $vol, $directories ) = File::Spec->splitpath( $path, 1 ); my @dirs = File::Spec->splitdir($directories); my @list; while ( my ($_dir) = shift @dirs ) { last if not defined $_dir; push @list, $_dir; next if ( $_dir eq '' ); my $progressive = File::Spec->catpath( $vol, File::Spec->catdir(@list), '' ); if ( !-d $progressive ) { mkdir( $progressive, $mask ) or -d $progressive or return; } } return 1 if -d $path; return; } sub rm { my ( $path, $fast ) = @_; my ( $orig_dev, $orig_ino ) = ( lstat $path )[ 0, 1 ]; if ( -e _ && !-d _ ) { $! = 20; return; } return 2 if !-d _; empty_dir( $path, $fast ) or return; _bail_if_changed( $path, $orig_dev, $orig_ino ); rmdir($path) or !-e $path or return; return 1; } sub empty_dir { my ( $path, $fast ) = @_; my ( $orig_dev, $orig_ino ) = ( lstat $path )[ 0, 1 ]; if ( -e _ && !-d _ ) { $! = 20; return; } my ( $starting_point, $starting_dev, $starting_ino ); if ( !$fast ) { $starting_point = cwd(); ( $starting_dev, $starting_ino ) = ( lstat $starting_point )[ 0, 1 ]; chdir($path) or Carp::croak("Failed to change directory to “$path”: $!"); $path = '.'; _bail_if_changed( $path, $orig_dev, $orig_ino ); } opendir( my $dh, $path ) or return; my @contents = grep { $_ ne '.' && $_ ne '..' } readdir($dh); closedir $dh; _bail_if_changed( $path, $orig_dev, $orig_ino ); require File::Spec if @contents; for my $thing (@contents) { my $long = File::Spec->catdir( $path, $thing ); if ( !-l $long && -d _ ) { _bail_if_changed( $path, $orig_dev, $orig_ino ); rm( $long, $fast ) or !-e $long or return; } else { _bail_if_changed( $path, $orig_dev, $orig_ino ); unlink $long or !-e $long or return; } } _bail_if_changed( $path, $orig_dev, $orig_ino ); if ( !$fast ) { chdir($starting_point) or Carp::croak("Failed to change directory to “$starting_point”: $!"); _bail_if_changed( ".", $starting_dev, $starting_ino ); } return 1; } sub mk_parent { my ( $path, $mode ) = @_; $path =~ s{/+$}{}; require File::Spec; my ( $v, $d, $f ) = File::Spec->splitpath( $path, 1 ); my @p = File::Spec->splitdir($d); # pop() is probably cheaper here, benchmark? $d = File::Spec->catdir(@p[0--$#p-1]); pop @p; $d = File::Spec->catdir(@p); my $parent = File::Spec->catpath( $v, $d, $f ); return mk( $parent, $mode ); } sub _bail_if_changed { my ( $path, $orig_dev, $orig_ino ) = @_; my ( $cur_dev, $cur_ino ) = ( lstat $path )[ 0, 1 ]; if ( !defined $cur_dev || !defined $cur_ino ) { $cur_dev ||= "undef(path went away?)"; $cur_ino ||= "undef(path went away?)"; } else { $path = Cwd::abs_path($path); } if ( $orig_dev ne $cur_dev || $orig_ino ne $cur_ino ) { local $Carp::CarpLevel += 1; Carp::croak("directory $path changed: expected dev=$orig_dev ino=$orig_ino, actual dev=$cur_dev ino=$cur_ino, aborting"); } } 1; File-Path-Tiny-1.0/lib/File/Path/Tiny.pod000644 000771 000024 00000021542 14007051072 020277 0ustar00dmueystaff000000 000000 =encoding utf8 =head1 NAME File::Path::Tiny - recursive versions of mkdir() and rmdir() without as much overhead as File::Path =head1 VERSION This document describes File::Path::Tiny version 1.0 =head1 SYNOPSIS use File::Path::Tiny; if(!File::Path::Tiny::mk($path)) { die "Could not make path '$path': $!"; } if(!File::Path::Tiny::rm($path)) { die "Could not remove path '$path': $!"; } =head1 DESCRIPTION The goal here is simply to provide recursive versions of L() and L() with as little code and overhead as possible. This module is in no way meant to derogate L and is in no way an endorsement to go out and replace all use of L with L. L is very good at what it does but there's simply a lot happening that we can do without much of the time. Here are some things L has/does that this module attempts to do without: =over 4 =item * multiple interfaces Backwards compatibility brings in a lot of code and logic that we don't need from here on out. =item * chdir()s It forces a ton of chdir()s which could leave you somewhere you're not planning on being and requires much more overhead to do. This module provides a way to disable that if you know it is safe to do so in your circumstance. =item * can croak not allowing you to detect and handle failure Just let me handle errors how I want. Don't make my entire app die or have to wrap it in an eval The exception here is the security checks can croak, which is what you want. See L for more info. =item * A well intentioned output system Just let me do the output how I want. (Nothing, As HTML, print to a filehandle, etc...) =item * A well intentioned and experimental (IE subject to change) error handling system. Just keep it simple and detect failure via a boolean check and do what I want with the error. See L =item * According to its POD, removing a tree is apparently not safe unless you tell it to be with the ‘safe’ or 'keep_root' attributes. Seems like that should just happen, I don't want to worry about accidentally removing / when I pass it /tmp =back =head1 INTERFACE Nothing in exported or exportable, that helps keep it '::Tiny'. =head2 File::Path::Tiny::mk() Takes a single path (like L()) to recursively create and, optionally, a mask (like L()) for all subsequent L() calls. Mask defaults to 0700 (also like L()) Returns false if it could not be made, true otherwise (returns ‘2’ if it is -d already) It is recursive in the sense that given “foo/bar/baz” as the path to create all 3 will be created if necessary. =head2 File::Path::Tiny::rm() Takes a single path (like L()) to recursively empty and remove. Returns false if it could not be emptied or removed, true otherwise (returns ‘2’ if it is !-d already). Also see L. It is recursive in the sense that given “/foo/bar/baz” as the path to remove it will recursively empty ‘baz’ and then remove it from /foo/bar. Its parents, /, /foo, and /foo/bar are *not* touched. By default it does chdir() for security reasons. If you are sure it is safe to do without that for the sake of a bit of speed you can pass a second true argument to skip that. =head2 File::Path::Tiny::empty_dir() Takes a single path to recursively empty but not remove. Returns false when there is a problem. Also see L. By default it does chdir() for security reasons. If you are sure it is safe to do without that for the sake of a bit of speed you can pass a second true argument to skip that. =head2 File::Path::Tiny::mk_parent() Like mk() but recursively creates the parent. e.g. given “foo/bar/baz.txt” creates foo/bar. =head2 From Cwd It uses these internally so, for convenience, these are exposed in case you want to use them also. =head3 File::Path::Tiny::cwd() Comes directly from L. =head3 File::Path::Tiny::chdir() Comes directly from L. =head1 DIAGNOSTICS If the functions ever return false, $! will have been set either explicitly or by the L(), L(), L(), or L() that ultimately returned false. =over 4 =item C<< directory %s changed: expected dev=%d ino=$d, actual dev=%d ino=%d, aborting >> empty_dir() and rm() throw this if any of the directories being operated on change during the operation. =back =head1 MISC =head2 How can I make/remove multiple paths? For simplicity sake && ::Tiny status this module must be very very very simple. That said it is also very simple to do multiple paths: for my $path (@paths) { File::Path::Tiny::::mk($path) or _my_handle_failed_mk($path, $!); } for my $path (@paths) { File::Path::Tiny::::rm($path) or _my_handle_failed_rm($path, $!); } That also lets you keep going or short circuit it or handle errors however you like: PATH: for my $path qw(foo/bar bar/rat) { if (!File::Path::Tiny::mk($path)) { print "problem unlinking '$path': $!\n"; last PATH; } else { print "No error encountered with '$path'\n" } } =head2 About the '::Tiny' status See L for information on the ::Tiny suffix. #3 is almost there (< 1/5th +/-), a bit more trimming and I think we'll have it! #8 is N/A since part of the "sub set" is to do single paths like their non-recursive core counterparts and there are so many ways to invoke it with different consequences [ -- RSS Memory -- ] Baseline perl 1168 File::Path 1808 (+640) File::Path::Tiny 1288 (+120) Even though "time" isn't really a ::Tiny factor, it does improve loading a bit: [ -- time -- ] Baseline perl real 0m0.007s user 0m0.002s sys 0m0.004s File::Path real 0m0.017s user 0m0.011s sys 0m0.005s File::Path::Tiny real 0m0.007s user 0m0.003s sys 0m0.004s As time allows and more tests are added I'll try to include more comprehensive benchmark results. =head2 How do I make sure the path is safe to create or remove? Of course the answer depends on what you mean by "safe". This module makes no assumptions on interpreting the "safeness" of a path, just like L() and L(). Also like L() and L() typically you'll find that filesystem permissions are a pretty reliable tool (of course if the code will be run as root you would want to setuid first...) You might use Cwd::abs_path() to sanitize a path before sending it to be made or removed. Even after that it might not be "safe" so you'll need to discern what your particular definition of "safe" is and take appropriate action. =head1 DEPENDENCIES L of course but its only loaded if needed =head1 SEE ALSO We already talked about L in the L. L also offers a mkpath interface but it too has/does things that this module attempts to do without per the L. Plus its ::Tiny name is a misnomer, see L for details. =head1 INCOMPATIBILITIES None reported. =head1 BUGS AND FEATURES Please report any bugs or feature requests (and a pull request for bonus points) through the issue tracker at L. =head1 AUTHOR Daniel Muey C<< >> =head1 LICENCE AND COPYRIGHT Copyright (c) 2008, Daniel Muey C<< >>. All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L. =head1 DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. File-Path-Tiny-1.0/t/pod.t000644 000771 000024 00000000356 13221537533 015551 0ustar00dmueystaff000000 000000 #!perl use Test::More; plan skip_all => 'POD tests are only run in RELEASE_TESTING mode.' unless $ENV{'RELEASE_TESTING'}; eval 'use Test::Pod 1.14'; plan skip_all => 'Test::Pod v1.14 required for testing POD' if $@; all_pod_files_ok(); File-Path-Tiny-1.0/t/pkg-changes.t000644 000771 000024 00000000455 13221537532 017155 0ustar00dmueystaff000000 000000 #!perl use Test::More; plan skip_all => 'pkg/Changes tests are only run in RELEASE_TESTING mode.' unless $ENV{'RELEASE_TESTING'}; eval 'use Test::CPAN::Changes 0.23'; plan skip_all => 'Test::CPAN::Changes 0.23 required for testing the pkg/Changes file' if $@; changes_ok(); # this does the plan File-Path-Tiny-1.0/t/pod-spelling.t000644 000771 000024 00000000577 13221537533 017371 0ustar00dmueystaff000000 000000 #!perl use Test::More; plan skip_all => 'POD tests are only run in RELEASE_TESTING mode.' unless $ENV{'RELEASE_TESTING'}; eval 'use Test::Spelling 0.19'; plan skip_all => 'Test::Spelling v0.19 required for testing POD' if $@; add_stopwords( map { split /[\s\:\-]/ } readline(*DATA) ); $ENV{LANG} = 'C'; all_pod_files_spelling_ok(); __DATA__ MERCHANTABILITY Muey LICENCE app baz File-Path-Tiny-1.0/t/perlcritic.t000644 000771 000024 00000000424 13221537532 017122 0ustar00dmueystaff000000 000000 #!perl use Test::More; plan skip_all => 'Critic tests are only run in RELEASE_TESTING mode.' unless $ENV{'RELEASE_TESTING'}; eval 'use Test::Perl::Critic'; plan skip_all => 'Test::Perl::Critic required for testing PBP compliance' if $@; Test::Perl::Critic::all_critic_ok(); File-Path-Tiny-1.0/t/01.symtogsafe.t000644 000771 000024 00000010250 13221540434 017353 0ustar00dmueystaff000000 000000 use strict; use warnings; use Test::More; use Test::Exception; use File::Path::Tiny; if ( !-x "/bin/mv" || !-x "/bin/mkdir" ) { # dragons! patches welcome plan skip_all => 'Only operate on systems w/ /bin/mv and /bin/mkdir, for reasons see the cource code comments'; } else { plan tests => 22; } use File::Temp; use Cwd; use File::Spec; my $orig_dir = Cwd::cwd(); my $dir = File::Temp->newdir(); our $catdir_toggle = sub { }; our @catdir_calls; chdir $dir || die "Could not chdir into temp directory: $!\n"; # so we can pathrm(), dragons! { ############################################################################## #### Wrap catdir() to control a symlink toggle in the path traversal loops. ## ############################################################################## no strict "refs"; no warnings "redefine", "once"; my $real_catdir = \&{ $File::Spec::ISA[0] . "::catdir" }; local *File::Spec::catdir = sub { my ( $self, @args ) = @_; push @catdir_calls, \@args; $catdir_toggle->(@args); goto &$real_catdir; }; mkdir "empty_dir"; mkdir "empty_dir/sanity"; File::Path::Tiny::empty_dir("empty_dir"); is( @catdir_calls, 1, "sanity check: catdir was actually called in the empty_dir() loop" ); mkdir "rm"; mkdir "rm/sanity"; File::Path::Tiny::rm("rm"); is( @catdir_calls, 2, "sanity check: catdir was actually called in the pathrmdir() loop" ); #################### #### Actual tests ## #################### for my $func (qw(empty_dir rm)) { _test( $func, "cwd/foo/bar/baz", "bails when high level changes" ); _test( $func, "cwd/foo/bar", "bails when mid level changes" ); _test( $func, "cwd/foo", "bails when low level changes" ); _test( $func, "cwd", "bails when CWD level changes" ); _test( $func, "", "bails when below level changes" ); } # TODO: cover readdir, chdir, and post loop failures } chdir $orig_dir || die "Could not chdir back to original directory: $!\n"; ############### #### helpers ## ############### sub _test { my ( $func, $toggle, $label ) = @_; _setup_tree($func); { local @catdir_calls = (); local $catdir_toggle = sub { chdir $dir || die "could not toggle dir/symlink (chdir): $!"; my $parent = ""; if ($toggle) { $parent = $toggle; $parent =~ s{[^/]+$}{}; # use system call since the perl to do this will likely use File::Spec system("/bin/mkdir -p moved/$func/$parent") and die "could not toggle dir/symlink (mkdir): $?\n"; } # use system call since the perl to do this will likely use File::Spec system("/bin/mv $dir/$func/$toggle $dir/moved/$func/$toggle") and die "could not toggle dir/symlink (mv): $?\n"; symlink( "$dir/victim", "$dir/$func" . ( $toggle ? "/$toggle" : "" ) ) or die "could not toggle dir/symlink (sym): $!\n"; chdir "$func/cwd" || die "could not toggle dir/symlink (back into $func/cwd): $!\n"; }; throws_ok { no strict "refs"; "File::Path::Tiny::$func"->("foo/bar/baz") } qr/directory .* changed: expected dev=.* ino=.*, actual dev=.* ino=.*, aborting/, "$func() detected symlink toggle: $label"; is( @catdir_calls, 1, "sanity check: catdir was actually called in $func() ($label)" ); } _teardown_tree($func); } sub _teardown_tree { my ($base) = @_; chdir $dir || die "Could not chdir back into temp dir: $!\n"; File::Path::Tiny::rm($base); File::Path::Tiny::rm("moved/"); File::Path::Tiny::rm("victim/"); return; } sub _setup_tree { my ($base) = @_; for my $dir ( "moved", "victim", "victim/cwd", $base, "$base/cwd", "$base/cwd/foo", "$base/cwd/foo/bar", "$base/cwd/foo/bar/baz" ) { mkdir $dir || die "Could not make test tree ($dir): $!\n"; open my $fh, ">", "$dir/file.txt" || die "Could not make test file in ($dir): $!\n"; print {$fh} "oh hai\n"; close($fh); } chdir "$base/cwd" || die "Could not chdir into $base/cwd: $!\n"; return; } File-Path-Tiny-1.0/t/pkg-readme.t000644 000771 000024 00000000460 13221537533 016777 0ustar00dmueystaff000000 000000 #!perl use Test::More; plan skip_all => 'pkg/README tests are only run in RELEASE_TESTING mode.' unless $ENV{'RELEASE_TESTING'}; eval 'use Test::CPAN::README'; plan skip_all => 'Test::CPAN::README required for testing the pkg/README file' if $@; readme_ok('File::Path::Tiny'); # this does the plan File-Path-Tiny-1.0/t/pod-coverage.t000644 000771 000024 00000000416 13221537533 017337 0ustar00dmueystaff000000 000000 #!perl use Test::More; plan skip_all => 'POD tests are only run in RELEASE_TESTING mode.' unless $ENV{'RELEASE_TESTING'}; eval 'use Test::Pod::Coverage 1.04'; plan skip_all => 'Test::Pod::Coverage v1.04 required for testing POD coverage' if $@; all_pod_coverage_ok(); File-Path-Tiny-1.0/t/perltidy.t000644 000771 000024 00000000405 13221537532 016615 0ustar00dmueystaff000000 000000 #!perl use Test::More; plan skip_all => 'PerlTidy tests are only run in RELEASE_TESTING mode.' unless $ENV{'RELEASE_TESTING'}; eval 'use Test::PerlTidy'; plan skip_all => 'Test::PerlTidy required for testing PerlTidy-ness' if $@; Test::PerlTidy::run_tests(); File-Path-Tiny-1.0/t/00.load.t000644 000771 000024 00000011441 13221537532 016120 0ustar00dmueystaff000000 000000 use strict; use warnings; use Test::More tests => 30; use File::Temp; use Cwd; BEGIN { use_ok('File::Path::Tiny'); } diag("Testing File::Path::Tiny $File::Path::Tiny::VERSION"); note "Relative paths"; { my $dir = File::Temp->newdir; my $starting_dir = cwd(); chdir $dir || die "Could not change into temp dir: $!"; ok( File::Path::Tiny::mk("foo/bar"), "make simple path - return true" ); ok( -d "foo/bar", "make simple path - path recursively created" ); ok( File::Path::Tiny::mk("foo") == 2, "make already existing dir" ); if ( open my $fh, '>', "foo/bar/file" ) { print {$fh} "test"; close $fh; } else { die "test file not created: $!"; } ok( !File::Path::Tiny::mk("foo/bar/file"), "make already existing non dir - return false" ); ok( $! == 20, "make already existing file - errno" ); my $file = "zib/dib/kib"; ok( File::Path::Tiny::mk_parent($file), "mk_parent() simple path returns true" ); ok( -d "zib/dib", "mk_parent() simple path - parent recursively created" ); ok( !-e $file, "mk_parent() simple path - file not created" ); ok( File::Path::Tiny::mk_parent($file) == 2, "mk_parent() already existing simple path dir" ); chdir $starting_dir || die "Could not go back into $starting_dir: $!\n"; } note "Absolute paths"; { my $dir = File::Temp->newdir(); my $new = "$dir/foo/bar/baz"; ok( File::Path::Tiny::mk($new), "make absolute path - return true" ); ok( -d $new, "make absolute path - path recursively created" ); ok( File::Path::Tiny::mk($new) == 2, "make already existing absolute path dir" ); my $file = "$dir/zib/dib/kib"; ok( File::Path::Tiny::mk_parent($file), "mk_parent() absolute path returns true" ); ok( -d "$dir/zib/dib", "mk_parent() absolute path - parent recursively created" ); ok( !-e $file, "mk_parent() absolute path - file not created" ); ok( File::Path::Tiny::mk_parent($file) == 2, "mk_parent() already existing absolute path dir" ); } note "Modes and misc"; { my $dir = File::Temp->newdir; my $starting_dir = cwd(); chdir $dir || die "Could not change into temp dir: $!"; File::Path::Tiny::mk('foo/bar/dir'); my $mk_mode = ( stat('foo/bar') )[2]; # $mk_mode = sprintf('%04o', $mk_mode & 07777); my $mkdir_mode = ( stat('foo/bar/dir') )[2]; # $mkdir_mode = sprintf('%04o', $mkdir_mode & 07777); # diag("mk: $mk_mode, mkdir: $mkdir_mode"); ok( $mk_mode == $mkdir_mode, 'MASK logic gets same results as mkdir()' ); File::Path::Tiny::mk( "foo/bar/mode", 0700 ); File::Path::Tiny::mk_parent( "parent_mode/x", 0700 ); mkdir 'foo/bar/mode_mkdir', 0700; ok( ( stat('foo/bar/mode') )[2] == ( stat('foo/bar/mode_mkdir') )[2], 'MASK arg OCT gets same results as mkdir()' ); ok( ( stat('parent_mode') )[2] == ( stat('foo/bar/mode_mkdir') )[2], 'MASK arg OCT gets same results as mkdir() - mk_parent()' ); File::Path::Tiny::mk( "foo/bar/mode2", oct('0700') ); File::Path::Tiny::mk_parent( "parent_oct/x", oct('0700') ); mkdir 'foo/bar/mode_mkdir2', oct('0700'); ok( ( stat('foo/bar/mode2') )[2] == ( stat('foo/bar/mode_mkdir2') )[2], 'MASK arg oct(STR) gets same results as mkdir()' ); ok( ( stat('parent_oct') )[2] == ( stat('foo/bar/mode_mkdir2') )[2], 'MASK arg oct(STR) gets same results as mkdir() - mk_parent()' ); File::Path::Tiny::mk( "foo/bar/mode3", "0700" ); File::Path::Tiny::mk_parent( "parent_str/x", "0700" ); # mkdir 'foo/bar/mode_mkdir3', "0700"; # this breaks permissions so we compare with previous one ok( ( stat('foo/bar/mode3') )[2] == ( stat('foo/bar/mode2') )[2], 'MASK arg STR gets detected and handled - different results as mkdir()' ); ok( ( stat('parent_str') )[2] == ( stat('foo/bar/mode2') )[2], 'MASK arg STR gets detected and handled - different results as mkdir() - mk_parent()' ); if ( open my $fh, '>', "foo/bar/file" ) { print {$fh} "test"; close $fh; } else { die "test file not created: $!"; } ok( !File::Path::Tiny::rm("foo/bar/file"), "remove existing non dir - return false" ); ok( $! == 20, "remove existing non dir - errno" ); undef $!; ok( File::Path::Tiny::rm('foo/bar'), "empty and remove simple path - return true" ); ok( !-d 'foo/bar', "remove simple path - path recursively removed" ); ok( File::Path::Tiny::rm('foo/bar') == 2, "remove already non-existing dir" ); ok( File::Path::Tiny::rm('foo'), 'remove empty dir' ); chdir $starting_dir || die "Could not go back into $starting_dir: $!\n"; }