← Index
NYTProf Performance Profile   « line view »
For /Users/timbo/perl5/perlbrew/perls/perl-5.18.2/bin/perlcritic
  Run on Sat Mar 19 22:12:22 2016
Reported on Sat Mar 19 22:14:12 2016

Filename/Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/site_perl/5.18.2/Path/Tiny.pm
StatementsExecuted 13018 statements in 31.7ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
476746.23ms7.84msPath::Tiny::::path Path::Tiny::path
1112.59ms6.00msPath::Tiny::::lines Path::Tiny::lines
1695311.97ms1.97msPath::Tiny::::CORE:subst Path::Tiny::CORE:subst (opcode)
113321.26ms3.92msPath::Tiny::::realpath Path::Tiny::realpath
9691791.22ms1.22msPath::Tiny::::__ANON__[:31] Path::Tiny::__ANON__[:31]
330311.20ms2.67msPath::Tiny::::basename Path::Tiny::basename
72321772µs772µsPath::Tiny::::_is_root Path::Tiny::_is_root
12331696µs1.67msPath::Tiny::::_splitpath Path::Tiny::_splitpath
13822524µs3.13msPath::Tiny::::child Path::Tiny::child
911469µs2.61msPath::Tiny::::children Path::Tiny::children
111469µs649µsPath::Tiny::::CORE:readline Path::Tiny::CORE:readline (opcode)
111440µs729µsPath::Tiny::::BEGIN@238 Path::Tiny::BEGIN@238
9111331µs331µsPath::Tiny::::CORE:ftis Path::Tiny::CORE:ftis (opcode)
9111304µs635µsPath::Tiny::::exists Path::Tiny::exists
1111221µs221µsPath::Tiny::::is_rootdir Path::Tiny::is_rootdir
911197µs197µsPath::Tiny::::CORE:readdir Path::Tiny::CORE:readdir (opcode)
2132184µs574µsPath::Tiny::::parent Path::Tiny::parent
911148µs148µsPath::Tiny::::CORE:open_dir Path::Tiny::CORE:open_dir (opcode)
47621146µs146µsPath::Tiny::::CORE:match Path::Tiny::CORE:match (opcode)
11192µs938µsPath::Tiny::::CORE:open Path::Tiny::CORE:open (opcode)
121161µs243µsPath::Tiny::::dirname Path::Tiny::dirname
22151µs51µsPath::Tiny::::CORE:regcomp Path::Tiny::CORE:regcomp (opcode)
121148µs291µsPath::Tiny::::is_absolute Path::Tiny::is_absolute
122248µs339µsPath::Tiny::::absolute Path::Tiny::absolute
211137µs37µsPath::Tiny::::_non_empty Path::Tiny::_non_empty
11137µs37µsPath::Tiny::::_check_UU Path::Tiny::_check_UU
91134µs34µsPath::Tiny::::CORE:closedir Path::Tiny::CORE:closedir (opcode)
11134µs986µsPath::Tiny::::filehandle Path::Tiny::filehandle
11122µs6.07msPath::Tiny::::lines_utf8 Path::Tiny::lines_utf8
33122µs22µsPath::Tiny::::_get_args Path::Tiny::_get_args
11119µs171µsPath::Tiny::::BEGIN@19 Path::Tiny::BEGIN@19
11116µs16µsFile::ShareDir::ProjectDistDir::::BEGIN@1.14File::ShareDir::ProjectDistDir::BEGIN@1.14
11116µs24µsflock::::BEGIN@109 flock::BEGIN@109
11113µs29µsPath::Tiny::::BEGIN@12 Path::Tiny::BEGIN@12
11110µs35µsPath::Tiny::Error::::BEGIN@1604 Path::Tiny::Error::BEGIN@1604
11110µs51µsPath::Tiny::::BEGIN@30 Path::Tiny::BEGIN@30
11110µs10µsPath::Tiny::::CORE:flock Path::Tiny::CORE:flock (opcode)
11110µs22µsPath::Tiny::::BEGIN@1120 Path::Tiny::BEGIN@1120
1119µs26µsPath::Tiny::::BEGIN@11 Path::Tiny::BEGIN@11
1119µs18µsPath::Tiny::::BEGIN@39 Path::Tiny::BEGIN@39
1119µs16µsPath::Tiny::::BEGIN@13 Path::Tiny::BEGIN@13
1118µs12µsFile::ShareDir::ProjectDistDir::::BEGIN@3.16File::ShareDir::ProjectDistDir::BEGIN@3.16
1117µs19µsFile::ShareDir::ProjectDistDir::::BEGIN@2.15File::ShareDir::ProjectDistDir::BEGIN@2.15
11117µs7µsPath::Tiny::::__ANON__ Path::Tiny::__ANON__ (xsub)
5515µs5µsPath::Tiny::::CORE:qr Path::Tiny::CORE:qr (opcode)
1113µs3µsPath::Tiny::::BEGIN@14 Path::Tiny::BEGIN@14
0000s0sPath::Tiny::Error::::__ANON__[:1604] Path::Tiny::Error::__ANON__[:1604]
0000s0sPath::Tiny::Error::::throw Path::Tiny::Error::throw
0000s0sPath::Tiny::::FREEZE Path::Tiny::FREEZE
0000s0sPath::Tiny::::THAW Path::Tiny::THAW
0000s0sPath::Tiny::::__ANON__[:1130] Path::Tiny::__ANON__[:1130]
0000s0sPath::Tiny::::__ANON__[:1136] Path::Tiny::__ANON__[:1136]
0000s0sPath::Tiny::::__ANON__[:1142] Path::Tiny::__ANON__[:1142]
0000s0sPath::Tiny::::__ANON__[:1220] Path::Tiny::__ANON__[:1220]
0000s0sPath::Tiny::::__ANON__[:941] Path::Tiny::__ANON__[:941]
0000s0sPath::Tiny::::_parse_file_temp_args Path::Tiny::_parse_file_temp_args
0000s0sPath::Tiny::::_symbolic_chmod Path::Tiny::_symbolic_chmod
0000s0sPath::Tiny::::_throw Path::Tiny::_throw
0000s0sPath::Tiny::::_win32_vol Path::Tiny::_win32_vol
0000s0sPath::Tiny::::append Path::Tiny::append
0000s0sPath::Tiny::::append_raw Path::Tiny::append_raw
0000s0sPath::Tiny::::append_utf8 Path::Tiny::append_utf8
0000s0sPath::Tiny::::canonpath Path::Tiny::canonpath
0000s0sPath::Tiny::::chmod Path::Tiny::chmod
0000s0sPath::Tiny::::copy Path::Tiny::copy
0000s0sPath::Tiny::::cwd Path::Tiny::cwd
0000s0sPath::Tiny::::digest Path::Tiny::digest
0000s0sPath::Tiny::::is_dir Path::Tiny::is_dir
0000s0sPath::Tiny::::is_file Path::Tiny::is_file
0000s0sPath::Tiny::::is_relative Path::Tiny::is_relative
0000s0sPath::Tiny::::iterator Path::Tiny::iterator
0000s0sPath::Tiny::::lines_raw Path::Tiny::lines_raw
0000s0sPath::Tiny::::lstat Path::Tiny::lstat
0000s0sPath::Tiny::::mkpath Path::Tiny::mkpath
0000s0sPath::Tiny::::move Path::Tiny::move
0000s0sPath::Tiny::::new Path::Tiny::new
0000s0sPath::Tiny::::relative Path::Tiny::relative
0000s0sPath::Tiny::::remove Path::Tiny::remove
0000s0sPath::Tiny::::remove_tree Path::Tiny::remove_tree
0000s0sPath::Tiny::::rootdir Path::Tiny::rootdir
0000s0sPath::Tiny::::sibling Path::Tiny::sibling
0000s0sPath::Tiny::::slurp Path::Tiny::slurp
0000s0sPath::Tiny::::slurp_raw Path::Tiny::slurp_raw
0000s0sPath::Tiny::::slurp_utf8 Path::Tiny::slurp_utf8
0000s0sPath::Tiny::::spew Path::Tiny::spew
0000s0sPath::Tiny::::spew_raw Path::Tiny::spew_raw
0000s0sPath::Tiny::::spew_utf8 Path::Tiny::spew_utf8
0000s0sPath::Tiny::::stat Path::Tiny::stat
0000s0sPath::Tiny::::stringify Path::Tiny::stringify
0000s0sPath::Tiny::::subsumes Path::Tiny::subsumes
0000s0sPath::Tiny::::tempdir Path::Tiny::tempdir
0000s0sPath::Tiny::::tempfile Path::Tiny::tempfile
0000s0sPath::Tiny::::touch Path::Tiny::touch
0000s0sPath::Tiny::::touchpath Path::Tiny::touchpath
0000s0sPath::Tiny::::volume Path::Tiny::volume
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1240µs116µs
# spent 16µs within File::ShareDir::ProjectDistDir::BEGIN@1.14 which was called: # once (16µs+0s) by File::ShareDir::ProjectDistDir::_path at line 1
use 5.008001;
# spent 16µs making 1 call to File::ShareDir::ProjectDistDir::BEGIN@1.14
2220µs231µs
# spent 19µs (7+12) within File::ShareDir::ProjectDistDir::BEGIN@2.15 which was called: # once (7µs+12µs) by File::ShareDir::ProjectDistDir::_path at line 2
use strict;
# spent 19µs making 1 call to File::ShareDir::ProjectDistDir::BEGIN@2.15 # spent 12µs making 1 call to strict::import
3235µs215µs
# spent 12µs (8+4) within File::ShareDir::ProjectDistDir::BEGIN@3.16 which was called: # once (8µs+4µs) by File::ShareDir::ProjectDistDir::_path at line 3
use warnings;
# spent 12µs making 1 call to File::ShareDir::ProjectDistDir::BEGIN@3.16 # spent 4µs making 1 call to warnings::import
4
5package Path::Tiny;
6# ABSTRACT: File path utility
7
81600nsour $VERSION = '0.061';
9
10# Dependencies
11229µs243µs
# spent 26µs (9+17) within Path::Tiny::BEGIN@11 which was called: # once (9µs+17µs) by File::ShareDir::ProjectDistDir::_path at line 11
use Config;
# spent 26µs making 1 call to Path::Tiny::BEGIN@11 # spent 17µs making 1 call to Config::import
12336µs345µs
# spent 29µs (13+16) within Path::Tiny::BEGIN@12 which was called: # once (13µs+16µs) by File::ShareDir::ProjectDistDir::_path at line 12
use Exporter 5.57 (qw/import/);
# spent 29µs making 1 call to Path::Tiny::BEGIN@12 # spent 8µs making 1 call to Exporter::import # spent 8µs making 1 call to UNIVERSAL::VERSION
13330µs223µs
# spent 16µs (9+7) within Path::Tiny::BEGIN@13 which was called: # once (9µs+7µs) by File::ShareDir::ProjectDistDir::_path at line 13
use File::Spec 3.40 ();
# spent 16µs making 1 call to Path::Tiny::BEGIN@13 # spent 7µs making 1 call to UNIVERSAL::VERSION
14269µs13µs
# spent 3µs within Path::Tiny::BEGIN@14 which was called: # once (3µs+0s) by File::ShareDir::ProjectDistDir::_path at line 14
use Carp ();
# spent 3µs making 1 call to Path::Tiny::BEGIN@14
15
161800nsour @EXPORT = qw/path/;
171700nsour @EXPORT_OK = qw/cwd rootdir tempfile tempdir/;
18
19
# spent 171µs (19+152) within Path::Tiny::BEGIN@19 which was called: # once (19µs+152µs) by File::ShareDir::ProjectDistDir::_path at line 28
use constant {
201300ns PATH => 0,
21 CANON => 1,
22 VOL => 2,
23 DIR => 3,
24 FILE => 4,
25 TEMP => 5,
26 IS_BSD => ( scalar $^O =~ /bsd$/ ),
27 IS_WIN32 => ( $^O eq 'MSWin32' ),
28179µs3324µs};
# spent 171µs making 1 call to Path::Tiny::BEGIN@19 # spent 151µs making 1 call to constant::import # spent 1µs making 1 call to Path::Tiny::CORE:match
29
30
# spent 51µs (10+41) within Path::Tiny::BEGIN@30 which was called: # once (10µs+41µs) by File::ShareDir::ProjectDistDir::_path at line 34
use overload (
319692.15ms
# spent 1.22ms within Path::Tiny::__ANON__[/Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/site_perl/5.18.2/Path/Tiny.pm:31] which was called 969 times, avg 1µs/call: # 182 times (200µs+0s) by Path::IsDev::Role::Matcher::FullPath::Is::Any::_fullpath_is at line 65 of Path/IsDev/Role/Matcher/FullPath/Is/Any.pm, avg 1µs/call # 178 times (206µs+0s) by Path::IsDev::Role::Matcher::FullPath::Is::Any::_fullpath_is at line 67 of Path/IsDev/Role/Matcher/FullPath/Is/Any.pm, avg 1µs/call # 137 times (198µs+0s) by Path::IsDev::Role::Matcher::Child::Exists::Any::child_exists at line 38 of Path/IsDev/Role/Matcher/Child/Exists/Any.pm, avg 1µs/call # 137 times (159µs+0s) by Path::IsDev::Role::Matcher::Child::Exists::Any::CORE:ftis at line 41 of Path/IsDev/Role/Matcher/Child/Exists/Any.pm, avg 1µs/call # 110 times (152µs+0s) by Path::IsDev::Role::Matcher::Child::BaseName::MatchRegexp::_this_child_matchregexp at line 35 of Path/IsDev/Role/Matcher/Child/BaseName/MatchRegexp.pm, avg 1µs/call # 91 times (137µs+0s) by Path::IsDev::Role::Matcher::FullPath::Is::Any::_fullpath_is at line 62 of Path/IsDev/Role/Matcher/FullPath/Is/Any.pm, avg 2µs/call # 91 times (109µs+0s) by Path::IsDev::Role::Matcher::FullPath::Is::Any::_fullpath_is at line 63 of Path/IsDev/Role/Matcher/FullPath/Is/Any.pm, avg 1µs/call # 11 times (14µs+0s) by Path::IsDev::Object::__ANON__[/Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/site_perl/5.18.2/Path/IsDev/Object.pm:201] at line 199 of Path/IsDev/Object.pm, avg 1µs/call # 11 times (14µs+0s) by Path::IsDev::Result::CORE:ftis at line 73 of Path/IsDev/Result.pm, avg 1µs/call # 10 times (14µs+0s) by Path::FindDev::Object::find_dev at line 237 of Path/FindDev/Object.pm, avg 1µs/call # 4 times (4µs+0s) by Path::IsDev::Role::Matcher::FullPath::Is::Any::_fullpath_is at line 71 of Path/IsDev/Role/Matcher/FullPath/Is/Any.pm, avg 1µs/call # 2 times (3µs+0s) by Path::IsDev::Role::HeuristicSet::matches at line 69 of Path/IsDev/Role/HeuristicSet.pm, avg 1µs/call # once (2µs+0s) by Path::Tiny::path at line 202 # once (2µs+0s) by Path::FindDev::Object::find_dev at line 230 of Path/FindDev/Object.pm # once (1µs+0s) by File::ShareDir::ProjectDistDir::CORE:ftdir at line 669 of File/ShareDir/ProjectDistDir.pm # once (1µs+0s) by File::ShareDir::ProjectDistDir::CORE:ftis at line 668 of File/ShareDir/ProjectDistDir.pm # once (1µs+0s) by File::ShareDir::ProjectDistDir::CORE:fteread at line 672 of File/ShareDir/ProjectDistDir.pm
q{""} => sub { $_[0]->[PATH] },
32 bool => sub () { 1 },
331600ns fallback => 1,
34157µs292µs);
# spent 51µs making 1 call to Path::Tiny::BEGIN@30 # spent 41µs making 1 call to overload::import
35
36# FREEZE/THAW per Sereal/CBOR/Types::Serialiser protocol
37sub FREEZE { return $_[0]->[PATH] }
38sub THAW { return path( $_[2] ) }
394472µs227µs
# spent 18µs (9+9) within Path::Tiny::BEGIN@39 which was called: # once (9µs+9µs) by File::ShareDir::ProjectDistDir::_path at line 39
{ no warnings 'once'; *TO_JSON = *FREEZE };
# spent 18µs making 1 call to Path::Tiny::BEGIN@39 # spent 9µs making 1 call to warnings::unimport
40
411100nsmy $HAS_UU; # has Unicode::UTF8; lazily populated
42
43
# spent 37µs within Path::Tiny::_check_UU which was called: # once (37µs+0s) by Path::Tiny::lines_utf8 at line 1019
sub _check_UU {
44239µs !!eval { require Unicode::UTF8; Unicode::UTF8->VERSION(0.58); 1 };
45}
46
4717µs11.71msmy $HAS_FLOCK = $Config{d_flock} || $Config{d_fcntl_can_lock} || $Config{d_lockf};
# spent 1.71ms making 1 call to Config::FETCH
48
49# notions of "root" directories differ on Win32: \\server\dir\ or C:\ or \
5016µs11µsmy $SLASH = qr{[\\/]};
# spent 1µs making 1 call to Path::Tiny::CORE:qr
5113µs1800nsmy $NOTSLASH = qr{[^\\/]};
# spent 800ns making 1 call to Path::Tiny::CORE:qr
5213µs1700nsmy $DRV_VOL = qr{[a-z]:}i;
# spent 700ns making 1 call to Path::Tiny::CORE:qr
53123µs216µsmy $UNC_VOL = qr{$SLASH $SLASH $NOTSLASH+ $SLASH $NOTSLASH+}x;
# spent 16µs making 1 call to Path::Tiny::CORE:regcomp # spent 900ns making 1 call to Path::Tiny::CORE:qr
54142µs236µsmy $WIN32_ROOT = qr{(?: $UNC_VOL $SLASH | $DRV_VOL $SLASH | $SLASH )}x;
# spent 35µs making 1 call to Path::Tiny::CORE:regcomp # spent 900ns making 1 call to Path::Tiny::CORE:qr
55
56sub _win32_vol {
57 my ( $path, $drv ) = @_;
58 require Cwd;
59 my $dcwd = eval { Cwd::getdcwd($drv) }; # C: -> C:\some\cwd
60 # getdcwd on non-existent drive returns empty string
61 # so just use the original drive Z: -> Z:
62 $dcwd = "$drv" unless defined $dcwd && length $dcwd;
63 # normalize dwcd to end with a slash: might be C:\some\cwd or D:\ or Z:
64 $dcwd =~ s{$SLASH?$}{/};
65 # make the path absolute with dcwd
66 $path =~ s{^$DRV_VOL}{$dcwd};
67 return $path;
68}
69
70# This is a string test for before we have the object; see is_rootdir for well-formed
71# object test
72
# spent 772µs within Path::Tiny::_is_root which was called 723 times, avg 1µs/call: # 475 times (520µs+0s) by Path::Tiny::path at line 229, avg 1µs/call # 248 times (252µs+0s) by Path::Tiny::path at line 219, avg 1µs/call
sub _is_root {
737231.34ms return IS_WIN32() ? ( $_[0] =~ /^$WIN32_ROOT$/ ) : ( $_[0] eq '/' );
74}
75
76# mode bits encoded for chmod in symbolic mode
7712µsmy %MODEBITS = ( om => 0007, gm => 0070, um => 0700 ); ## no critic
7836µs{ my $m = 0; $MODEBITS{$_} = ( 1 << $m++ ) for qw/ox ow or gx gw gr ux uw ur/ };
79
80sub _symbolic_chmod {
81 my ( $mode, $symbolic ) = @_;
82 for my $clause ( split /,\s*/, $symbolic ) {
83 if ( $clause =~ m{\A([augo]+)([=+-])([rwx]+)\z} ) {
84 my ( $who, $action, $perms ) = ( $1, $2, $3 );
85 $who =~ s/a/ugo/g;
86 for my $w ( split //, $who ) {
87 my $p = 0;
88 $p |= $MODEBITS{"$w$_"} for split //, $perms;
89 if ( $action eq '=' ) {
90 $mode = ( $mode & ~$MODEBITS{"${w}m"} ) | $p;
91 }
92 else {
93 $mode = $action eq "+" ? ( $mode | $p ) : ( $mode & ~$p );
94 }
95 }
96 }
97 else {
98 Carp::croak("Invalid mode clause '$clause' for chmod()");
99 }
100 }
101 return $mode;
102}
103
104# flock doesn't work on NFS on BSD. Since program authors often can't control
105# or detect that, we warn once instead of being fatal if we can detect it and
106# people who need it strict can fatalize the 'flock' category
107
108#<<< No perltidy
1093472µs228µs
# spent 24µs (16+8) within flock::BEGIN@109 which was called: # once (16µs+8µs) by File::ShareDir::ProjectDistDir::_path at line 109
{ package flock; use if Path::Tiny::IS_BSD(), 'warnings::register' }
# spent 24µs making 1 call to flock::BEGIN@109 # spent 4µs making 1 call to if::import
110#>>>
111
1121100nsmy $WARNED_BSD_NFS = 0;
113
114sub _throw {
115 my ( $self, $function, $file ) = @_;
116 if ( IS_BSD()
117 && $function =~ /^flock/
118 && $! =~ /operation not supported/i
119 && !warnings::fatal_enabled('flock') )
120 {
121 if ( !$WARNED_BSD_NFS ) {
122 warnings::warn( flock => "No flock for NFS on BSD: continuing in unsafe mode" );
123 $WARNED_BSD_NFS++;
124 }
125 }
126 else {
127 Path::Tiny::Error->throw( $function, ( defined $file ? $file : $self->[PATH] ), $! );
128 }
129 return;
130}
131
132# cheapo option validation
133
# spent 22µs within Path::Tiny::_get_args which was called 3 times, avg 7µs/call: # once (10µs+0s) by Path::Tiny::lines_utf8 at line 1018 # once (7µs+0s) by Path::Tiny::lines at line 981 # once (4µs+0s) by Path::Tiny::filehandle at line 758
sub _get_args {
13432µs my ( $raw, @valid ) = @_;
13531µs if ( defined($raw) && ref($raw) ne 'HASH' ) {
136 my ( undef, undef, undef, $called_as ) = caller(1);
137 $called_as =~ s{^.*::}{};
138 Carp::croak("Options for $called_as must be a hash reference");
139 }
14031µs my $cooked = {};
14131µs for my $k (@valid) {
14277µs $cooked->{$k} = delete $raw->{$k} if exists $raw->{$k};
143 }
14432µs if ( keys %$raw ) {
145 my ( undef, undef, undef, $called_as ) = caller(1);
146 $called_as =~ s{^.*::}{};
147 Carp::croak( "Invalid option(s) for $called_as: " . join( ", ", keys %$raw ) );
148 }
149311µs return $cooked;
150}
151
152#--------------------------------------------------------------------------#
153# Constructors
154#--------------------------------------------------------------------------#
155
156#pod =construct path
157#pod
158#pod $path = path("foo/bar");
159#pod $path = path("/tmp", "file.txt"); # list
160#pod $path = path("."); # cwd
161#pod $path = path("~user/file.txt"); # tilde processing
162#pod
163#pod Constructs a C<Path::Tiny> object. It doesn't matter if you give a file or
164#pod directory path. It's still up to you to call directory-like methods only on
165#pod directories and file-like methods only on files. This function is exported
166#pod automatically by default.
167#pod
168#pod The first argument must be defined and have non-zero length or an exception
169#pod will be thrown. This prevents subtle, dangerous errors with code like
170#pod C<< path( maybe_undef() )->remove_tree >>.
171#pod
172#pod If the first component of the path is a tilde ('~') then the component will be
173#pod replaced with the output of C<glob('~')>. If the first component of the path
174#pod is a tilde followed by a user name then the component will be replaced with
175#pod output of C<glob('~username')>. Behaviour for non-existent users depends on
176#pod the output of C<glob> on the system.
177#pod
178#pod On Windows, if the path consists of a drive identifier without a path component
179#pod (C<C:> or C<D:>), it will be expanded to the absolute path of the current
180#pod directory on that volume using C<Cwd::getdcwd()>.
181#pod
182#pod If called with a single C<Path::Tiny> argument, the original is returned unless
183#pod the original is holding a temporary file or directory reference in which case a
184#pod stringified copy is made.
185#pod
186#pod $path = path("foo/bar");
187#pod $temp = Path::Tiny->tempfile;
188#pod
189#pod $p2 = path($path); # like $p2 = $path
190#pod $t2 = path($temp); # like $t2 = path( "$temp" )
191#pod
192#pod This optimizes copies without proliferating references unexpectedly if a copy is
193#pod made by code outside your control.
194#pod
195#pod Current API available since 0.017.
196#pod
197#pod =cut
198
199
# spent 7.84ms (6.23+1.62) within Path::Tiny::path which was called 476 times, avg 16µs/call: # 138 times (2.06ms+547µs) by Path::Tiny::child at line 547, avg 19µs/call # 113 times (1.37ms+346µs) by Path::Tiny::realpath at line 1224, avg 15µs/call # 110 times (1.40ms+366µs) by Path::Tiny::children at line 586, avg 16µs/call # 91 times (1.09ms+281µs) by Path::IsDev::Role::Matcher::FullPath::Is::Any::_fullpath_is at line 15 of Path/IsDev/Role/Matcher/FullPath/Is/Any.pm, avg 15µs/call # 21 times (266µs+67µs) by Path::Tiny::parent at line 1173, avg 16µs/call # 2 times (37µs+9µs) by File::ShareDir::ProjectDistDir::__ANON__[/Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/site_perl/5.18.2/File/ShareDir/ProjectDistDir.pm:676] or File::ShareDir::ProjectDistDir::_get_cached_dist_dir_result at line 269 of File/ShareDir/ProjectDistDir.pm, avg 23µs/call # once (8µs+2µs) by Path::FindDev::Object::find_dev at line 229 of Path/FindDev/Object.pm
sub path {
200476120µs my $path = shift;
201 Carp::croak("Path::Tiny paths require defined, positive-length parts")
202476418µs12µs unless 1 + @_ == grep { defined && length } $path, @_;
# spent 2µs making 1 call to Path::Tiny::__ANON__[Path/Tiny.pm:31]
203
204 # non-temp Path::Tiny objects are effectively immutable and can be reused
20547683µs if ( !@_ && ref($path) eq __PACKAGE__ && !$path->[TEMP] ) {
206 return $path;
207 }
208
209 # stringify objects
21047549µs $path = "$path";
211
212 # expand relative volume paths on windows; put trailing slash on UNC root
213 if ( IS_WIN32() ) {
214 $path = _win32_vol( $path, $1 ) if $path =~ m{^($DRV_VOL)(?:$NOTSLASH|$)};
215 $path .= "/" if $path =~ m{^$UNC_VOL$};
216 }
217
218 # concatenations stringifies objects, too
219475402µs248252µs if (@_) {
# spent 252µs making 248 calls to Path::Tiny::_is_root, avg 1µs/call
220 $path .= ( _is_root($path) ? "" : "/" ) . join( "/", @_ );
221 }
222
223 # canonicalize, but with unix slashes and put back trailing volume slash
2244751.66ms475499µs my $cpath = $path = File::Spec->canonpath($path);
# spent 499µs making 475 calls to File::Spec::Unix::canonpath, avg 1µs/call
225 $path =~ tr[\\][/] if IS_WIN32();
226475200ns $path .= "/" if IS_WIN32() && $path =~ m{^$UNC_VOL$};
227
228 # root paths must always have a trailing slash, but other paths must not
229475538µs475520µs if ( _is_root($path) ) {
# spent 520µs making 475 calls to Path::Tiny::_is_root, avg 1µs/call
230418µs48µs $path =~ s{/?$}{/};
# spent 8µs making 4 calls to Path::Tiny::CORE:subst, avg 2µs/call
231 }
232 else {
233471848µs471191µs $path =~ s{/$}{};
# spent 191µs making 471 calls to Path::Tiny::CORE:subst, avg 406ns/call
234 }
235
236 # do any tilde expansions
237475730µs475145µs if ( $path =~ m{^(~[^/]*).*} ) {
# spent 145µs making 475 calls to Path::Tiny::CORE:match, avg 305ns/call
23822.57ms1729µs
# spent 729µs (440+289) within Path::Tiny::BEGIN@238 which was called: # once (440µs+289µs) by File::ShareDir::ProjectDistDir::_path at line 238
my ($homedir) = glob($1); # glob without list context == heisenbug!
# spent 729µs making 1 call to Path::Tiny::BEGIN@238
239 $path =~ s{^(~[^/]*)}{$homedir};
240 }
241
2424751.46ms bless [ $path, $cpath ], __PACKAGE__;
243}
244
245#pod =construct new
246#pod
247#pod $path = Path::Tiny->new("foo/bar");
248#pod
249#pod This is just like C<path>, but with method call overhead. (Why would you
250#pod do that?)
251#pod
252#pod Current API available since 0.001.
253#pod
254#pod =cut
255
256sub new { shift; path(@_) }
257
258#pod =construct cwd
259#pod
260#pod $path = Path::Tiny->cwd; # path( Cwd::getcwd )
261#pod $path = cwd; # optional export
262#pod
263#pod Gives you the absolute path to the current directory as a C<Path::Tiny> object.
264#pod This is slightly faster than C<< path(".")->absolute >>.
265#pod
266#pod C<cwd> may be exported on request and used as a function instead of as a
267#pod method.
268#pod
269#pod Current API available since 0.018.
270#pod
271#pod =cut
272
273sub cwd {
274 require Cwd;
275 return path( Cwd::getcwd() );
276}
277
278#pod =construct rootdir
279#pod
280#pod $path = Path::Tiny->rootdir; # /
281#pod $path = rootdir; # optional export
282#pod
283#pod Gives you C<< File::Spec->rootdir >> as a C<Path::Tiny> object if you're too
284#pod picky for C<path("/")>.
285#pod
286#pod C<rootdir> may be exported on request and used as a function instead of as a
287#pod method.
288#pod
289#pod Current API available since 0.018.
290#pod
291#pod =cut
292
293sub rootdir { path( File::Spec->rootdir ) }
294
295#pod =construct tempfile, tempdir
296#pod
297#pod $temp = Path::Tiny->tempfile( @options );
298#pod $temp = Path::Tiny->tempdir( @options );
299#pod $temp = tempfile( @options ); # optional export
300#pod $temp = tempdir( @options ); # optional export
301#pod
302#pod C<tempfile> passes the options to C<< File::Temp->new >> and returns a C<Path::Tiny>
303#pod object with the file name. The C<TMPDIR> option is enabled by default.
304#pod
305#pod The resulting C<File::Temp> object is cached. When the C<Path::Tiny> object is
306#pod destroyed, the C<File::Temp> object will be as well.
307#pod
308#pod C<File::Temp> annoyingly requires you to specify a custom template in slightly
309#pod different ways depending on which function or method you call, but
310#pod C<Path::Tiny> lets you ignore that and can take either a leading template or a
311#pod C<TEMPLATE> option and does the right thing.
312#pod
313#pod $temp = Path::Tiny->tempfile( "customXXXXXXXX" ); # ok
314#pod $temp = Path::Tiny->tempfile( TEMPLATE => "customXXXXXXXX" ); # ok
315#pod
316#pod The tempfile path object will normalized to have an absolute path, even if
317#pod created in a relative directory using C<DIR>.
318#pod
319#pod C<tempdir> is just like C<tempfile>, except it calls
320#pod C<< File::Temp->newdir >> instead.
321#pod
322#pod Both C<tempfile> and C<tempdir> may be exported on request and used as
323#pod functions instead of as methods.
324#pod
325#pod Current API available since 0.018.
326#pod
327#pod =cut
328
329sub tempfile {
330 shift if @_ && $_[0] eq 'Path::Tiny'; # called as method
331 my ( $maybe_template, $args ) = _parse_file_temp_args(@_);
332 # File::Temp->new demands TEMPLATE
333 $args->{TEMPLATE} = $maybe_template->[0] if @$maybe_template;
334
335 require File::Temp;
336 my $temp = File::Temp->new( TMPDIR => 1, %$args );
337 close $temp;
338 my $self = path($temp)->absolute;
339 $self->[TEMP] = $temp; # keep object alive while we are
340 return $self;
341}
342
343sub tempdir {
344 shift if @_ && $_[0] eq 'Path::Tiny'; # called as method
345 my ( $maybe_template, $args ) = _parse_file_temp_args(@_);
346
347 # File::Temp->newdir demands leading template
348 require File::Temp;
349 my $temp = File::Temp->newdir( @$maybe_template, TMPDIR => 1, %$args );
350 my $self = path($temp)->absolute;
351 $self->[TEMP] = $temp; # keep object alive while we are
352 return $self;
353}
354
355# normalize the various ways File::Temp does templates
356sub _parse_file_temp_args {
357 my $leading_template = ( scalar(@_) % 2 == 1 ? shift(@_) : '' );
358 my %args = @_;
359 %args = map { uc($_), $args{$_} } keys %args;
360 my @template = (
361 exists $args{TEMPLATE} ? delete $args{TEMPLATE}
362 : $leading_template ? $leading_template
363 : ()
364 );
365 return ( \@template, \%args );
366}
367
368#--------------------------------------------------------------------------#
369# Private methods
370#--------------------------------------------------------------------------#
371
372
# spent 1.67ms (696µs+973µs) within Path::Tiny::_splitpath which was called 123 times, avg 14µs/call: # 110 times (611µs+856µs) by Path::Tiny::basename at line 509, avg 13µs/call # 12 times (77µs+104µs) by Path::Tiny::dirname at line 702, avg 15µs/call # once (7µs+12µs) by Path::Tiny::parent at line 1166
sub _splitpath {
37312325µs my ($self) = @_;
374123648µs123973µs @{$self}[ VOL, DIR, FILE ] = File::Spec->splitpath( $self->[PATH] );
# spent 973µs making 123 calls to File::Spec::Unix::splitpath, avg 8µs/call
375}
376
377#--------------------------------------------------------------------------#
378# Public methods
379#--------------------------------------------------------------------------#
380
381#pod =method absolute
382#pod
383#pod $abs = path("foo/bar")->absolute;
384#pod $abs = path("foo/bar")->absolute("/tmp");
385#pod
386#pod Returns a new C<Path::Tiny> object with an absolute path (or itself if already
387#pod absolute). Unless an argument is given, the current directory is used as the
388#pod absolute base path. The argument must be absolute or you won't get an absolute
389#pod result.
390#pod
391#pod This will not resolve upward directories ("foo/../bar") unless C<canonpath>
392#pod in L<File::Spec> would normally do so on your platform. If you need them
393#pod resolved, you must call the more expensive C<realpath> method instead.
394#pod
395#pod On Windows, an absolute path without a volume component will have it added
396#pod based on the current drive.
397#pod
398#pod Current API available since 0.001.
399#pod
400#pod =cut
401
402
# spent 339µs (48+291) within Path::Tiny::absolute which was called 12 times, avg 28µs/call: # 11 times (43µs+265µs) by Path::IsDev::Result::BUILD at line 76 of Path/IsDev/Result.pm, avg 28µs/call # once (5µs+26µs) by Path::FindDev::Object::find_dev at line 229 of Path/FindDev/Object.pm
sub absolute {
403124µs my ( $self, $base ) = @_;
404
405 # absolute paths handled differently by OS
406121µs if (IS_WIN32) {
407 return $self if length $self->volume;
408 # add missing volume
409 if ( $self->is_absolute ) {
410 require Cwd;
411 # use Win32::GetCwd not Cwd::getdcwd because we're sure
412 # to have the former but not necessarily the latter
413 my ($drv) = Win32::GetCwd() =~ /^($DRV_VOL | $UNC_VOL)/x;
414 return path( $drv . $self->[PATH] );
415 }
416 }
417 else {
4181238µs12291µs return $self if $self->is_absolute;
# spent 291µs making 12 calls to Path::Tiny::is_absolute, avg 24µs/call
419 }
420
421 # relative path on any OS
422 require Cwd;
423 return path( ( defined($base) ? $base : Cwd::getcwd() ), $_[0]->[PATH] );
424}
425
426#pod =method append, append_raw, append_utf8
427#pod
428#pod path("foo.txt")->append(@data);
429#pod path("foo.txt")->append(\@data);
430#pod path("foo.txt")->append({binmode => ":raw"}, @data);
431#pod path("foo.txt")->append_raw(@data);
432#pod path("foo.txt")->append_utf8(@data);
433#pod
434#pod Appends data to a file. The file is locked with C<flock> prior to writing. An
435#pod optional hash reference may be used to pass options. Valid options are:
436#pod
437#pod =for :list
438#pod * C<binmode>: passed to C<binmode()> on the handle used for writing.
439#pod * C<truncate>: truncates the file after locking and before appending
440#pod
441#pod The C<truncate> option is a way to replace the contents of a file
442#pod B<in place>, unlike L</spew> which writes to a temporary file and then
443#pod replaces the original (if it exists).
444#pod
445#pod C<append_raw> is like C<append> with a C<binmode> of C<:unix> for fast,
446#pod unbuffered, raw write.
447#pod
448#pod C<append_utf8> is like C<append> with a C<binmode> of
449#pod C<:unix:encoding(UTF-8)>. If L<Unicode::UTF8> 0.58+ is installed, a raw
450#pod append will be done instead on the data encoded with C<Unicode::UTF8>.
451#pod
452#pod Current API available since 0.060.
453#pod
454#pod =cut
455
456sub append {
457 my ( $self, @data ) = @_;
458 my $args = ( @data && ref $data[0] eq 'HASH' ) ? shift @data : {};
459 $args = _get_args( $args, qw/binmode truncate/ );
460 my $binmode = $args->{binmode};
461 $binmode = ( ( caller(0) )[10] || {} )->{'open>'} unless defined $binmode;
462 my $mode = $args->{truncate} ? ">" : ">>";
463 my $fh = $self->filehandle( { locked => 1 }, $mode, $binmode );
464 print {$fh} map { ref eq 'ARRAY' ? @$_ : $_ } @data;
465 close $fh or $self->_throw('close');
466}
467
468sub append_raw {
469 my ( $self, @data ) = @_;
470 my $args = ( @data && ref $data[0] eq 'HASH' ) ? shift @data : {};
471 $args = _get_args( $args, qw/binmode truncate/ );
472 $args->{binmode} = ':unix';
473 append( $self, $args, @data );
474}
475
476sub append_utf8 {
477 my ( $self, @data ) = @_;
478 my $args = ( @data && ref $data[0] eq 'HASH' ) ? shift @data : {};
479 $args = _get_args( $args, qw/binmode truncate/ );
480 if ( defined($HAS_UU) ? $HAS_UU : ( $HAS_UU = _check_UU() ) ) {
481 $args->{binmode} = ":unix";
482 append( $self, $args, map { Unicode::UTF8::encode_utf8($_) } @data );
483 }
484 else {
485 $args->{binmode} = ":unix:encoding(UTF-8)";
486 append( $self, $args, @data );
487 }
488}
489
490#pod =method basename
491#pod
492#pod $name = path("foo/bar.txt")->basename; # bar.txt
493#pod $name = path("foo.txt")->basename('.txt'); # foo
494#pod $name = path("foo.txt")->basename(qr/.txt/); # foo
495#pod $name = path("foo.txt")->basename(@suffixes);
496#pod
497#pod Returns the file portion or last directory portion of a path.
498#pod
499#pod Given a list of suffixes as strings or regular expressions, any that match at
500#pod the end of the file portion or last directory portion will be removed before
501#pod the result is returned.
502#pod
503#pod Current API available since 0.054.
504#pod
505#pod =cut
506
507
# spent 2.67ms (1.20+1.47) within Path::Tiny::basename which was called 330 times, avg 8µs/call: # 110 times (617µs+1.47ms) by Path::IsDev::Role::Matcher::Child::BaseName::MatchRegexp::_this_child_matchregexp at line 35 of Path/IsDev/Role/Matcher/Child/BaseName/MatchRegexp.pm, avg 19µs/call # 110 times (298µs+0s) by Path::IsDev::Role::Matcher::Child::BaseName::MatchRegexp::_this_child_matchregexp at line 49 of Path/IsDev/Role/Matcher/Child/BaseName/MatchRegexp.pm, avg 3µs/call # 110 times (288µs+0s) by Path::IsDev::Role::Matcher::Child::BaseName::MatchRegexp::_this_child_matchregexp at line 43 of Path/IsDev/Role/Matcher/Child/BaseName/MatchRegexp.pm, avg 3µs/call
sub basename {
50833086µs my ( $self, @suffixes ) = @_;
509330233µs1101.47ms $self->_splitpath unless defined $self->[FILE];
# spent 1.47ms making 110 calls to Path::Tiny::_splitpath, avg 13µs/call
51033098µs my $file = $self->[FILE];
511330121µs for my $s (@suffixes) {
512 my $re = ref($s) eq 'Regexp' ? qr/$s$/ : qr/\Q$s\E$/;
513 last if $file =~ s/$re//;
514 }
515330708µs return $file;
516}
517
518#pod =method canonpath
519#pod
520#pod $canonical = path("foo/bar")->canonpath; # foo\bar on Windows
521#pod
522#pod Returns a string with the canonical format of the path name for
523#pod the platform. In particular, this means directory separators
524#pod will be C<\> on Windows.
525#pod
526#pod Current API available since 0.001.
527#pod
528#pod =cut
529
530sub canonpath { $_[0]->[CANON] }
531
532#pod =method child
533#pod
534#pod $file = path("/tmp")->child("foo.txt"); # "/tmp/foo.txt"
535#pod $file = path("/tmp")->child(@parts);
536#pod
537#pod Returns a new C<Path::Tiny> object relative to the original. Works
538#pod like C<catfile> or C<catdir> from File::Spec, but without caring about
539#pod file or directories.
540#pod
541#pod Current API available since 0.001.
542#pod
543#pod =cut
544
545
# spent 3.13ms (524µs+2.61) within Path::Tiny::child which was called 138 times, avg 23µs/call: # 137 times (520µs+2.59ms) by Path::IsDev::Role::Matcher::Child::Exists::Any::child_exists at line 36 of Path/IsDev/Role/Matcher/Child/Exists/Any.pm, avg 23µs/call # once (4µs+18µs) by File::ShareDir::ProjectDistDir::__ANON__[/Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/site_perl/5.18.2/File/ShareDir/ProjectDistDir.pm:676] at line 667 of File/ShareDir/ProjectDistDir.pm
sub child {
54613877µs my ( $self, @parts ) = @_;
547138407µs1382.61ms return path( $self->[PATH], @parts );
# spent 2.61ms making 138 calls to Path::Tiny::path, avg 19µs/call
548}
549
550#pod =method children
551#pod
552#pod @paths = path("/tmp")->children;
553#pod @paths = path("/tmp")->children( qr/\.txt$/ );
554#pod
555#pod Returns a list of C<Path::Tiny> objects for all files and directories
556#pod within a directory. Excludes "." and ".." automatically.
557#pod
558#pod If an optional C<qr//> argument is provided, it only returns objects for child
559#pod names that match the given regular expression. Only the base name is used
560#pod for matching:
561#pod
562#pod @paths = path("/tmp")->children( qr/^foo/ );
563#pod # matches children like the glob foo*
564#pod
565#pod Current API available since 0.028.
566#pod
567#pod =cut
568
569
# spent 2.61ms (469µs+2.14) within Path::Tiny::children which was called 9 times, avg 290µs/call: # 9 times (469µs+2.14ms) by Path::IsDev::Role::Matcher::Child::BaseName::MatchRegexp::File::child_basename_matchregexp_file at line 70 of Path/IsDev/Role/Matcher/Child/BaseName/MatchRegexp/File.pm, avg 290µs/call
sub children {
57092µs my ( $self, $filter ) = @_;
5719900ns my $dh;
5729189µs9148µs opendir $dh, $self->[PATH] or $self->_throw('opendir');
# spent 148µs making 9 calls to Path::Tiny::CORE:open_dir, avg 16µs/call
5739240µs9197µs my @children = readdir $dh;
# spent 197µs making 9 calls to Path::Tiny::CORE:readdir, avg 22µs/call
574956µs934µs closedir $dh or $self->_throw('closedir');
# spent 34µs making 9 calls to Path::Tiny::CORE:closedir, avg 4µs/call
575
576962µs if ( not defined $filter ) {
577 @children = grep { $_ ne '.' && $_ ne '..' } @children;
578 }
579 elsif ( $filter && ref($filter) eq 'Regexp' ) {
580 @children = grep { $_ ne '.' && $_ ne '..' && $_ =~ $filter } @children;
581 }
582 else {
583 Carp::croak("Invalid argument '$filter' for children()");
584 }
585
586119206µs1101.76ms return map { path( $self->[PATH], $_ ) } @children;
# spent 1.76ms making 110 calls to Path::Tiny::path, avg 16µs/call
587}
588
589#pod =method chmod
590#pod
591#pod path("foo.txt")->chmod(0777);
592#pod path("foo.txt")->chmod("0755");
593#pod path("foo.txt")->chmod("go-w");
594#pod path("foo.txt")->chmod("a=r,u+wx");
595#pod
596#pod Sets file or directory permissions. The argument can be a numeric mode, a
597#pod octal string beginning with a "0" or a limited subset of the symbolic mode use
598#pod by F</bin/chmod>.
599#pod
600#pod The symbolic mode must be a comma-delimited list of mode clauses. Clauses must
601#pod match C<< qr/\A([augo]+)([=+-])([rwx]+)\z/ >>, which defines "who", "op" and
602#pod "perms" parameters for each clause. Unlike F</bin/chmod>, all three parameters
603#pod are required for each clause, multiple ops are not allowed and permissions
604#pod C<stugoX> are not supported. (See L<File::chmod> for more complex needs.)
605#pod
606#pod Current API available since 0.053.
607#pod
608#pod =cut
609
610sub chmod {
611 my ( $self, $new_mode ) = @_;
612
613 my $mode;
614 if ( $new_mode =~ /\d/ ) {
615 $mode = ( $new_mode =~ /^0/ ? oct($new_mode) : $new_mode );
616 }
617 elsif ( $new_mode =~ /[=+-]/ ) {
618 $mode = _symbolic_chmod( $self->stat->mode & 07777, $new_mode ); ## no critic
619 }
620 else {
621 Carp::croak("Invalid mode argument '$new_mode' for chmod()");
622 }
623
624 CORE::chmod( $mode, $self->[PATH] ) or $self->_throw("chmod");
625
626 return 1;
627}
628
629#pod =method copy
630#pod
631#pod path("/tmp/foo.txt")->copy("/tmp/bar.txt");
632#pod
633#pod Copies a file using L<File::Copy>'s C<copy> function.
634#pod
635#pod Current API available since 0.001.
636#pod
637#pod =cut
638
639# XXX do recursively for directories?
640sub copy {
641 my ( $self, $dest ) = @_;
642 require File::Copy;
643 File::Copy::copy( $self->[PATH], $dest )
644 or Carp::croak("copy failed for $self to $dest: $!");
645}
646
647#pod =method digest
648#pod
649#pod $obj = path("/tmp/foo.txt")->digest; # SHA-256
650#pod $obj = path("/tmp/foo.txt")->digest("MD5"); # user-selected
651#pod $obj = path("/tmp/foo.txt")->digest( { chunk_size => 1e6 }, "MD5" );
652#pod
653#pod Returns a hexadecimal digest for a file. An optional hash reference of options may
654#pod be given. The only option is C<chunk_size>. If C<chunk_size> is given, that many
655#pod bytes will be read at a time. If not provided, the entire file will be slurped
656#pod into memory to compute the digest.
657#pod
658#pod Any subsequent arguments are passed to the constructor for L<Digest> to select
659#pod an algorithm. If no arguments are given, the default is SHA-256.
660#pod
661#pod Current API available since 0.056.
662#pod
663#pod =cut
664
665sub digest {
666 my ( $self, @opts ) = @_;
667 my $args = ( @opts && ref $opts[0] eq 'HASH' ) ? shift @opts : {};
668 $args = _get_args( $args, qw/chunk_size/ );
669 unshift @opts, 'SHA-256' unless @opts;
670 require Digest;
671 my $digest = Digest->new(@opts);
672 if ( $args->{chunk_size} ) {
673 my $fh = $self->filehandle( { locked => 1 }, "<", ":unix" );
674 my $buf;
675 $digest->add($buf) while read $fh, $buf, $args->{chunk_size};
676 }
677 else {
678 $digest->add( $self->slurp_raw );
679 }
680 return $digest->hexdigest;
681}
682
683#pod =method dirname (deprecated)
684#pod
685#pod $name = path("/tmp/foo.txt")->dirname; # "/tmp/"
686#pod
687#pod Returns the directory portion you would get from calling
688#pod C<< File::Spec->splitpath( $path->stringify ) >> or C<"."> for a path without a
689#pod parent directory portion. Because L<File::Spec> is inconsistent, the result
690#pod might or might not have a trailing slash. Because of this, this method is
691#pod B<deprecated>.
692#pod
693#pod A better, more consistently approach is likely C<< $path->parent->stringify >>,
694#pod which will not have a trailing slash except for a root directory.
695#pod
696#pod Deprecated in 0.056.
697#pod
698#pod =cut
699
700
# spent 243µs (61+182) within Path::Tiny::dirname which was called 12 times, avg 20µs/call: # 12 times (61µs+182µs) by Path::Tiny::is_absolute at line 836, avg 20µs/call
sub dirname {
701123µs my ($self) = @_;
7021220µs12182µs $self->_splitpath unless defined $self->[DIR];
# spent 182µs making 12 calls to Path::Tiny::_splitpath, avg 15µs/call
7031232µs return length $self->[DIR] ? $self->[DIR] : ".";
704}
705
706#pod =method exists, is_file, is_dir
707#pod
708#pod if ( path("/tmp")->exists ) { ... } # -e
709#pod if ( path("/tmp")->is_dir ) { ... } # -d
710#pod if ( path("/tmp")->is_file ) { ... } # -e && ! -d
711#pod
712#pod Implements file test operations, this means the file or directory actually has
713#pod to exist on the filesystem. Until then, it's just a path.
714#pod
715#pod B<Note>: C<is_file> is not C<-f> because C<-f> is not the opposite of C<-d>.
716#pod C<-f> means "plain file", excluding symlinks, devices, etc. that often can be
717#pod read just like files.
718#pod
719#pod Use C<-f> instead if you really mean to check for a plain file.
720#pod
721#pod Current API available since 0.053.
722#pod
723#pod =cut
724
725915.18ms91331µs
# spent 635µs (304+331) within Path::Tiny::exists which was called 91 times, avg 7µs/call: # 91 times (304µs+331µs) by Path::IsDev::Role::Matcher::FullPath::Is::Any::_fullpath_is at line 52 of Path/IsDev/Role/Matcher/FullPath/Is/Any.pm, avg 7µs/call
sub exists { -e $_[0]->[PATH] }
# spent 331µs making 91 calls to Path::Tiny::CORE:ftis, avg 4µs/call
726
727sub is_file { -e $_[0]->[PATH] && !-d _ }
728
729sub is_dir { -d $_[0]->[PATH] }
730
731#pod =method filehandle
732#pod
733#pod $fh = path("/tmp/foo.txt")->filehandle($mode, $binmode);
734#pod $fh = path("/tmp/foo.txt")->filehandle({ locked => 1 }, $mode, $binmode);
735#pod
736#pod Returns an open file handle. The C<$mode> argument must be a Perl-style
737#pod read/write mode string ("<" ,">", "<<", etc.). If a C<$binmode>
738#pod is given, it is set during the C<open> call.
739#pod
740#pod An optional hash reference may be used to pass options. The only option is
741#pod C<locked>. If true, handles opened for writing, appending or read-write are
742#pod locked with C<LOCK_EX>; otherwise, they are locked with C<LOCK_SH>. When using
743#pod C<locked>, ">" or "+>" modes will delay truncation until after the lock is
744#pod acquired.
745#pod
746#pod See C<openr>, C<openw>, C<openrw>, and C<opena> for sugar.
747#pod
748#pod Current API available since 0.039.
749#pod
750#pod =cut
751
752# Note: must put binmode on open line, not subsequent binmode() call, so things
753# like ":unix" actually stop perlio/crlf from being added
754
755
# spent 986µs (34+952) within Path::Tiny::filehandle which was called: # once (34µs+952µs) by Path::Tiny::lines at line 984
sub filehandle {
75611µs my ( $self, @args ) = @_;
75711µs my $args = ( @args && ref $args[0] eq 'HASH' ) ? shift @args : {};
75811µs14µs $args = _get_args( $args, qw/locked/ );
# spent 4µs making 1 call to Path::Tiny::_get_args
7591600ns my ( $opentype, $binmode ) = @args;
760
7611400ns $opentype = "<" unless defined $opentype;
762 Carp::croak("Invalid file mode '$opentype'")
76312µs unless grep { $opentype eq $_ } qw/< +< > +> >> +>>/;
764
7651200ns $binmode = ( ( caller(0) )[10] || {} )->{ 'open' . substr( $opentype, -1, 1 ) }
766 unless defined $binmode;
7671300ns $binmode = "" unless defined $binmode;
768
7691300ns my ( $fh, $lock, $trunc );
7701800ns if ( $HAS_FLOCK && $args->{locked} ) {
7711500ns require Fcntl;
772 # truncating file modes shouldn't truncate until lock acquired
77312µs if ( grep { $opentype eq $_ } qw( > +> ) ) {
774 # sysopen in write mode without truncation
775 my $flags = $opentype eq ">" ? Fcntl::O_WRONLY() : Fcntl::O_RDWR();
776 $flags |= Fcntl::O_CREAT();
777 sysopen( $fh, $self->[PATH], $flags ) or $self->_throw("sysopen");
778
779 # fix up the binmode since sysopen() can't specify layers like
780 # open() and binmode() can't start with just :unix like open()
781 if ( $binmode =~ s/^:unix// ) {
782 # eliminate pseudo-layers
783 binmode( $fh, ":raw" ) or $self->_throw("binmode (:raw)");
784 # strip off real layers until only :unix is left
785 while ( 1 < ( my $layers =()= PerlIO::get_layers( $fh, output => 1 ) ) ) {
786 binmode( $fh, ":pop" ) or $self->_throw("binmode (:pop)");
787 }
788 }
789
790 # apply any remaining binmode layers
791 if ( length $binmode ) {
792 binmode( $fh, $binmode ) or $self->_throw("binmode ($binmode)");
793 }
794
795 # ask for lock and truncation
796 $lock = Fcntl::LOCK_EX();
797 $trunc = 1;
798 }
799 elsif ( $^O eq 'aix' && $opentype eq "<" ) {
800 # AIX can only lock write handles, so upgrade to RW and LOCK_EX if
801 # the file is writable; otherwise give up on locking. N.B.
802 # checking -w before open to determine the open mode is an
803 # unavoidable race condition
804 if ( -w $self->[PATH] ) {
805 $opentype = "+<";
806 $lock = Fcntl::LOCK_EX();
807 }
808 }
809 else {
8101600ns $lock = $opentype eq "<" ? Fcntl::LOCK_SH() : Fcntl::LOCK_EX();
811 }
812 }
813
8141700ns unless ($fh) {
81511µs my $mode = $opentype . $binmode;
8163267µs51.58ms open $fh, $mode, $self->[PATH] or $self->_throw("open ($mode)");
# spent 938µs making 1 call to Path::Tiny::CORE:open # spent 524µs making 1 call to PerlIO::import # spent 104µs making 1 call to Encode::find_encoding # spent 14µs making 1 call to Encode::Encoding::renew # spent 2µs making 1 call to Encode::Encoding::needs_lines
817 }
818
819116µs110µs do { flock( $fh, $lock ) or $self->_throw("flock ($lock)") } if $lock;
# spent 10µs making 1 call to Path::Tiny::CORE:flock
8201300ns do { truncate( $fh, 0 ) or $self->_throw("truncate") } if $trunc;
821
82215µs return $fh;
823}
824
825#pod =method is_absolute, is_relative
826#pod
827#pod if ( path("/tmp")->is_absolute ) { ... }
828#pod if ( path("/tmp")->is_relative ) { ... }
829#pod
830#pod Booleans for whether the path appears absolute or relative.
831#pod
832#pod Current API available since 0.001.
833#pod
834#pod =cut
835
8361244µs12243µs
# spent 291µs (48+243) within Path::Tiny::is_absolute which was called 12 times, avg 24µs/call: # 12 times (48µs+243µs) by Path::Tiny::absolute at line 418, avg 24µs/call
sub is_absolute { substr( $_[0]->dirname, 0, 1 ) eq '/' }
# spent 243µs making 12 calls to Path::Tiny::dirname, avg 20µs/call
837
838sub is_relative { substr( $_[0]->dirname, 0, 1 ) ne '/' }
839
840#pod =method is_rootdir
841#pod
842#pod while ( ! $path->is_rootdir ) {
843#pod $path = $path->parent;
844#pod ...
845#pod }
846#pod
847#pod Boolean for whether the path is the root directory of the volume. I.e. the
848#pod C<dirname> is C<q[/]> and the C<basename> is C<q[]>.
849#pod
850#pod This works even on C<MSWin32> with drives and UNC volumes:
851#pod
852#pod path("C:/")->is_rootdir; # true
853#pod path("//server/share/")->is_rootdir; #true
854#pod
855#pod Current API available since 0.038.
856#pod
857#pod =cut
858
859
# spent 221µs within Path::Tiny::is_rootdir which was called 11 times, avg 20µs/call: # 11 times (221µs+0s) by Path::FindDev::Object::_step at line 206 of Path/FindDev/Object.pm, avg 20µs/call
sub is_rootdir {
860113µs my ($self) = @_;
86111194µs $self->_splitpath unless defined $self->[DIR];
8621131µs return $self->[DIR] eq '/' && $self->[FILE] eq '';
863}
864
865#pod =method iterator
866#pod
867#pod $iter = path("/tmp")->iterator( \%options );
868#pod
869#pod Returns a code reference that walks a directory lazily. Each invocation
870#pod returns a C<Path::Tiny> object or undef when the iterator is exhausted.
871#pod
872#pod $iter = path("/tmp")->iterator;
873#pod while ( $path = $iter->() ) {
874#pod ...
875#pod }
876#pod
877#pod The current and parent directory entries ("." and "..") will not
878#pod be included.
879#pod
880#pod If the C<recurse> option is true, the iterator will walk the directory
881#pod recursively, breadth-first. If the C<follow_symlinks> option is also true,
882#pod directory links will be followed recursively. There is no protection against
883#pod loops when following links. If a directory is not readable, it will not be
884#pod followed.
885#pod
886#pod The default is the same as:
887#pod
888#pod $iter = path("/tmp")->iterator( {
889#pod recurse => 0,
890#pod follow_symlinks => 0,
891#pod } );
892#pod
893#pod For a more powerful, recursive iterator with built-in loop avoidance, see
894#pod L<Path::Iterator::Rule>.
895#pod
896#pod Current API available since 0.016.
897#pod
898#pod =cut
899
900sub iterator {
901 my $self = shift;
902 my $args = _get_args( shift, qw/recurse follow_symlinks/ );
903 my @dirs = $self;
904 my $current;
905 return sub {
906 my $next;
907 while (@dirs) {
908 if ( ref $dirs[0] eq 'Path::Tiny' ) {
909 if ( !-r $dirs[0] ) {
910 # Directory is missing or not readable, so skip it. There
911 # is still a race condition possible between the check and
912 # the opendir, but we can't easily differentiate between
913 # error cases that are OK to skip and those that we want
914 # to be exceptions, so we live with the race and let opendir
915 # be fatal.
916 shift @dirs and next;
917 }
918 $current = $dirs[0];
919 my $dh;
920 opendir( $dh, $current->[PATH] )
921 or $self->_throw( 'opendir', $current->[PATH] );
922 $dirs[0] = $dh;
923 if ( -l $current->[PATH] && !$args->{follow_symlinks} ) {
924 # Symlink attack! It was a real dir, but is now a symlink!
925 # N.B. we check *after* opendir so the attacker has to win
926 # two races: replace dir with symlink before opendir and
927 # replace symlink with dir before -l check above
928 shift @dirs and next;
929 }
930 }
931 while ( defined( $next = readdir $dirs[0] ) ) {
932 next if $next eq '.' || $next eq '..';
933 my $path = $current->child($next);
934 push @dirs, $path
935 if $args->{recurse} && -d $path && !( !$args->{follow_symlinks} && -l $path );
936 return $path;
937 }
938 shift @dirs;
939 }
940 return;
941 };
942}
943
944#pod =method lines, lines_raw, lines_utf8
945#pod
946#pod @contents = path("/tmp/foo.txt")->lines;
947#pod @contents = path("/tmp/foo.txt")->lines(\%options);
948#pod @contents = path("/tmp/foo.txt")->lines_raw;
949#pod @contents = path("/tmp/foo.txt")->lines_utf8;
950#pod
951#pod @contents = path("/tmp/foo.txt")->lines( { chomp => 1, count => 4 } );
952#pod
953#pod Returns a list of lines from a file. Optionally takes a hash-reference of
954#pod options. Valid options are C<binmode>, C<count> and C<chomp>. If C<binmode>
955#pod is provided, it will be set on the handle prior to reading. If C<count> is
956#pod provided, up to that many lines will be returned. If C<chomp> is set, any
957#pod end-of-line character sequences (C<CR>, C<CRLF>, or C<LF>) will be removed
958#pod from the lines returned.
959#pod
960#pod Because the return is a list, C<lines> in scalar context will return the number
961#pod of lines (and throw away the data).
962#pod
963#pod $number_of_lines = path("/tmp/foo.txt")->lines;
964#pod
965#pod C<lines_raw> is like C<lines> with a C<binmode> of C<:raw>. We use C<:raw>
966#pod instead of C<:unix> so PerlIO buffering can manage reading by line.
967#pod
968#pod C<lines_utf8> is like C<lines> with a C<binmode> of
969#pod C<:raw:encoding(UTF-8)>. If L<Unicode::UTF8> 0.58+ is installed, a raw
970#pod UTF-8 slurp will be done and then the lines will be split. This is
971#pod actually faster than relying on C<:encoding(UTF-8)>, though a bit memory
972#pod intensive. If memory use is a concern, consider C<openr_utf8> and
973#pod iterating directly on the handle.
974#pod
975#pod Current API available since 0.048.
976#pod
977#pod =cut
978
979
# spent 6.00ms (2.59+3.41) within Path::Tiny::lines which was called: # once (2.59ms+3.41ms) by Path::Tiny::lines_utf8 at line 1027
sub lines {
9801400ns my $self = shift;
98112µs17µs my $args = _get_args( shift, qw/binmode chomp count/ );
# spent 7µs making 1 call to Path::Tiny::_get_args
9821700ns my $binmode = $args->{binmode};
9831300ns $binmode = ( ( caller(0) )[10] || {} )->{'open<'} unless defined $binmode;
98414µs1986µs my $fh = $self->filehandle( { locked => 1 }, "<", $binmode );
# spent 986µs making 1 call to Path::Tiny::filehandle
9851600ns my $chomp = $args->{chomp};
986 # XXX more efficient to read @lines then chomp(@lines) vs map?
9871700ns if ( $args->{count} ) {
988 my ( @result, $counter );
989 while ( my $line = <$fh> ) {
990 $line =~ s/(?:\x{0d}?\x{0a}|\x{0d})$// if $chomp;
991 push @result, $line;
992 last if ++$counter == $args->{count};
993 }
994 return @result;
995 }
996 elsif ($chomp) {
99724414.77ms12432.62ms return map { s/(?:\x{0d}?\x{0a}|\x{0d})$//; $_ } <$fh>; ## no critic
# spent 1.77ms making 1220 calls to Path::Tiny::CORE:subst, avg 1µs/call # spent 649µs making 1 call to Path::Tiny::CORE:readline # spent 180µs making 11 calls to Encode::utf8::decode_xs, avg 16µs/call # spent 14µs making 11 calls to Encode::Encoding::renewed, avg 1µs/call
998 }
999 else {
1000 return wantarray ? <$fh> : ( my $count =()= <$fh> );
1001 }
1002}
1003
1004sub lines_raw {
1005 my $self = shift;
1006 my $args = _get_args( shift, qw/binmode chomp count/ );
1007 if ( $args->{chomp} && !$args->{count} ) {
1008 return split /\n/, slurp_raw($self); ## no critic
1009 }
1010 else {
1011 $args->{binmode} = ":raw";
1012 return lines( $self, $args );
1013 }
1014}
1015
1016
# spent 6.07ms (22µs+6.05) within Path::Tiny::lines_utf8 which was called: # once (22µs+6.05ms) by Pod::Spell::BEGIN@10 at line 22 of Pod/Wordlist.pm
sub lines_utf8 {
10171400ns my $self = shift;
101812µs110µs my $args = _get_args( shift, qw/binmode chomp count/ );
# spent 10µs making 1 call to Path::Tiny::_get_args
101913µs137µs if ( ( defined($HAS_UU) ? $HAS_UU : ( $HAS_UU = _check_UU() ) )
# spent 37µs making 1 call to Path::Tiny::_check_UU
1020 && $args->{chomp}
1021 && !$args->{count} )
1022 {
1023 return split /(?:\x{0d}?\x{0a}|\x{0d})/, slurp_utf8($self); ## no critic
1024 }
1025 else {
102611µs $args->{binmode} = ":raw:encoding(UTF-8)";
102718µs16.00ms return lines( $self, $args );
# spent 6.00ms making 1 call to Path::Tiny::lines
1028 }
1029}
1030
1031#pod =method mkpath
1032#pod
1033#pod path("foo/bar/baz")->mkpath;
1034#pod path("foo/bar/baz")->mkpath( \%options );
1035#pod
1036#pod Like calling C<make_path> from L<File::Path>. An optional hash reference
1037#pod is passed through to C<make_path>. Errors will be trapped and an exception
1038#pod thrown. Returns the list of directories created or an empty list if
1039#pod the directories already exist, just like C<make_path>.
1040#pod
1041#pod Current API available since 0.001.
1042#pod
1043#pod =cut
1044
1045sub mkpath {
1046 my ( $self, $args ) = @_;
1047 $args = {} unless ref $args eq 'HASH';
1048 my $err;
1049 $args->{err} = \$err unless defined $args->{err};
1050 require File::Path;
1051 my @dirs = File::Path::make_path( $self->[PATH], $args );
1052 if ( $err && @$err ) {
1053 my ( $file, $message ) = %{ $err->[0] };
1054 Carp::croak("mkpath failed for $file: $message");
1055 }
1056 return @dirs;
1057}
1058
1059#pod =method move
1060#pod
1061#pod path("foo.txt")->move("bar.txt");
1062#pod
1063#pod Just like C<rename>.
1064#pod
1065#pod Current API available since 0.001.
1066#pod
1067#pod =cut
1068
1069sub move {
1070 my ( $self, $dst ) = @_;
1071
1072 return rename( $self->[PATH], $dst )
1073 || $self->_throw( 'rename', $self->[PATH] . "' -> '$dst'" );
1074}
1075
1076#pod =method openr, openw, openrw, opena
1077#pod
1078#pod $fh = path("foo.txt")->openr($binmode); # read
1079#pod $fh = path("foo.txt")->openr_raw;
1080#pod $fh = path("foo.txt")->openr_utf8;
1081#pod
1082#pod $fh = path("foo.txt")->openw($binmode); # write
1083#pod $fh = path("foo.txt")->openw_raw;
1084#pod $fh = path("foo.txt")->openw_utf8;
1085#pod
1086#pod $fh = path("foo.txt")->opena($binmode); # append
1087#pod $fh = path("foo.txt")->opena_raw;
1088#pod $fh = path("foo.txt")->opena_utf8;
1089#pod
1090#pod $fh = path("foo.txt")->openrw($binmode); # read/write
1091#pod $fh = path("foo.txt")->openrw_raw;
1092#pod $fh = path("foo.txt")->openrw_utf8;
1093#pod
1094#pod Returns a file handle opened in the specified mode. The C<openr> style methods
1095#pod take a single C<binmode> argument. All of the C<open*> methods have
1096#pod C<open*_raw> and C<open*_utf8> equivalents that use C<:raw> and
1097#pod C<:raw:encoding(UTF-8)>, respectively.
1098#pod
1099#pod An optional hash reference may be used to pass options. The only option is
1100#pod C<locked>. If true, handles opened for writing, appending or read-write are
1101#pod locked with C<LOCK_EX>; otherwise, they are locked for C<LOCK_SH>.
1102#pod
1103#pod $fh = path("foo.txt")->openrw_utf8( { locked => 1 } );
1104#pod
1105#pod See L</filehandle> for more on locking.
1106#pod
1107#pod Current API available since 0.011.
1108#pod
1109#pod =cut
1110
1111# map method names to corresponding open mode
111212µsmy %opens = (
1113 opena => ">>",
1114 openr => "<",
1115 openw => ">",
1116 openrw => "+<"
1117);
1118
111914µswhile ( my ( $k, $v ) = each %opens ) {
112021.51ms234µs
# spent 22µs (10+12) within Path::Tiny::BEGIN@1120 which was called: # once (10µs+12µs) by File::ShareDir::ProjectDistDir::_path at line 1120
no strict 'refs';
# spent 22µs making 1 call to Path::Tiny::BEGIN@1120 # spent 12µs making 1 call to strict::unimport
1121 # must check for lexical IO mode hint
1122 *{$k} = sub {
1123 my ( $self, @args ) = @_;
1124 my $args = ( @args && ref $args[0] eq 'HASH' ) ? shift @args : {};
1125 $args = _get_args( $args, qw/locked/ );
1126 my ($binmode) = @args;
1127 $binmode = ( ( caller(0) )[10] || {} )->{ 'open' . substr( $v, -1, 1 ) }
1128 unless defined $binmode;
1129 $self->filehandle( $args, $v, $binmode );
1130412µs };
1131 *{ $k . "_raw" } = sub {
1132 my ( $self, @args ) = @_;
1133 my $args = ( @args && ref $args[0] eq 'HASH' ) ? shift @args : {};
1134 $args = _get_args( $args, qw/locked/ );
1135 $self->filehandle( $args, $v, ":raw" );
113648µs };
1137 *{ $k . "_utf8" } = sub {
1138 my ( $self, @args ) = @_;
1139 my $args = ( @args && ref $args[0] eq 'HASH' ) ? shift @args : {};
1140 $args = _get_args( $args, qw/locked/ );
1141 $self->filehandle( $args, $v, ":raw:encoding(UTF-8)" );
114247µs };
1143}
1144
1145#pod =method parent
1146#pod
1147#pod $parent = path("foo/bar/baz")->parent; # foo/bar
1148#pod $parent = path("foo/wibble.txt")->parent; # foo
1149#pod
1150#pod $parent = path("foo/bar/baz")->parent(2); # foo
1151#pod
1152#pod Returns a C<Path::Tiny> object corresponding to the parent directory of the
1153#pod original directory or file. An optional positive integer argument is the number
1154#pod of parent directories upwards to return. C<parent> by itself is equivalent to
1155#pod C<parent(1)>.
1156#pod
1157#pod Current API available since 0.014.
1158#pod
1159#pod =cut
1160
1161# XXX this is ugly and coverage is incomplete. I think it's there for windows
1162# so need to check coverage there and compare
1163
# spent 574µs (184+389) within Path::Tiny::parent which was called 21 times, avg 27µs/call: # 10 times (85µs+194µs) by Path::FindDev::Object::find_dev at line 237 of Path/FindDev/Object.pm, avg 28µs/call # 10 times (68µs+158µs) by Path::FindDev::Object::find_dev at line 238 of Path/FindDev/Object.pm, avg 23µs/call # once (31µs+37µs) by File::ShareDir::ProjectDistDir::_get_cached_dist_dir_result at line 549 of File/ShareDir/ProjectDistDir.pm
sub parent {
1164215µs my ( $self, $level ) = @_;
1165216µs $level = 1 unless defined $level && $level > 0;
11662124µs120µs $self->_splitpath unless defined $self->[FILE];
# spent 20µs making 1 call to Path::Tiny::_splitpath
116721700ns my $parent;
11682120µs if ( length $self->[FILE] ) {
1169 if ( $self->[FILE] eq '.' || $self->[FILE] eq ".." ) {
1170 $parent = path( $self->[PATH] . "/.." );
1171 }
1172 else {
11732147µs42370µs $parent = path( _non_empty( $self->[VOL] . $self->[DIR] ) );
# spent 332µs making 21 calls to Path::Tiny::path, avg 16µs/call # spent 37µs making 21 calls to Path::Tiny::_non_empty, avg 2µs/call
1174 }
1175 }
1176 elsif ( length $self->[DIR] ) {
1177 # because of symlinks, any internal updir requires us to
1178 # just add more updirs at the end
1179 if ( $self->[DIR] =~ m{(?:^\.\./|/\.\./|/\.\.$)} ) {
1180 $parent = path( $self->[VOL] . $self->[DIR] . "/.." );
1181 }
1182 else {
1183 ( my $dir = $self->[DIR] ) =~ s{/[^\/]+/$}{/};
1184 $parent = path( $self->[VOL] . $dir );
1185 }
1186 }
1187 else {
1188 $parent = path( _non_empty( $self->[VOL] ) );
1189 }
11902142µs return $level == 1 ? $parent : $parent->parent( $level - 1 );
1191}
1192
1193
# spent 37µs within Path::Tiny::_non_empty which was called 21 times, avg 2µs/call: # 21 times (37µs+0s) by Path::Tiny::parent at line 1173, avg 2µs/call
sub _non_empty {
1194218µs my ($string) = shift;
11952149µs return ( ( defined($string) && length($string) ) ? $string : "." );
1196}
1197
1198#pod =method realpath
1199#pod
1200#pod $real = path("/baz/foo/../bar")->realpath;
1201#pod $real = path("foo/../bar")->realpath;
1202#pod
1203#pod Returns a new C<Path::Tiny> object with all symbolic links and upward directory
1204#pod parts resolved using L<Cwd>'s C<realpath>. Compared to C<absolute>, this is
1205#pod more expensive as it must actually consult the filesystem.
1206#pod
1207#pod If the path can't be resolved (e.g. if it includes directories that don't exist),
1208#pod an exception will be thrown:
1209#pod
1210#pod $real = path("doesnt_exist/foo")->realpath; # dies
1211#pod
1212#pod Current API available since 0.001.
1213#pod
1214#pod =cut
1215
1216
# spent 3.92ms (1.26+2.66) within Path::Tiny::realpath which was called 113 times, avg 35µs/call: # 91 times (984µs+2.05ms) by Path::IsDev::Role::Matcher::FullPath::Is::Any::_fullpath_is at line 60 of Path/IsDev/Role/Matcher/FullPath/Is/Any.pm, avg 33µs/call # 21 times (257µs+550µs) by Path::IsDev::Role::Matcher::FullPath::Is::Any::fullpath_is_any at line 89 of Path/IsDev/Role/Matcher/FullPath/Is/Any.pm, avg 38µs/call # once (18µs+68µs) by Path::FindDev::Object::find_dev at line 229 of Path/FindDev/Object.pm
sub realpath {
121711324µs my $self = shift;
121811324µs require Cwd;
121911349µs my $realpath = eval {
1220113287µs local $SIG{__WARN__} = sub { }; # (sigh) pure-perl CWD can carp
12211131.42ms113947µs Cwd::realpath( $self->[PATH] );
# spent 947µs making 113 calls to Cwd::abs_path, avg 8µs/call
1222 };
122311336µs $self->_throw("resolving realpath") unless defined $realpath and length $realpath;
1224113290µs1131.72ms return path($realpath);
# spent 1.72ms making 113 calls to Path::Tiny::path, avg 15µs/call
1225}
1226
1227#pod =method relative
1228#pod
1229#pod $rel = path("/tmp/foo/bar")->relative("/tmp"); # foo/bar
1230#pod
1231#pod Returns a C<Path::Tiny> object with a relative path name.
1232#pod Given the trickiness of this, it's a thin wrapper around
1233#pod C<< File::Spec->abs2rel() >>.
1234#pod
1235#pod Current API available since 0.001.
1236#pod
1237#pod =cut
1238
1239# Easy to get wrong, so wash it through File::Spec (sigh)
1240sub relative { path( File::Spec->abs2rel( $_[0]->[PATH], $_[1] ) ) }
1241
1242#pod =method remove
1243#pod
1244#pod path("foo.txt")->remove;
1245#pod
1246#pod This is just like C<unlink>, except for its error handling: if the path does
1247#pod not exist, it returns false; if deleting the file fails, it throws an
1248#pod exception.
1249#pod
1250#pod Current API available since 0.012.
1251#pod
1252#pod =cut
1253
1254sub remove {
1255 my $self = shift;
1256
1257 return 0 if !-e $self->[PATH] && !-l $self->[PATH];
1258
1259 return unlink( $self->[PATH] ) || $self->_throw('unlink');
1260}
1261
1262#pod =method remove_tree
1263#pod
1264#pod # directory
1265#pod path("foo/bar/baz")->remove_tree;
1266#pod path("foo/bar/baz")->remove_tree( \%options );
1267#pod path("foo/bar/baz")->remove_tree( { safe => 0 } ); # force remove
1268#pod
1269#pod Like calling C<remove_tree> from L<File::Path>, but defaults to C<safe> mode.
1270#pod An optional hash reference is passed through to C<remove_tree>. Errors will be
1271#pod trapped and an exception thrown. Returns the number of directories deleted,
1272#pod just like C<remove_tree>.
1273#pod
1274#pod If you want to remove a directory only if it is empty, use the built-in
1275#pod C<rmdir> function instead.
1276#pod
1277#pod rmdir path("foo/bar/baz/");
1278#pod
1279#pod Current API available since 0.013.
1280#pod
1281#pod =cut
1282
1283sub remove_tree {
1284 my ( $self, $args ) = @_;
1285 return 0 if !-e $self->[PATH] && !-l $self->[PATH];
1286 $args = {} unless ref $args eq 'HASH';
1287 my $err;
1288 $args->{err} = \$err unless defined $args->{err};
1289 $args->{safe} = 1 unless defined $args->{safe};
1290 require File::Path;
1291 my $count = File::Path::remove_tree( $self->[PATH], $args );
1292
1293 if ( $err && @$err ) {
1294 my ( $file, $message ) = %{ $err->[0] };
1295 Carp::croak("remove_tree failed for $file: $message");
1296 }
1297 return $count;
1298}
1299
1300#pod =method sibling
1301#pod
1302#pod $foo = path("/tmp/foo.txt");
1303#pod $sib = $foo->sibling("bar.txt"); # /tmp/bar.txt
1304#pod $sib = $foo->sibling("baz", "bam.txt"); # /tmp/baz/bam.txt
1305#pod
1306#pod Returns a new C<Path::Tiny> object relative to the parent of the original.
1307#pod This is slightly more efficient than C<< $path->parent->child(...) >>.
1308#pod
1309#pod Current API available since 0.058.
1310#pod
1311#pod =cut
1312
1313sub sibling {
1314 my $self = shift;
1315 return path( $self->parent->[PATH], @_ );
1316}
1317
1318#pod =method slurp, slurp_raw, slurp_utf8
1319#pod
1320#pod $data = path("foo.txt")->slurp;
1321#pod $data = path("foo.txt")->slurp( {binmode => ":raw"} );
1322#pod $data = path("foo.txt")->slurp_raw;
1323#pod $data = path("foo.txt")->slurp_utf8;
1324#pod
1325#pod Reads file contents into a scalar. Takes an optional hash reference may be
1326#pod used to pass options. The only option is C<binmode>, which is passed to
1327#pod C<binmode()> on the handle used for reading.
1328#pod
1329#pod C<slurp_raw> is like C<slurp> with a C<binmode> of C<:unix> for
1330#pod a fast, unbuffered, raw read.
1331#pod
1332#pod C<slurp_utf8> is like C<slurp> with a C<binmode> of
1333#pod C<:unix:encoding(UTF-8)>. If L<Unicode::UTF8> 0.58+ is installed, a raw
1334#pod slurp will be done instead and the result decoded with C<Unicode::UTF8>.
1335#pod This is just as strict and is roughly an order of magnitude faster than
1336#pod using C<:encoding(UTF-8)>.
1337#pod
1338#pod Current API available since 0.004.
1339#pod
1340#pod =cut
1341
1342sub slurp {
1343 my $self = shift;
1344 my $args = _get_args( shift, qw/binmode/ );
1345 my $binmode = $args->{binmode};
1346 $binmode = ( ( caller(0) )[10] || {} )->{'open<'} unless defined $binmode;
1347 my $fh = $self->filehandle( { locked => 1 }, "<", $binmode );
1348 if ( ( defined($binmode) ? $binmode : "" ) eq ":unix"
1349 and my $size = -s $fh )
1350 {
1351 my $buf;
1352 read $fh, $buf, $size; # File::Slurp in a nutshell
1353 return $buf;
1354 }
1355 else {
1356 local $/;
1357 return scalar <$fh>;
1358 }
1359}
1360
1361sub slurp_raw { $_[1] = { binmode => ":unix" }; goto &slurp }
1362
1363sub slurp_utf8 {
1364 if ( defined($HAS_UU) ? $HAS_UU : ( $HAS_UU = _check_UU() ) ) {
1365 return Unicode::UTF8::decode_utf8( slurp( $_[0], { binmode => ":unix" } ) );
1366 }
1367 else {
1368 $_[1] = { binmode => ":raw:encoding(UTF-8)" };
1369 goto &slurp;
1370 }
1371}
1372
1373#pod =method spew, spew_raw, spew_utf8
1374#pod
1375#pod path("foo.txt")->spew(@data);
1376#pod path("foo.txt")->spew(\@data);
1377#pod path("foo.txt")->spew({binmode => ":raw"}, @data);
1378#pod path("foo.txt")->spew_raw(@data);
1379#pod path("foo.txt")->spew_utf8(@data);
1380#pod
1381#pod Writes data to a file atomically. The file is written to a temporary file in
1382#pod the same directory, then renamed over the original. An optional hash reference
1383#pod may be used to pass options. The only option is C<binmode>, which is passed to
1384#pod C<binmode()> on the handle used for writing.
1385#pod
1386#pod C<spew_raw> is like C<spew> with a C<binmode> of C<:unix> for a fast,
1387#pod unbuffered, raw write.
1388#pod
1389#pod C<spew_utf8> is like C<spew> with a C<binmode> of C<:unix:encoding(UTF-8)>.
1390#pod If L<Unicode::UTF8> 0.58+ is installed, a raw spew will be done instead on
1391#pod the data encoded with C<Unicode::UTF8>.
1392#pod
1393#pod B<NOTE>: because the file is written to a temporary file and then renamed, the
1394#pod new file will wind up with permissions based on your current umask. This is a
1395#pod feature to protect you from a race condition that would otherwise give
1396#pod different permissions than you might expect. If you really want to keep the
1397#pod original mode flags, use L</append> with the C<truncate> option.
1398#pod
1399#pod Current API available since 0.011.
1400#pod
1401#pod =cut
1402
1403# XXX add "unsafe" option to disable flocking and atomic? Check benchmarks on append() first.
1404sub spew {
1405 my ( $self, @data ) = @_;
1406 my $args = ( @data && ref $data[0] eq 'HASH' ) ? shift @data : {};
1407 $args = _get_args( $args, qw/binmode/ );
1408 my $binmode = $args->{binmode};
1409 # get default binmode from caller's lexical scope (see "perldoc open")
1410 $binmode = ( ( caller(0) )[10] || {} )->{'open>'} unless defined $binmode;
1411 my $temp = path( $self->[PATH] . $$ . int( rand( 2**31 ) ) );
1412 my $fh = $temp->filehandle( { locked => 1 }, ">", $binmode );
1413 print {$fh} map { ref eq 'ARRAY' ? @$_ : $_ } @data;
1414 close $fh or $self->_throw( 'close', $temp->[PATH] );
1415
1416 # spewing need to follow the link
1417 # and replace the destination instead
1418 my $resolved_path = $self->[PATH];
1419 $resolved_path = readlink $resolved_path while -l $resolved_path;
1420 return $temp->move($resolved_path);
1421}
1422
1423sub spew_raw { splice @_, 1, 0, { binmode => ":unix" }; goto &spew }
1424
1425sub spew_utf8 {
1426 if ( defined($HAS_UU) ? $HAS_UU : ( $HAS_UU = _check_UU() ) ) {
1427 my $self = shift;
1428 spew( $self, { binmode => ":unix" }, map { Unicode::UTF8::encode_utf8($_) } @_ );
1429 }
1430 else {
1431 splice @_, 1, 0, { binmode => ":unix:encoding(UTF-8)" };
1432 goto &spew;
1433 }
1434}
1435
1436#pod =method stat, lstat
1437#pod
1438#pod $stat = path("foo.txt")->stat;
1439#pod $stat = path("/some/symlink")->lstat;
1440#pod
1441#pod Like calling C<stat> or C<lstat> from L<File::stat>.
1442#pod
1443#pod Current API available since 0.001.
1444#pod
1445#pod =cut
1446
1447# XXX break out individual stat() components as subs?
1448sub stat {
1449 my $self = shift;
1450 require File::stat;
1451 return File::stat::stat( $self->[PATH] ) || $self->_throw('stat');
1452}
1453
1454sub lstat {
1455 my $self = shift;
1456 require File::stat;
1457 return File::stat::lstat( $self->[PATH] ) || $self->_throw('lstat');
1458}
1459
1460#pod =method stringify
1461#pod
1462#pod $path = path("foo.txt");
1463#pod say $path->stringify; # same as "$path"
1464#pod
1465#pod Returns a string representation of the path. Unlike C<canonpath>, this method
1466#pod returns the path standardized with Unix-style C</> directory separators.
1467#pod
1468#pod Current API available since 0.001.
1469#pod
1470#pod =cut
1471
1472sub stringify { $_[0]->[PATH] }
1473
1474#pod =method subsumes
1475#pod
1476#pod path("foo/bar")->subsumes("foo/bar/baz"); # true
1477#pod path("/foo/bar")->subsumes("/foo/baz"); # false
1478#pod
1479#pod Returns true if the first path is a prefix of the second path at a directory
1480#pod boundary.
1481#pod
1482#pod This B<does not> resolve parent directory entries (C<..>) or symlinks:
1483#pod
1484#pod path("foo/bar")->subsumes("foo/bar/../baz"); # true
1485#pod
1486#pod If such things are important to you, ensure that both paths are resolved to
1487#pod the filesystem with C<realpath>:
1488#pod
1489#pod my $p1 = path("foo/bar")->realpath;
1490#pod my $p2 = path("foo/bar/../baz")->realpath;
1491#pod if ( $p1->subsumes($p2) ) { ... }
1492#pod
1493#pod Current API available since 0.048.
1494#pod
1495#pod =cut
1496
1497sub subsumes {
1498 my $self = shift;
1499 Carp::croak("subsumes() requires a defined, positive-length argument")
1500 unless defined $_[0];
1501 my $other = path(shift);
1502
1503 # normalize absolute vs relative
1504 if ( $self->is_absolute && !$other->is_absolute ) {
1505 $other = $other->absolute;
1506 }
1507 elsif ( $other->is_absolute && !$self->is_absolute ) {
1508 $self = $self->absolute;
1509 }
1510
1511 # normalize volume vs non-volume; do this after absolute path
1512 # adjustments above since that might add volumes already
1513 if ( length $self->volume && !length $other->volume ) {
1514 $other = $other->absolute;
1515 }
1516 elsif ( length $other->volume && !length $self->volume ) {
1517 $self = $self->absolute;
1518 }
1519
1520 if ( $self->[PATH] eq '.' ) {
1521 return !!1; # cwd subsumes everything relative
1522 }
1523 elsif ( $self->is_rootdir ) {
1524 # a root directory ("/", "c:/") already ends with a separator
1525 return $other->[PATH] =~ m{^\Q$self->[PATH]\E};
1526 }
1527 else {
1528 # exact match or prefix breaking at a separator
1529 return $other->[PATH] =~ m{^\Q$self->[PATH]\E(?:/|$)};
1530 }
1531}
1532
1533#pod =method touch
1534#pod
1535#pod path("foo.txt")->touch;
1536#pod path("foo.txt")->touch($epoch_secs);
1537#pod
1538#pod Like the Unix C<touch> utility. Creates the file if it doesn't exist, or else
1539#pod changes the modification and access times to the current time. If the first
1540#pod argument is the epoch seconds then it will be used.
1541#pod
1542#pod Returns the path object so it can be easily chained with spew:
1543#pod
1544#pod path("foo.txt")->touch->spew( $content );
1545#pod
1546#pod Current API available since 0.015.
1547#pod
1548#pod =cut
1549
1550sub touch {
1551 my ( $self, $epoch ) = @_;
1552 if ( !-e $self->[PATH] ) {
1553 my $fh = $self->openw;
1554 close $fh or $self->_throw('close');
1555 }
1556 $epoch = defined($epoch) ? $epoch : time();
1557 utime $epoch, $epoch, $self->[PATH]
1558 or $self->_throw("utime ($epoch)");
1559 return $self;
1560}
1561
1562#pod =method touchpath
1563#pod
1564#pod path("bar/baz/foo.txt")->touchpath;
1565#pod
1566#pod Combines C<mkpath> and C<touch>. Creates the parent directory if it doesn't exist,
1567#pod before touching the file. Returns the path object like C<touch> does.
1568#pod
1569#pod Current API available since 0.022.
1570#pod
1571#pod =cut
1572
1573sub touchpath {
1574 my ($self) = @_;
1575 my $parent = $self->parent;
1576 $parent->mkpath unless $parent->exists;
1577 $self->touch;
1578}
1579
1580#pod =method volume
1581#pod
1582#pod $vol = path("/tmp/foo.txt")->volume; # ""
1583#pod $vol = path("C:/tmp/foo.txt")->volume; # "C:"
1584#pod
1585#pod Returns the volume portion of the path. This is equivalent
1586#pod equivalent to what L<File::Spec> would give from C<splitpath> and thus
1587#pod usually is the empty string on Unix-like operating systems or the
1588#pod drive letter for an absolute path on C<MSWin32>.
1589#pod
1590#pod Current API available since 0.001.
1591#pod
1592#pod =cut
1593
1594sub volume {
1595 my ($self) = @_;
1596 $self->_splitpath unless defined $self->[VOL];
1597 return $self->[VOL];
1598}
1599
1600package Path::Tiny::Error;
1601
16021800nsour @CARP_NOT = qw/Path::Tiny/;
1603
16042103µs261µs
# spent 35µs (10+25) within Path::Tiny::Error::BEGIN@1604 which was called: # once (10µs+25µs) by File::ShareDir::ProjectDistDir::_path at line 1604
use overload ( q{""} => sub { (shift)->{msg} }, fallback => 1 );
# spent 35µs making 1 call to Path::Tiny::Error::BEGIN@1604 # spent 25µs making 1 call to overload::import
1605
1606sub throw {
1607 my ( $class, $op, $file, $err ) = @_;
1608 chomp( my $trace = Carp::shortmess );
1609 my $msg = "Error $op on '$file': $err$trace\n";
1610 die bless { op => $op, file => $file, err => $err, msg => $msg }, $class;
1611}
1612
1613114µs1;
1614
1615
1616# vim: ts=4 sts=4 sw=4 et:
1617
1618__END__
 
# spent 34µs within Path::Tiny::CORE:closedir which was called 9 times, avg 4µs/call: # 9 times (34µs+0s) by Path::Tiny::children at line 574, avg 4µs/call
sub Path::Tiny::CORE:closedir; # opcode
# spent 10µs within Path::Tiny::CORE:flock which was called: # once (10µs+0s) by Path::Tiny::filehandle at line 819
sub Path::Tiny::CORE:flock; # opcode
# spent 331µs within Path::Tiny::CORE:ftis which was called 91 times, avg 4µs/call: # 91 times (331µs+0s) by Path::Tiny::exists at line 725, avg 4µs/call
sub Path::Tiny::CORE:ftis; # opcode
# spent 146µs within Path::Tiny::CORE:match which was called 476 times, avg 307ns/call: # 475 times (145µs+0s) by Path::Tiny::path at line 237, avg 305ns/call # once (1µs+0s) by Path::Tiny::BEGIN@19 at line 28
sub Path::Tiny::CORE:match; # opcode
# spent 938µs (92+846) within Path::Tiny::CORE:open which was called: # once (92µs+846µs) by Path::Tiny::filehandle at line 816
sub Path::Tiny::CORE:open; # opcode
# spent 148µs within Path::Tiny::CORE:open_dir which was called 9 times, avg 16µs/call: # 9 times (148µs+0s) by Path::Tiny::children at line 572, avg 16µs/call
sub Path::Tiny::CORE:open_dir; # opcode
# spent 5µs within Path::Tiny::CORE:qr which was called 5 times, avg 920ns/call: # once (1µs+0s) by File::ShareDir::ProjectDistDir::_path at line 50 # once (900ns+0s) by File::ShareDir::ProjectDistDir::_path at line 54 # once (900ns+0s) by File::ShareDir::ProjectDistDir::_path at line 53 # once (800ns+0s) by File::ShareDir::ProjectDistDir::_path at line 51 # once (700ns+0s) by File::ShareDir::ProjectDistDir::_path at line 52
sub Path::Tiny::CORE:qr; # opcode
# spent 197µs within Path::Tiny::CORE:readdir which was called 9 times, avg 22µs/call: # 9 times (197µs+0s) by Path::Tiny::children at line 573, avg 22µs/call
sub Path::Tiny::CORE:readdir; # opcode
# spent 649µs (469+180) within Path::Tiny::CORE:readline which was called: # once (469µs+180µs) by Path::Tiny::lines at line 997
sub Path::Tiny::CORE:readline; # opcode
# spent 51µs within Path::Tiny::CORE:regcomp which was called 2 times, avg 25µs/call: # once (35µs+0s) by File::ShareDir::ProjectDistDir::_path at line 54 # once (16µs+0s) by File::ShareDir::ProjectDistDir::_path at line 53
sub Path::Tiny::CORE:regcomp; # opcode
# spent 1.97ms within Path::Tiny::CORE:subst which was called 1695 times, avg 1µs/call: # 1220 times (1.77ms+0s) by Path::Tiny::lines at line 997, avg 1µs/call # 471 times (191µs+0s) by Path::Tiny::path at line 233, avg 406ns/call # 4 times (8µs+0s) by Path::Tiny::path at line 230, avg 2µs/call
sub Path::Tiny::CORE:subst; # opcode
# spent 7µs within Path::Tiny::__ANON__ which was called 11 times, avg 655ns/call: # 11 times (7µs+0s) by Path::IsDev::Result::BUILD at line 67 of Path/IsDev/Result.pm, avg 655ns/call
sub Path::Tiny::__ANON__; # xsub
Report produced by the NYTProf 6.01 Perl profiler, developed by Tim Bunce and Adam Kaplan.