← Index
NYTProf Performance Profile   « line view »
For rbm/rbm
  Run on Wed Feb 12 03:38:15 2020
Reported on Wed Feb 12 04:56:35 2020

Filename/usr/share/perl5/Path/Tiny.pm
StatementsExecuted 117117 statements in 14.7s
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
19921114.0s14.0sPath::Tiny::::CORE:read Path::Tiny::CORE:read (opcode)
199211198ms14.5sPath::Tiny::::slurp Path::Tiny::slurp
199311123ms123msPath::Tiny::::CORE:open Path::Tiny::CORE:open (opcode)
202552103ms125msPath::Tiny::::path Path::Tiny::path
20093199.6ms252msPath::Tiny::::filehandle Path::Tiny::filehandle
40195133.1ms33.1msPath::Tiny::::_get_args Path::Tiny::_get_args
20091117.5ms17.5msPath::Tiny::::CORE:flock Path::Tiny::CORE:flock (opcode)
19921116.8ms16.8msPath::Tiny::::slurp_raw Path::Tiny::slurp_raw
1992118.18ms8.18msPath::Tiny::::CORE:ftsize Path::Tiny::CORE:ftsize (opcode)
2025118.07ms8.07msPath::Tiny::::_is_root Path::Tiny::_is_root
1114.06ms4.84msPath::Tiny::::BEGIN@14 Path::Tiny::BEGIN@14
2041213.11ms3.11msPath::Tiny::::CORE:subst Path::Tiny::CORE:subst (opcode)
1112.04ms7.41msPath::Tiny::::BEGIN@13 Path::Tiny::BEGIN@13
2025111.93ms1.93msPath::Tiny::::CORE:match Path::Tiny::CORE:match (opcode)
17211.63ms1.63msPath::Tiny::::CORE:close Path::Tiny::CORE:close (opcode)
16111.48ms8.96msPath::Tiny::::spew Path::Tiny::spew
1111.19ms1.84msPath::Tiny::::_check_UU Path::Tiny::_check_UU
1111.10ms1.19msPath::Tiny::::BEGIN@29 Path::Tiny::BEGIN@29
1721854µs854µsPath::Tiny::::CORE:print Path::Tiny::CORE:print (opcode)
1621802µs11.7msPath::Tiny::::spew_utf8 Path::Tiny::spew_utf8
1611593µs614µsPath::Tiny::::CORE:rename Path::Tiny::CORE:rename (opcode)
1611442µs442µsPath::Tiny::::CORE:sysopen Path::Tiny::CORE:sysopen (opcode)
1611290µs290µsPath::Tiny::::CORE:truncate Path::Tiny::CORE:truncate (opcode)
1611265µs879µsPath::Tiny::::move Path::Tiny::move
1611191µs294µsPath::Tiny::::_resolve_symlinks Path::Tiny::_resolve_symlinks
1611103µs103µsPath::Tiny::::CORE:ftlink Path::Tiny::CORE:ftlink (opcode)
322177µs77µsPath::Tiny::::__ANON__[:30] Path::Tiny::__ANON__[:30]
11166µs278µsPath::Tiny::::append_utf8 Path::Tiny::append_utf8
322162µs62µsPath::Tiny::::CORE:binmode Path::Tiny::CORE:binmode (opcode)
22155µs55µsPath::Tiny::::CORE:regcomp Path::Tiny::CORE:regcomp (opcode)
11143µs198µsPath::Tiny::::append Path::Tiny::append
11123µs23µsRBM::::BEGIN@1 RBM::BEGIN@1
11114µs27µsPath::Tiny::::BEGIN@12 Path::Tiny::BEGIN@12
11111µs114µsPath::Tiny::::BEGIN@19 Path::Tiny::BEGIN@19
11111µs49µsPath::Tiny::Error::::BEGIN@2133Path::Tiny::Error::BEGIN@2133
11110µs29µsPath::Tiny::::BEGIN@1415 Path::Tiny::BEGIN@1415
1117µs21µsPath::Tiny::::BEGIN@11 Path::Tiny::BEGIN@11
1116µs18µsPath::Tiny::::BEGIN@38 Path::Tiny::BEGIN@38
6616µs6µsPath::Tiny::::CORE:qr Path::Tiny::CORE:qr (opcode)
1116µs22µsRBM::::BEGIN@3.1 RBM::BEGIN@3.1
1116µs32µsflock::::BEGIN@132 flock::BEGIN@132
1116µs6µsPath::Tiny::::BEGIN@94 Path::Tiny::BEGIN@94
1116µs8µsRBM::::BEGIN@2 RBM::BEGIN@2
0000s0sPath::Tiny::Error::::__ANON__[:2133]Path::Tiny::Error::__ANON__[:2133]
0000s0sPath::Tiny::Error::::throwPath::Tiny::Error::throw
0000s0sPath::Tiny::::FREEZE Path::Tiny::FREEZE
0000s0sPath::Tiny::::THAW Path::Tiny::THAW
0000s0sPath::Tiny::::__ANON__[:1214] Path::Tiny::__ANON__[:1214]
0000s0sPath::Tiny::::__ANON__[:1425] Path::Tiny::__ANON__[:1425]
0000s0sPath::Tiny::::__ANON__[:1431] Path::Tiny::__ANON__[:1431]
0000s0sPath::Tiny::::__ANON__[:1437] Path::Tiny::__ANON__[:1437]
0000s0sPath::Tiny::::__ANON__[:1532] Path::Tiny::__ANON__[:1532]
0000s0sPath::Tiny::::__ANON__[:95] Path::Tiny::__ANON__[:95]
0000s0sPath::Tiny::::_check_PU Path::Tiny::_check_PU
0000s0sPath::Tiny::::_just_filepath Path::Tiny::_just_filepath
0000s0sPath::Tiny::::_non_empty Path::Tiny::_non_empty
0000s0sPath::Tiny::::_parse_file_temp_args Path::Tiny::_parse_file_temp_args
0000s0sPath::Tiny::::_resolve_between Path::Tiny::_resolve_between
0000s0sPath::Tiny::::_splitpath Path::Tiny::_splitpath
0000s0sPath::Tiny::::_symbolic_chmod Path::Tiny::_symbolic_chmod
0000s0sPath::Tiny::::_throw Path::Tiny::_throw
0000s0sPath::Tiny::::_win32_vol Path::Tiny::_win32_vol
0000s0sPath::Tiny::::absolute Path::Tiny::absolute
0000s0sPath::Tiny::::append_raw Path::Tiny::append_raw
0000s0sPath::Tiny::::assert Path::Tiny::assert
0000s0sPath::Tiny::::basename Path::Tiny::basename
0000s0sPath::Tiny::::cached_temp Path::Tiny::cached_temp
0000s0sPath::Tiny::::canonpath Path::Tiny::canonpath
0000s0sPath::Tiny::::child Path::Tiny::child
0000s0sPath::Tiny::::children Path::Tiny::children
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::::dirname Path::Tiny::dirname
0000s0sPath::Tiny::::edit Path::Tiny::edit
0000s0sPath::Tiny::::edit_lines Path::Tiny::edit_lines
0000s0sPath::Tiny::::edit_lines_raw Path::Tiny::edit_lines_raw
0000s0sPath::Tiny::::edit_lines_utf8 Path::Tiny::edit_lines_utf8
0000s0sPath::Tiny::::edit_raw Path::Tiny::edit_raw
0000s0sPath::Tiny::::edit_utf8 Path::Tiny::edit_utf8
0000s0sPath::Tiny::::exists Path::Tiny::exists
0000s0sPath::Tiny::::is_absolute Path::Tiny::is_absolute
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::::is_rootdir Path::Tiny::is_rootdir
0000s0sPath::Tiny::::iterator Path::Tiny::iterator
0000s0sPath::Tiny::::lines Path::Tiny::lines
0000s0sPath::Tiny::::lines_raw Path::Tiny::lines_raw
0000s0sPath::Tiny::::lines_utf8 Path::Tiny::lines_utf8
0000s0sPath::Tiny::::lstat Path::Tiny::lstat
0000s0sPath::Tiny::::mkpath Path::Tiny::mkpath
0000s0sPath::Tiny::::new Path::Tiny::new
0000s0sPath::Tiny::::parent Path::Tiny::parent
0000s0sPath::Tiny::::realpath Path::Tiny::realpath
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_utf8 Path::Tiny::slurp_utf8
0000s0sPath::Tiny::::spew_raw Path::Tiny::spew_raw
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::::visit Path::Tiny::visit
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
1253µs123µs
# spent 23µs within RBM::BEGIN@1 which was called: # once (23µs+0s) by RBM::BEGIN@5 at line 1
use 5.008001;
# spent 23µs making 1 call to RBM::BEGIN@1
2218µs211µs
# spent 8µs (6+3) within RBM::BEGIN@2 which was called: # once (6µs+3µs) by RBM::BEGIN@5 at line 2
use strict;
# spent 8µs making 1 call to RBM::BEGIN@2 # spent 3µs making 1 call to strict::import
3252µs239µs
# spent 22µs (6+17) within RBM::BEGIN@3.1 which was called: # once (6µs+17µs) by RBM::BEGIN@5 at line 3
use warnings;
# spent 22µs making 1 call to RBM::BEGIN@3.1 # spent 17µs making 1 call to warnings::import
4
5package Path::Tiny;
6# ABSTRACT: File path utility
7
81400nsour $VERSION = '0.108';
9
10# Dependencies
11235µs235µs
# spent 21µs (7+14) within Path::Tiny::BEGIN@11 which was called: # once (7µs+14µs) by RBM::BEGIN@5 at line 11
use Config;
# spent 21µs making 1 call to Path::Tiny::BEGIN@11 # spent 14µs making 1 call to Config::import
12338µs340µs
# spent 27µs (14+13) within Path::Tiny::BEGIN@12 which was called: # once (14µs+13µs) by RBM::BEGIN@5 at line 12
use Exporter 5.57 (qw/import/);
# spent 27µs making 1 call to Path::Tiny::BEGIN@12 # spent 7µs making 1 call to Exporter::import # spent 6µs making 1 call to UNIVERSAL::VERSION
133143µs27.42ms
# spent 7.41ms (2.04+5.37) within Path::Tiny::BEGIN@13 which was called: # once (2.04ms+5.37ms) by RBM::BEGIN@5 at line 13
use File::Spec 0.86 (); # shipped with 5.8.1
# spent 7.41ms making 1 call to Path::Tiny::BEGIN@13 # spent 12µs making 1 call to UNIVERSAL::VERSION
142152µs14.84ms
# spent 4.84ms (4.06+780µs) within Path::Tiny::BEGIN@14 which was called: # once (4.06ms+780µs) by RBM::BEGIN@5 at line 14
use Carp ();
# spent 4.84ms making 1 call to Path::Tiny::BEGIN@14
15
1611µsour @EXPORT = qw/path/;
1711µsour @EXPORT_OK = qw/cwd rootdir tempfile tempdir/;
18
19
# spent 114µs (11+103) within Path::Tiny::BEGIN@19 which was called: # once (11µs+103µs) by RBM::BEGIN@5 at line 27
use constant {
2019µs1103µs PATH => 0,
# spent 103µs making 1 call to constant::import
21 CANON => 1,
22 VOL => 2,
23 DIR => 3,
24 FILE => 4,
25 TEMP => 5,
26 IS_WIN32 => ( $^O eq 'MSWin32' ),
27163µs1114µs};
# spent 114µs making 1 call to Path::Tiny::BEGIN@19
28
29
# spent 1.19ms (1.10+94µs) within Path::Tiny::BEGIN@29 which was called: # once (1.10ms+94µs) by RBM::BEGIN@5 at line 33
use overload (
3032189µs
# spent 77µs within Path::Tiny::__ANON__[/usr/share/perl5/Path/Tiny.pm:30] which was called 32 times, avg 2µs/call: # 16 times (56µs+0s) by Path::Tiny::spew at line 1864, avg 4µs/call # 16 times (20µs+0s) by Path::Tiny::CORE:rename at line 1367, avg 1µs/call
q{""} => sub { $_[0]->[PATH] },
31 bool => sub () { 1 },
3216µs125µs fallback => 1,
# spent 25µs making 1 call to overload::import
331567µs11.19ms);
# spent 1.19ms making 1 call to Path::Tiny::BEGIN@29
34
35# FREEZE/THAW per Sereal/CBOR/Types::Serialiser protocol
36sub FREEZE { return $_[0]->[PATH] }
37sub THAW { return path( $_[2] ) }
384377µs231µs
# spent 18µs (6+12) within Path::Tiny::BEGIN@38 which was called: # once (6µs+12µs) by RBM::BEGIN@5 at line 38
{ no warnings 'once'; *TO_JSON = *FREEZE };
# spent 18µs making 1 call to Path::Tiny::BEGIN@38 # spent 12µs making 1 call to warnings::unimport
39
401100nsmy $HAS_UU; # has Unicode::UTF8; lazily populated
41
42
# spent 1.84ms (1.19+648µs) within Path::Tiny::_check_UU which was called: # once (1.19ms+648µs) by Path::Tiny::spew_utf8 at line 1875
sub _check_UU {
4312µs local $SIG{__DIE__}; # prevent outer handler from being called
4417µs !!eval {
4511.10ms require Unicode::UTF8;
46128µs117µs Unicode::UTF8->VERSION(0.58);
# spent 17µs making 1 call to UNIVERSAL::VERSION
471500ns 1;
48 };
49}
50
51my $HAS_PU; # has PerlIO::utf8_strict; lazily populated
52
53sub _check_PU {
54 local $SIG{__DIE__}; # prevent outer handler from being called
55 !!eval {
56 # MUST preload Encode or $SIG{__DIE__} localization fails
57 # on some Perl 5.8.8 (maybe other 5.8.*) compiled with -O2.
58 require Encode;
59 require PerlIO::utf8_strict;
60 PerlIO::utf8_strict->VERSION(0.003);
61 1;
62 };
63}
64
6518µs14.63msmy $HAS_FLOCK = $Config{d_flock} || $Config{d_fcntl_can_lock} || $Config{d_lockf};
# spent 4.63ms making 1 call to Config::FETCH
66
67# notions of "root" directories differ on Win32: \\server\dir\ or C:\ or \
6816µs12µsmy $SLASH = qr{[\\/]};
# spent 2µs making 1 call to Path::Tiny::CORE:qr
6913µs11µsmy $NOTSLASH = qr{[^\\/]};
# spent 1µs making 1 call to Path::Tiny::CORE:qr
7012µs1700nsmy $DRV_VOL = qr{[a-z]:}i;
# spent 700ns making 1 call to Path::Tiny::CORE:qr
71125µs220µsmy $UNC_VOL = qr{$SLASH $SLASH $NOTSLASH+ $SLASH $NOTSLASH+}x;
# spent 19µs making 1 call to Path::Tiny::CORE:regcomp # spent 500ns making 1 call to Path::Tiny::CORE:qr
72142µs236µsmy $WIN32_ROOT = qr{(?: $UNC_VOL $SLASH | $DRV_VOL $SLASH | $SLASH )}x;
# spent 36µs making 1 call to Path::Tiny::CORE:regcomp # spent 700ns making 1 call to Path::Tiny::CORE:qr
73
74sub _win32_vol {
75 my ( $path, $drv ) = @_;
76 require Cwd;
77 my $dcwd = eval { Cwd::getdcwd($drv) }; # C: -> C:\some\cwd
78 # getdcwd on non-existent drive returns empty string
79 # so just use the original drive Z: -> Z:
80 $dcwd = "$drv" unless defined $dcwd && length $dcwd;
81 # normalize dwcd to end with a slash: might be C:\some\cwd or D:\ or Z:
82 $dcwd =~ s{$SLASH?$}{/};
83 # make the path absolute with dcwd
84 $path =~ s{^$DRV_VOL}{$dcwd};
85 return $path;
86}
87
88# This is a string test for before we have the object; see is_rootdir for well-formed
89# object test
90
# spent 8.07ms within Path::Tiny::_is_root which was called 2025 times, avg 4µs/call: # 2025 times (8.07ms+0s) by Path::Tiny::path at line 254, avg 4µs/call
sub _is_root {
9120259.88ms return IS_WIN32() ? ( $_[0] =~ /^$WIN32_ROOT$/ ) : ( $_[0] eq '/' );
92}
93
94
# spent 6µs within Path::Tiny::BEGIN@94 which was called: # once (6µs+0s) by RBM::BEGIN@5 at line 96
BEGIN {
9516µs *_same = IS_WIN32() ? sub { lc( $_[0] ) eq lc( $_[1] ) } : sub { $_[0] eq $_[1] };
961233µs16µs}
# spent 6µs making 1 call to Path::Tiny::BEGIN@94
97
98# mode bits encoded for chmod in symbolic mode
9913µsmy %MODEBITS = ( om => 0007, gm => 0070, um => 0700 ); ## no critic
10039µs{ my $m = 0; $MODEBITS{$_} = ( 1 << $m++ ) for qw/ox ow or gx gw gr ux uw ur/ };
101
102sub _symbolic_chmod {
103 my ( $mode, $symbolic ) = @_;
104 for my $clause ( split /,\s*/, $symbolic ) {
105 if ( $clause =~ m{\A([augo]+)([=+-])([rwx]+)\z} ) {
106 my ( $who, $action, $perms ) = ( $1, $2, $3 );
107 $who =~ s/a/ugo/g;
108 for my $w ( split //, $who ) {
109 my $p = 0;
110 $p |= $MODEBITS{"$w$_"} for split //, $perms;
111 if ( $action eq '=' ) {
112 $mode = ( $mode & ~$MODEBITS{"${w}m"} ) | $p;
113 }
114 else {
115 $mode = $action eq "+" ? ( $mode | $p ) : ( $mode & ~$p );
116 }
117 }
118 }
119 else {
120 Carp::croak("Invalid mode clause '$clause' for chmod()");
121 }
122 }
123 return $mode;
124}
125
126# flock doesn't work on NFS on BSD or on some filesystems like lustre.
127# Since program authors often can't control or detect that, we warn once
128# instead of being fatal if we can detect it and people who need it strict
129# can fatalize the 'flock' category
130
131#<<< No perltidy
13224.52ms258µs
# spent 32µs (6+26) within flock::BEGIN@132 which was called: # once (6µs+26µs) by RBM::BEGIN@5 at line 132
{ package flock; use warnings::register }
# spent 32µs making 1 call to flock::BEGIN@132 # spent 26µs making 1 call to warnings::register::import
133#>>>
134
13521µsmy $WARNED_NO_FLOCK = 0;
136
137sub _throw {
138 my ( $self, $function, $file, $msg ) = @_;
139 if ( $function =~ /^flock/
140 && $! =~ /operation not supported|function not implemented/i
141 && !warnings::fatal_enabled('flock') )
142 {
143 if ( !$WARNED_NO_FLOCK ) {
144 warnings::warn( flock => "Flock not available: '$!': continuing in unsafe mode" );
145 $WARNED_NO_FLOCK++;
146 }
147 }
148 else {
149 $msg = $! unless defined $msg;
150 Path::Tiny::Error->throw( $function, ( defined $file ? $file : $self->[PATH] ),
151 $msg );
152 }
153 return;
154}
155
156# cheapo option validation
157
# spent 33.1ms within Path::Tiny::_get_args which was called 4019 times, avg 8µs/call: # 2009 times (8.31ms+0s) by Path::Tiny::filehandle at line 1027, avg 4µs/call # 1992 times (24.5ms+0s) by Path::Tiny::slurp at line 1788, avg 12µs/call # 16 times (200µs+0s) by Path::Tiny::spew at line 1855, avg 13µs/call # once (10µs+0s) by Path::Tiny::append_utf8 at line 565 # once (5µs+0s) by Path::Tiny::append at line 545
sub _get_args {
15840194.08ms my ( $raw, @valid ) = @_;
15940192.95ms if ( defined($raw) && ref($raw) ne 'HASH' ) {
160 my ( undef, undef, undef, $called_as ) = caller(1);
161 $called_as =~ s{^.*::}{};
162 Carp::croak("Options for $called_as must be a hash reference");
163 }
16440192.34ms my $cooked = {};
16540194.17ms for my $k (@valid) {
16660307.89ms $cooked->{$k} = delete $raw->{$k} if exists $raw->{$k};
167 }
16840193.00ms if ( keys %$raw ) {
169 my ( undef, undef, undef, $called_as ) = caller(1);
170 $called_as =~ s{^.*::}{};
171 Carp::croak( "Invalid option(s) for $called_as: " . join( ", ", keys %$raw ) );
172 }
173401915.2ms return $cooked;
174}
175
176#--------------------------------------------------------------------------#
177# Constructors
178#--------------------------------------------------------------------------#
179
180#pod =construct path
181#pod
182#pod $path = path("foo/bar");
183#pod $path = path("/tmp", "file.txt"); # list
184#pod $path = path("."); # cwd
185#pod $path = path("~user/file.txt"); # tilde processing
186#pod
187#pod Constructs a C<Path::Tiny> object. It doesn't matter if you give a file or
188#pod directory path. It's still up to you to call directory-like methods only on
189#pod directories and file-like methods only on files. This function is exported
190#pod automatically by default.
191#pod
192#pod The first argument must be defined and have non-zero length or an exception
193#pod will be thrown. This prevents subtle, dangerous errors with code like
194#pod C<< path( maybe_undef() )->remove_tree >>.
195#pod
196#pod If the first component of the path is a tilde ('~') then the component will be
197#pod replaced with the output of C<glob('~')>. If the first component of the path
198#pod is a tilde followed by a user name then the component will be replaced with
199#pod output of C<glob('~username')>. Behaviour for non-existent users depends on
200#pod the output of C<glob> on the system.
201#pod
202#pod On Windows, if the path consists of a drive identifier without a path component
203#pod (C<C:> or C<D:>), it will be expanded to the absolute path of the current
204#pod directory on that volume using C<Cwd::getdcwd()>.
205#pod
206#pod If called with a single C<Path::Tiny> argument, the original is returned unless
207#pod the original is holding a temporary file or directory reference in which case a
208#pod stringified copy is made.
209#pod
210#pod $path = path("foo/bar");
211#pod $temp = Path::Tiny->tempfile;
212#pod
213#pod $p2 = path($path); # like $p2 = $path
214#pod $t2 = path($temp); # like $t2 = path( "$temp" )
215#pod
216#pod This optimizes copies without proliferating references unexpectedly if a copy is
217#pod made by code outside your control.
218#pod
219#pod Current API available since 0.017.
220#pod
221#pod =cut
222
223
# spent 125ms (103+21.7) within Path::Tiny::path which was called 2025 times, avg 62µs/call: # 1992 times (102ms+21.6ms) by RBM::input_file_need_dl at line 718 of /root/tor-browser-build/rbm/lib/RBM.pm, avg 62µs/call # 16 times (153µs+36µs) by Path::Tiny::spew at line 1864, avg 12µs/call # 15 times (519µs+122µs) by RBM::run_script at line 466 of /root/tor-browser-build/rbm/lib/RBM.pm, avg 43µs/call # once (38µs+12µs) by RBM::build_run at line 1058 of /root/tor-browser-build/rbm/lib/RBM.pm # once (36µs+10µs) by RBM::build_run at line 1068 of /root/tor-browser-build/rbm/lib/RBM.pm
sub path {
22420252.04ms my $path = shift;
225 Carp::croak("Path::Tiny paths require defined, positive-length parts")
22620255.52ms unless 1 + @_ == grep { defined && length } $path, @_;
227
228 # non-temp Path::Tiny objects are effectively immutable and can be reused
22920252.53ms if ( !@_ && ref($path) eq __PACKAGE__ && !$path->[TEMP] ) {
230 return $path;
231 }
232
233 # stringify objects
23420251.31ms $path = "$path";
235
236 # expand relative volume paths on windows; put trailing slash on UNC root
237 if ( IS_WIN32() ) {
238 $path = _win32_vol( $path, $1 ) if $path =~ m{^($DRV_VOL)(?:$NOTSLASH|$)};
239 $path .= "/" if $path =~ m{^$UNC_VOL$};
240 }
241
242 # concatenations stringifies objects, too
24320251.48ms if (@_) {
244 $path .= ( _is_root($path) ? "" : "/" ) . join( "/", @_ );
245 }
246
247 # canonicalize, but with unix slashes and put back trailing volume slash
248202550.4ms20258.69ms my $cpath = $path = File::Spec->canonpath($path);
# spent 8.69ms making 2025 calls to File::Spec::Unix::canonpath, avg 4µs/call
249 $path =~ tr[\\][/] if IS_WIN32();
25020252.13ms $path = "/" if $path eq '/..'; # for old File::Spec
251 $path .= "/" if IS_WIN32() && $path =~ m{^$UNC_VOL$};
252
253 # root paths must always have a trailing slash, but other paths must not
25420258.49ms20258.07ms if ( _is_root($path) ) {
# spent 8.07ms making 2025 calls to Path::Tiny::_is_root, avg 4µs/call
255 $path =~ s{/?$}{/};
256 }
257 else {
258202511.4ms20253.04ms $path =~ s{/$}{};
# spent 3.04ms making 2025 calls to Path::Tiny::CORE:subst, avg 2µs/call
259 }
260
261 # do any tilde expansions
262202510.5ms20251.93ms if ( $path =~ m{^(~[^/]*).*} ) {
# spent 1.93ms making 2025 calls to Path::Tiny::CORE:match, avg 951ns/call
263 require File::Glob;
264 my ($homedir) = File::Glob::bsd_glob($1);
265 $homedir =~ tr[\\][/] if IS_WIN32();
266 $path =~ s{^(~[^/]*)}{$homedir};
267 }
268
269202519.5ms bless [ $path, $cpath ], __PACKAGE__;
270}
271
272#pod =construct new
273#pod
274#pod $path = Path::Tiny->new("foo/bar");
275#pod
276#pod This is just like C<path>, but with method call overhead. (Why would you
277#pod do that?)
278#pod
279#pod Current API available since 0.001.
280#pod
281#pod =cut
282
283sub new { shift; path(@_) }
284
285#pod =construct cwd
286#pod
287#pod $path = Path::Tiny->cwd; # path( Cwd::getcwd )
288#pod $path = cwd; # optional export
289#pod
290#pod Gives you the absolute path to the current directory as a C<Path::Tiny> object.
291#pod This is slightly faster than C<< path(".")->absolute >>.
292#pod
293#pod C<cwd> may be exported on request and used as a function instead of as a
294#pod method.
295#pod
296#pod Current API available since 0.018.
297#pod
298#pod =cut
299
300sub cwd {
301 require Cwd;
302 return path( Cwd::getcwd() );
303}
304
305#pod =construct rootdir
306#pod
307#pod $path = Path::Tiny->rootdir; # /
308#pod $path = rootdir; # optional export
309#pod
310#pod Gives you C<< File::Spec->rootdir >> as a C<Path::Tiny> object if you're too
311#pod picky for C<path("/")>.
312#pod
313#pod C<rootdir> may be exported on request and used as a function instead of as a
314#pod method.
315#pod
316#pod Current API available since 0.018.
317#pod
318#pod =cut
319
320sub rootdir { path( File::Spec->rootdir ) }
321
322#pod =construct tempfile, tempdir
323#pod
324#pod $temp = Path::Tiny->tempfile( @options );
325#pod $temp = Path::Tiny->tempdir( @options );
326#pod $temp = tempfile( @options ); # optional export
327#pod $temp = tempdir( @options ); # optional export
328#pod
329#pod C<tempfile> passes the options to C<< File::Temp->new >> and returns a C<Path::Tiny>
330#pod object with the file name. The C<TMPDIR> option is enabled by default.
331#pod
332#pod The resulting C<File::Temp> object is cached. When the C<Path::Tiny> object is
333#pod destroyed, the C<File::Temp> object will be as well.
334#pod
335#pod C<File::Temp> annoyingly requires you to specify a custom template in slightly
336#pod different ways depending on which function or method you call, but
337#pod C<Path::Tiny> lets you ignore that and can take either a leading template or a
338#pod C<TEMPLATE> option and does the right thing.
339#pod
340#pod $temp = Path::Tiny->tempfile( "customXXXXXXXX" ); # ok
341#pod $temp = Path::Tiny->tempfile( TEMPLATE => "customXXXXXXXX" ); # ok
342#pod
343#pod The tempfile path object will be normalized to have an absolute path, even if
344#pod created in a relative directory using C<DIR>. If you want it to have
345#pod the C<realpath> instead, pass a leading options hash like this:
346#pod
347#pod $real_temp = tempfile({realpath => 1}, @options);
348#pod
349#pod C<tempdir> is just like C<tempfile>, except it calls
350#pod C<< File::Temp->newdir >> instead.
351#pod
352#pod Both C<tempfile> and C<tempdir> may be exported on request and used as
353#pod functions instead of as methods.
354#pod
355#pod B<Note>: for tempfiles, the filehandles from File::Temp are closed and not
356#pod reused. This is not as secure as using File::Temp handles directly, but is
357#pod less prone to deadlocks or access problems on some platforms. Think of what
358#pod C<Path::Tiny> gives you to be just a temporary file B<name> that gets cleaned
359#pod up.
360#pod
361#pod B<Note 2>: if you don't want these cleaned up automatically when the object
362#pod is destroyed, File::Temp requires different options for directories and
363#pod files. Use C<< CLEANUP => 0 >> for directories and C<< UNLINK => 0 >> for
364#pod files.
365#pod
366#pod B<Note 3>: Don't lose the temporary object by chaining a method call instead
367#pod of storing it:
368#pod
369#pod my $lost = tempdir()->child("foo"); # tempdir cleaned up right away
370#pod
371#pod B<Note 4>: The cached object may be accessed with the L</cached_temp> method.
372#pod Keeping a reference to, or modifying the cached object may break the
373#pod behavior documented above and is not supported. Use at your own risk.
374#pod
375#pod Current API available since 0.097.
376#pod
377#pod =cut
378
379sub tempfile {
380 shift if @_ && $_[0] eq 'Path::Tiny'; # called as method
381 my $opts = ( @_ && ref $_[0] eq 'HASH' ) ? shift @_ : {};
382 $opts = _get_args( $opts, qw/realpath/ );
383
384 my ( $maybe_template, $args ) = _parse_file_temp_args(@_);
385 # File::Temp->new demands TEMPLATE
386 $args->{TEMPLATE} = $maybe_template->[0] if @$maybe_template;
387
388 require File::Temp;
389 my $temp = File::Temp->new( TMPDIR => 1, %$args );
390 close $temp;
391 my $self = $opts->{realpath} ? path($temp)->realpath : path($temp)->absolute;
392 $self->[TEMP] = $temp; # keep object alive while we are
393 return $self;
394}
395
396sub tempdir {
397 shift if @_ && $_[0] eq 'Path::Tiny'; # called as method
398 my $opts = ( @_ && ref $_[0] eq 'HASH' ) ? shift @_ : {};
399 $opts = _get_args( $opts, qw/realpath/ );
400
401 my ( $maybe_template, $args ) = _parse_file_temp_args(@_);
402
403 # File::Temp->newdir demands leading template
404 require File::Temp;
405 my $temp = File::Temp->newdir( @$maybe_template, TMPDIR => 1, %$args );
406 my $self = $opts->{realpath} ? path($temp)->realpath : path($temp)->absolute;
407 $self->[TEMP] = $temp; # keep object alive while we are
408 # Some ActiveState Perls for Windows break Cwd in ways that lead
409 # File::Temp to get confused about what path to remove; this
410 # monkey-patches the object with our own view of the absolute path
411 $temp->{REALNAME} = $self->[CANON] if IS_WIN32;
412 return $self;
413}
414
415# normalize the various ways File::Temp does templates
416sub _parse_file_temp_args {
417 my $leading_template = ( scalar(@_) % 2 == 1 ? shift(@_) : '' );
418 my %args = @_;
419 %args = map { uc($_), $args{$_} } keys %args;
420 my @template = (
421 exists $args{TEMPLATE} ? delete $args{TEMPLATE}
422 : $leading_template ? $leading_template
423 : ()
424 );
425 return ( \@template, \%args );
426}
427
428#--------------------------------------------------------------------------#
429# Private methods
430#--------------------------------------------------------------------------#
431
432sub _splitpath {
433 my ($self) = @_;
434 @{$self}[ VOL, DIR, FILE ] = File::Spec->splitpath( $self->[PATH] );
435}
436
437
# spent 294µs (191+103) within Path::Tiny::_resolve_symlinks which was called 16 times, avg 18µs/call: # 16 times (191µs+103µs) by Path::Tiny::spew at line 1862, avg 18µs/call
sub _resolve_symlinks {
4381612µs my ($self) = @_;
4391612µs my $new = $self;
4401622µs my ( $count, %seen ) = 0;
44116200µs16103µs while ( -l $new->[PATH] ) {
# spent 103µs making 16 calls to Path::Tiny::CORE:ftlink, avg 6µs/call
442 if ( $seen{ $new->[PATH] }++ ) {
443 $self->_throw( 'readlink', $self->[PATH], "symlink loop detected" );
444 }
445 if ( ++$count > 100 ) {
446 $self->_throw( 'readlink', $self->[PATH], "maximum symlink depth exceeded" );
447 }
448 my $resolved = readlink $new->[PATH] or $new->_throw( 'readlink', $new->[PATH] );
449 $resolved = path($resolved);
450 $new = $resolved->is_absolute ? $resolved : $new->sibling($resolved);
451 }
4521681µs return $new;
453}
454
455#--------------------------------------------------------------------------#
456# Public methods
457#--------------------------------------------------------------------------#
458
459#pod =method absolute
460#pod
461#pod $abs = path("foo/bar")->absolute;
462#pod $abs = path("foo/bar")->absolute("/tmp");
463#pod
464#pod Returns a new C<Path::Tiny> object with an absolute path (or itself if already
465#pod absolute). If no argument is given, the current directory is used as the
466#pod absolute base path. If an argument is given, it will be converted to an
467#pod absolute path (if it is not already) and used as the absolute base path.
468#pod
469#pod This will not resolve upward directories ("foo/../bar") unless C<canonpath>
470#pod in L<File::Spec> would normally do so on your platform. If you need them
471#pod resolved, you must call the more expensive C<realpath> method instead.
472#pod
473#pod On Windows, an absolute path without a volume component will have it added
474#pod based on the current drive.
475#pod
476#pod Current API available since 0.101.
477#pod
478#pod =cut
479
480sub absolute {
481 my ( $self, $base ) = @_;
482
483 # absolute paths handled differently by OS
484 if (IS_WIN32) {
485 return $self if length $self->volume;
486 # add missing volume
487 if ( $self->is_absolute ) {
488 require Cwd;
489 # use Win32::GetCwd not Cwd::getdcwd because we're sure
490 # to have the former but not necessarily the latter
491 my ($drv) = Win32::GetCwd() =~ /^($DRV_VOL | $UNC_VOL)/x;
492 return path( $drv . $self->[PATH] );
493 }
494 }
495 else {
496 return $self if $self->is_absolute;
497 }
498
499 # no base means use current directory as base
500 require Cwd;
501 return path( Cwd::getcwd(), $_[0]->[PATH] ) unless defined $base;
502
503 # relative base should be made absolute; we check is_absolute rather
504 # than unconditionally make base absolute so that "/foo" doesn't become
505 # "C:/foo" on Windows.
506 $base = path($base);
507 return path( ( $base->is_absolute ? $base : $base->absolute ), $_[0]->[PATH] );
508}
509
510#pod =method append, append_raw, append_utf8
511#pod
512#pod path("foo.txt")->append(@data);
513#pod path("foo.txt")->append(\@data);
514#pod path("foo.txt")->append({binmode => ":raw"}, @data);
515#pod path("foo.txt")->append_raw(@data);
516#pod path("foo.txt")->append_utf8(@data);
517#pod
518#pod Appends data to a file. The file is locked with C<flock> prior to writing
519#pod and closed afterwards. An optional hash reference may be used to pass
520#pod options. Valid options are:
521#pod
522#pod =for :list
523#pod * C<binmode>: passed to C<binmode()> on the handle used for writing.
524#pod * C<truncate>: truncates the file after locking and before appending
525#pod
526#pod The C<truncate> option is a way to replace the contents of a file
527#pod B<in place>, unlike L</spew> which writes to a temporary file and then
528#pod replaces the original (if it exists).
529#pod
530#pod C<append_raw> is like C<append> with a C<binmode> of C<:unix> for fast,
531#pod unbuffered, raw write.
532#pod
533#pod C<append_utf8> is like C<append> with a C<binmode> of
534#pod C<:unix:encoding(UTF-8)> (or L<PerlIO::utf8_strict>). If L<Unicode::UTF8>
535#pod 0.58+ is installed, a raw append will be done instead on the data encoded
536#pod with C<Unicode::UTF8>.
537#pod
538#pod Current API available since 0.060.
539#pod
540#pod =cut
541
542
# spent 198µs (43+155) within Path::Tiny::append which was called: # once (43µs+155µs) by Path::Tiny::append_utf8 at line 568
sub append {
54311µs my ( $self, @data ) = @_;
54411µs my $args = ( @data && ref $data[0] eq 'HASH' ) ? shift @data : {};
54512µs15µs $args = _get_args( $args, qw/binmode truncate/ );
# spent 5µs making 1 call to Path::Tiny::_get_args
54611µs my $binmode = $args->{binmode};
5471400ns $binmode = ( ( caller(0) )[10] || {} )->{'open>'} unless defined $binmode;
54812µs my $mode = $args->{truncate} ? ">" : ">>";
54915µs198µs my $fh = $self->filehandle( { locked => 1 }, $mode, $binmode );
# spent 98µs making 1 call to Path::Tiny::filehandle
550147µs140µs print {$fh} map { ref eq 'ARRAY' ? @$_ : $_ } @data;
# spent 40µs making 1 call to Path::Tiny::CORE:print
551131µs111µs close $fh or $self->_throw('close');
# spent 11µs making 1 call to Path::Tiny::CORE:close
552}
553
554sub append_raw {
555 my ( $self, @data ) = @_;
556 my $args = ( @data && ref $data[0] eq 'HASH' ) ? shift @data : {};
557 $args = _get_args( $args, qw/binmode truncate/ );
558 $args->{binmode} = ':unix';
559 append( $self, $args, @data );
560}
561
562
# spent 278µs (66+211) within Path::Tiny::append_utf8 which was called: # once (66µs+211µs) by RBM::build_run at line 1068 of /root/tor-browser-build/rbm/lib/RBM.pm
sub append_utf8 {
56311µs my ( $self, @data ) = @_;
56412µs my $args = ( @data && ref $data[0] eq 'HASH' ) ? shift @data : {};
56514µs110µs $args = _get_args( $args, qw/binmode truncate/ );
# spent 10µs making 1 call to Path::Tiny::_get_args
56617µs if ( defined($HAS_UU) ? $HAS_UU : ( $HAS_UU = _check_UU() ) ) {
56712µs $args->{binmode} = ":unix";
568218µs2201µs append( $self, $args, map { Unicode::UTF8::encode_utf8($_) } @data );
# spent 198µs making 1 call to Path::Tiny::append # spent 3µs making 1 call to Unicode::UTF8::encode_utf8
569 }
570 elsif ( defined($HAS_PU) ? $HAS_PU : ( $HAS_PU = _check_PU() ) ) {
571 $args->{binmode} = ":unix:utf8_strict";
572 append( $self, $args, @data );
573 }
574 else {
575 $args->{binmode} = ":unix:encoding(UTF-8)";
576 append( $self, $args, @data );
577 }
578}
579
580#pod =method assert
581#pod
582#pod $path = path("foo.txt")->assert( sub { $_->exists } );
583#pod
584#pod Returns the invocant after asserting that a code reference argument returns
585#pod true. When the assertion code reference runs, it will have the invocant
586#pod object in the C<$_> variable. If it returns false, an exception will be
587#pod thrown. The assertion code reference may also throw its own exception.
588#pod
589#pod If no assertion is provided, the invocant is returned without error.
590#pod
591#pod Current API available since 0.062.
592#pod
593#pod =cut
594
595sub assert {
596 my ( $self, $assertion ) = @_;
597 return $self unless $assertion;
598 if ( ref $assertion eq 'CODE' ) {
599 local $_ = $self;
600 $assertion->()
601 or Path::Tiny::Error->throw( "assert", $self->[PATH], "failed assertion" );
602 }
603 else {
604 Carp::croak("argument to assert must be a code reference argument");
605 }
606 return $self;
607}
608
609#pod =method basename
610#pod
611#pod $name = path("foo/bar.txt")->basename; # bar.txt
612#pod $name = path("foo.txt")->basename('.txt'); # foo
613#pod $name = path("foo.txt")->basename(qr/.txt/); # foo
614#pod $name = path("foo.txt")->basename(@suffixes);
615#pod
616#pod Returns the file portion or last directory portion of a path.
617#pod
618#pod Given a list of suffixes as strings or regular expressions, any that match at
619#pod the end of the file portion or last directory portion will be removed before
620#pod the result is returned.
621#pod
622#pod Current API available since 0.054.
623#pod
624#pod =cut
625
626sub basename {
627 my ( $self, @suffixes ) = @_;
628 $self->_splitpath unless defined $self->[FILE];
629 my $file = $self->[FILE];
630 for my $s (@suffixes) {
631 my $re = ref($s) eq 'Regexp' ? qr/$s$/ : qr/\Q$s\E$/;
632 last if $file =~ s/$re//;
633 }
634 return $file;
635}
636
637#pod =method canonpath
638#pod
639#pod $canonical = path("foo/bar")->canonpath; # foo\bar on Windows
640#pod
641#pod Returns a string with the canonical format of the path name for
642#pod the platform. In particular, this means directory separators
643#pod will be C<\> on Windows.
644#pod
645#pod Current API available since 0.001.
646#pod
647#pod =cut
648
649sub canonpath { $_[0]->[CANON] }
650
651#pod =method cached_temp
652#pod
653#pod Returns the cached C<File::Temp> or C<File::Temp::Dir> object if the
654#pod C<Path::Tiny> object was created with C</tempfile> or C</tempdir>.
655#pod If there is no such object, this method throws.
656#pod
657#pod B<WARNING>: Keeping a reference to, or modifying the cached object may
658#pod break the behavior documented for temporary files and directories created
659#pod with C<Path::Tiny> and is not supported. Use at your own risk.
660#pod
661#pod Current API available since 0.101.
662#pod
663#pod =cut
664
665sub cached_temp {
666 my $self = shift;
667 $self->_throw( "cached_temp", $self, "has no cached File::Temp object" )
668 unless defined $self->[TEMP];
669 return $self->[TEMP];
670}
671
672#pod =method child
673#pod
674#pod $file = path("/tmp")->child("foo.txt"); # "/tmp/foo.txt"
675#pod $file = path("/tmp")->child(@parts);
676#pod
677#pod Returns a new C<Path::Tiny> object relative to the original. Works
678#pod like C<catfile> or C<catdir> from File::Spec, but without caring about
679#pod file or directories.
680#pod
681#pod B<WARNING>: because the argument could contain C<..> or refer to symlinks,
682#pod there is no guarantee that the new path refers to an actual descendent of
683#pod the original. If this is important to you, transform parent and child with
684#pod L</realpath> and check them with L</subsumes>.
685#pod
686#pod Current API available since 0.001.
687#pod
688#pod =cut
689
690sub child {
691 my ( $self, @parts ) = @_;
692 return path( $self->[PATH], @parts );
693}
694
695#pod =method children
696#pod
697#pod @paths = path("/tmp")->children;
698#pod @paths = path("/tmp")->children( qr/\.txt$/ );
699#pod
700#pod Returns a list of C<Path::Tiny> objects for all files and directories
701#pod within a directory. Excludes "." and ".." automatically.
702#pod
703#pod If an optional C<qr//> argument is provided, it only returns objects for child
704#pod names that match the given regular expression. Only the base name is used
705#pod for matching:
706#pod
707#pod @paths = path("/tmp")->children( qr/^foo/ );
708#pod # matches children like the glob foo*
709#pod
710#pod Current API available since 0.028.
711#pod
712#pod =cut
713
714sub children {
715 my ( $self, $filter ) = @_;
716 my $dh;
717 opendir $dh, $self->[PATH] or $self->_throw('opendir');
718 my @children = readdir $dh;
719 closedir $dh or $self->_throw('closedir');
720
721 if ( not defined $filter ) {
722 @children = grep { $_ ne '.' && $_ ne '..' } @children;
723 }
724 elsif ( $filter && ref($filter) eq 'Regexp' ) {
725 @children = grep { $_ ne '.' && $_ ne '..' && $_ =~ $filter } @children;
726 }
727 else {
728 Carp::croak("Invalid argument '$filter' for children()");
729 }
730
731 return map { path( $self->[PATH], $_ ) } @children;
732}
733
734#pod =method chmod
735#pod
736#pod path("foo.txt")->chmod(0777);
737#pod path("foo.txt")->chmod("0755");
738#pod path("foo.txt")->chmod("go-w");
739#pod path("foo.txt")->chmod("a=r,u+wx");
740#pod
741#pod Sets file or directory permissions. The argument can be a numeric mode, a
742#pod octal string beginning with a "0" or a limited subset of the symbolic mode use
743#pod by F</bin/chmod>.
744#pod
745#pod The symbolic mode must be a comma-delimited list of mode clauses. Clauses must
746#pod match C<< qr/\A([augo]+)([=+-])([rwx]+)\z/ >>, which defines "who", "op" and
747#pod "perms" parameters for each clause. Unlike F</bin/chmod>, all three parameters
748#pod are required for each clause, multiple ops are not allowed and permissions
749#pod C<stugoX> are not supported. (See L<File::chmod> for more complex needs.)
750#pod
751#pod Current API available since 0.053.
752#pod
753#pod =cut
754
755sub chmod {
756 my ( $self, $new_mode ) = @_;
757
758 my $mode;
759 if ( $new_mode =~ /\d/ ) {
760 $mode = ( $new_mode =~ /^0/ ? oct($new_mode) : $new_mode );
761 }
762 elsif ( $new_mode =~ /[=+-]/ ) {
763 $mode = _symbolic_chmod( $self->stat->mode & 07777, $new_mode ); ## no critic
764 }
765 else {
766 Carp::croak("Invalid mode argument '$new_mode' for chmod()");
767 }
768
769 CORE::chmod( $mode, $self->[PATH] ) or $self->_throw("chmod");
770
771 return 1;
772}
773
774#pod =method copy
775#pod
776#pod path("/tmp/foo.txt")->copy("/tmp/bar.txt");
777#pod
778#pod Copies the current path to the given destination using L<File::Copy>'s
779#pod C<copy> function. Upon success, returns the C<Path::Tiny> object for the
780#pod newly copied file.
781#pod
782#pod Current API available since 0.070.
783#pod
784#pod =cut
785
786# XXX do recursively for directories?
787sub copy {
788 my ( $self, $dest ) = @_;
789 require File::Copy;
790 File::Copy::copy( $self->[PATH], $dest )
791 or Carp::croak("copy failed for $self to $dest: $!");
792
793 return -d $dest ? path( $dest, $self->basename ) : path($dest);
794}
795
796#pod =method digest
797#pod
798#pod $obj = path("/tmp/foo.txt")->digest; # SHA-256
799#pod $obj = path("/tmp/foo.txt")->digest("MD5"); # user-selected
800#pod $obj = path("/tmp/foo.txt")->digest( { chunk_size => 1e6 }, "MD5" );
801#pod
802#pod Returns a hexadecimal digest for a file. An optional hash reference of options may
803#pod be given. The only option is C<chunk_size>. If C<chunk_size> is given, that many
804#pod bytes will be read at a time. If not provided, the entire file will be slurped
805#pod into memory to compute the digest.
806#pod
807#pod Any subsequent arguments are passed to the constructor for L<Digest> to select
808#pod an algorithm. If no arguments are given, the default is SHA-256.
809#pod
810#pod Current API available since 0.056.
811#pod
812#pod =cut
813
814sub digest {
815 my ( $self, @opts ) = @_;
816 my $args = ( @opts && ref $opts[0] eq 'HASH' ) ? shift @opts : {};
817 $args = _get_args( $args, qw/chunk_size/ );
818 unshift @opts, 'SHA-256' unless @opts;
819 require Digest;
820 my $digest = Digest->new(@opts);
821 if ( $args->{chunk_size} ) {
822 my $fh = $self->filehandle( { locked => 1 }, "<", ":unix" );
823 my $buf;
824 $digest->add($buf) while read $fh, $buf, $args->{chunk_size};
825 }
826 else {
827 $digest->add( $self->slurp_raw );
828 }
829 return $digest->hexdigest;
830}
831
832#pod =method dirname (deprecated)
833#pod
834#pod $name = path("/tmp/foo.txt")->dirname; # "/tmp/"
835#pod
836#pod Returns the directory portion you would get from calling
837#pod C<< File::Spec->splitpath( $path->stringify ) >> or C<"."> for a path without a
838#pod parent directory portion. Because L<File::Spec> is inconsistent, the result
839#pod might or might not have a trailing slash. Because of this, this method is
840#pod B<deprecated>.
841#pod
842#pod A better, more consistently approach is likely C<< $path->parent->stringify >>,
843#pod which will not have a trailing slash except for a root directory.
844#pod
845#pod Deprecated in 0.056.
846#pod
847#pod =cut
848
849sub dirname {
850 my ($self) = @_;
851 $self->_splitpath unless defined $self->[DIR];
852 return length $self->[DIR] ? $self->[DIR] : ".";
853}
854
855#pod =method edit, edit_raw, edit_utf8
856#pod
857#pod path("foo.txt")->edit( \&callback, $options );
858#pod path("foo.txt")->edit_utf8( \&callback );
859#pod path("foo.txt")->edit_raw( \&callback );
860#pod
861#pod These are convenience methods that allow "editing" a file using a single
862#pod callback argument. They slurp the file using C<slurp>, place the contents
863#pod inside a localized C<$_> variable, call the callback function (without
864#pod arguments), and then write C<$_> (presumably mutated) back to the
865#pod file with C<spew>.
866#pod
867#pod An optional hash reference may be used to pass options. The only option is
868#pod C<binmode>, which is passed to C<slurp> and C<spew>.
869#pod
870#pod C<edit_utf8> and C<edit_raw> act like their respective C<slurp_*> and
871#pod C<spew_*> methods.
872#pod
873#pod Current API available since 0.077.
874#pod
875#pod =cut
876
877sub edit {
878 my $self = shift;
879 my $cb = shift;
880 my $args = _get_args( shift, qw/binmode/ );
881 Carp::croak("Callback for edit() must be a code reference")
882 unless defined($cb) && ref($cb) eq 'CODE';
883
884 local $_ =
885 $self->slurp( exists( $args->{binmode} ) ? { binmode => $args->{binmode} } : () );
886 $cb->();
887 $self->spew( $args, $_ );
888
889 return;
890}
891
892# this is done long-hand to benefit from slurp_utf8 optimizations
893sub edit_utf8 {
894 my ( $self, $cb ) = @_;
895 Carp::croak("Callback for edit_utf8() must be a code reference")
896 unless defined($cb) && ref($cb) eq 'CODE';
897
898 local $_ = $self->slurp_utf8;
899 $cb->();
900 $self->spew_utf8($_);
901
902 return;
903}
904
905sub edit_raw { $_[2] = { binmode => ":unix" }; goto &edit }
906
907#pod =method edit_lines, edit_lines_utf8, edit_lines_raw
908#pod
909#pod path("foo.txt")->edit_lines( \&callback, $options );
910#pod path("foo.txt")->edit_lines_utf8( \&callback );
911#pod path("foo.txt")->edit_lines_raw( \&callback );
912#pod
913#pod These are convenience methods that allow "editing" a file's lines using a
914#pod single callback argument. They iterate over the file: for each line, the
915#pod line is put into a localized C<$_> variable, the callback function is
916#pod executed (without arguments) and then C<$_> is written to a temporary file.
917#pod When iteration is finished, the temporary file is atomically renamed over
918#pod the original.
919#pod
920#pod An optional hash reference may be used to pass options. The only option is
921#pod C<binmode>, which is passed to the method that open handles for reading and
922#pod writing.
923#pod
924#pod C<edit_lines_utf8> and C<edit_lines_raw> act like their respective
925#pod C<slurp_*> and C<spew_*> methods.
926#pod
927#pod Current API available since 0.077.
928#pod
929#pod =cut
930
931sub edit_lines {
932 my $self = shift;
933 my $cb = shift;
934 my $args = _get_args( shift, qw/binmode/ );
935 Carp::croak("Callback for edit_lines() must be a code reference")
936 unless defined($cb) && ref($cb) eq 'CODE';
937
938 my $binmode = $args->{binmode};
939 # get default binmode from caller's lexical scope (see "perldoc open")
940 $binmode = ( ( caller(0) )[10] || {} )->{'open>'} unless defined $binmode;
941
942 # writing need to follow the link and create the tempfile in the same
943 # dir for later atomic rename
944 my $resolved_path = $self->_resolve_symlinks;
945 my $temp = path( $resolved_path . $$ . int( rand( 2**31 ) ) );
946
947 my $temp_fh = $temp->filehandle( { exclusive => 1, locked => 1 }, ">", $binmode );
948 my $in_fh = $self->filehandle( { locked => 1 }, '<', $binmode );
949
950 local $_;
951 while (<$in_fh>) {
952 $cb->();
953 $temp_fh->print($_);
954 }
955
956 close $temp_fh or $self->_throw( 'close', $temp );
957 close $in_fh or $self->_throw('close');
958
959 return $temp->move($resolved_path);
960}
961
962sub edit_lines_raw { $_[2] = { binmode => ":unix" }; goto &edit_lines }
963
964sub edit_lines_utf8 {
965 $_[2] = { binmode => ":raw:encoding(UTF-8)" };
966 goto &edit_lines;
967}
968
969#pod =method exists, is_file, is_dir
970#pod
971#pod if ( path("/tmp")->exists ) { ... } # -e
972#pod if ( path("/tmp")->is_dir ) { ... } # -d
973#pod if ( path("/tmp")->is_file ) { ... } # -e && ! -d
974#pod
975#pod Implements file test operations, this means the file or directory actually has
976#pod to exist on the filesystem. Until then, it's just a path.
977#pod
978#pod B<Note>: C<is_file> is not C<-f> because C<-f> is not the opposite of C<-d>.
979#pod C<-f> means "plain file", excluding symlinks, devices, etc. that often can be
980#pod read just like files.
981#pod
982#pod Use C<-f> instead if you really mean to check for a plain file.
983#pod
984#pod Current API available since 0.053.
985#pod
986#pod =cut
987
988sub exists { -e $_[0]->[PATH] }
989
990sub is_file { -e $_[0]->[PATH] && !-d _ }
991
992sub is_dir { -d $_[0]->[PATH] }
993
994#pod =method filehandle
995#pod
996#pod $fh = path("/tmp/foo.txt")->filehandle($mode, $binmode);
997#pod $fh = path("/tmp/foo.txt")->filehandle({ locked => 1 }, $mode, $binmode);
998#pod $fh = path("/tmp/foo.txt")->filehandle({ exclusive => 1 }, $mode, $binmode);
999#pod
1000#pod Returns an open file handle. The C<$mode> argument must be a Perl-style
1001#pod read/write mode string ("<" ,">", ">>", etc.). If a C<$binmode>
1002#pod is given, it is set during the C<open> call.
1003#pod
1004#pod An optional hash reference may be used to pass options.
1005#pod
1006#pod The C<locked> option governs file locking; if true, handles opened for writing,
1007#pod appending or read-write are locked with C<LOCK_EX>; otherwise, they are
1008#pod locked with C<LOCK_SH>. When using C<locked>, ">" or "+>" modes will delay
1009#pod truncation until after the lock is acquired.
1010#pod
1011#pod The C<exclusive> option causes the open() call to fail if the file already
1012#pod exists. This corresponds to the O_EXCL flag to sysopen / open(2).
1013#pod C<exclusive> implies C<locked> and will set it for you if you forget it.
1014#pod
1015#pod See C<openr>, C<openw>, C<openrw>, and C<opena> for sugar.
1016#pod
1017#pod Current API available since 0.066.
1018#pod
1019#pod =cut
1020
1021# Note: must put binmode on open line, not subsequent binmode() call, so things
1022# like ":unix" actually stop perlio/crlf from being added
1023
1024
# spent 252ms (99.6+152) within Path::Tiny::filehandle which was called 2009 times, avg 125µs/call: # 1992 times (97.4ms+151ms) by Path::Tiny::slurp at line 1791, avg 125µs/call # 16 times (2.16ms+1.27ms) by Path::Tiny::spew at line 1865, avg 215µs/call # once (46µs+53µs) by Path::Tiny::append at line 549
sub filehandle {
102520092.37ms my ( $self, @args ) = @_;
102620093.87ms my $args = ( @args && ref $args[0] eq 'HASH' ) ? shift @args : {};
102720093.18ms20098.31ms $args = _get_args( $args, qw/locked exclusive/ );
# spent 8.31ms making 2009 calls to Path::Tiny::_get_args, avg 4µs/call
102820092.43ms $args->{locked} = 1 if $args->{exclusive};
102920093.03ms my ( $opentype, $binmode ) = @args;
1030
103120091.47ms $opentype = "<" unless defined $opentype;
1032 Carp::croak("Invalid file mode '$opentype'")
103320095.45ms unless grep { $opentype eq $_ } qw/< +< > +> >> +>>/;
1034
103520091.57ms $binmode = ( ( caller(0) )[10] || {} )->{ 'open' . substr( $opentype, -1, 1 ) }
1036 unless defined $binmode;
103720091.92ms $binmode = "" unless defined $binmode;
1038
103920091000µs my ( $fh, $lock, $trunc );
104020095.00ms if ( $HAS_FLOCK && $args->{locked} && !$ENV{PERL_PATH_TINY_NO_FLOCK} ) {
104120091.78ms require Fcntl;
1042 # truncating file modes shouldn't truncate until lock acquired
104320098.20ms if ( grep { $opentype eq $_ } qw( > +> ) ) {
1044 # sysopen in write mode without truncation
104516194µs1624µs my $flags = $opentype eq ">" ? Fcntl::O_WRONLY() : Fcntl::O_RDWR();
# spent 24µs making 16 calls to Fcntl::O_WRONLY, avg 2µs/call
104616125µs1619µs $flags |= Fcntl::O_CREAT();
# spent 19µs making 16 calls to Fcntl::O_CREAT, avg 1µs/call
104716109µs1612µs $flags |= Fcntl::O_EXCL() if $args->{exclusive};
# spent 12µs making 16 calls to Fcntl::O_EXCL, avg 725ns/call
104816775µs16442µs sysopen( $fh, $self->[PATH], $flags ) or $self->_throw("sysopen");
# spent 442µs making 16 calls to Path::Tiny::CORE:sysopen, avg 28µs/call
1049
1050 # fix up the binmode since sysopen() can't specify layers like
1051 # open() and binmode() can't start with just :unix like open()
105216172µs1665µs if ( $binmode =~ s/^:unix// ) {
# spent 65µs making 16 calls to Path::Tiny::CORE:subst, avg 4µs/call
1053 # eliminate pseudo-layers
105416180µs1642µs binmode( $fh, ":raw" ) or $self->_throw("binmode (:raw)");
# spent 42µs making 16 calls to Path::Tiny::CORE:binmode, avg 3µs/call
1055 # strip off real layers until only :unix is left
105616421µs48133µs while ( 1 < ( my $layers =()= PerlIO::get_layers( $fh, output => 1 ) ) ) {
# spent 113µs making 32 calls to PerlIO::get_layers, avg 4µs/call # spent 20µs making 16 calls to Path::Tiny::CORE:binmode, avg 1µs/call
1057 binmode( $fh, ":pop" ) or $self->_throw("binmode (:pop)");
1058 }
1059 }
1060
1061 # apply any remaining binmode layers
10621617µs if ( length $binmode ) {
1063 binmode( $fh, $binmode ) or $self->_throw("binmode ($binmode)");
1064 }
1065
1066 # ask for lock and truncation
106716128µs1613µs $lock = Fcntl::LOCK_EX();
# spent 13µs making 16 calls to Fcntl::LOCK_EX, avg 812ns/call
10681613µs $trunc = 1;
1069 }
1070 elsif ( $^O eq 'aix' && $opentype eq "<" ) {
1071 # AIX can only lock write handles, so upgrade to RW and LOCK_EX if
1072 # the file is writable; otherwise give up on locking. N.B.
1073 # checking -w before open to determine the open mode is an
1074 # unavoidable race condition
1075 if ( -w $self->[PATH] ) {
1076 $opentype = "+<";
1077 $lock = Fcntl::LOCK_EX();
1078 }
1079 }
1080 else {
1081199312.3ms19933.01ms $lock = $opentype eq "<" ? Fcntl::LOCK_SH() : Fcntl::LOCK_EX();
# spent 3.01ms making 1992 calls to Fcntl::LOCK_SH, avg 2µs/call # spent 2µs making 1 call to Fcntl::LOCK_EX
1082 }
1083 }
1084
108520091.65ms unless ($fh) {
108619931.48ms my $mode = $opentype . $binmode;
10871993141ms1993123ms open $fh, $mode, $self->[PATH] or $self->_throw("open ($mode)");
# spent 123ms making 1993 calls to Path::Tiny::CORE:open, avg 61µs/call
1088 }
1089
1090200928.9ms200917.5ms do { flock( $fh, $lock ) or $self->_throw("flock ($lock)") } if $lock;
# spent 17.5ms making 2009 calls to Path::Tiny::CORE:flock, avg 9µs/call
109120091.57ms16290µs do { truncate( $fh, 0 ) or $self->_throw("truncate") } if $trunc;
# spent 290µs making 16 calls to Path::Tiny::CORE:truncate, avg 18µs/call
1092
1093200920.6ms return $fh;
1094}
1095
1096#pod =method is_absolute, is_relative
1097#pod
1098#pod if ( path("/tmp")->is_absolute ) { ... }
1099#pod if ( path("/tmp")->is_relative ) { ... }
1100#pod
1101#pod Booleans for whether the path appears absolute or relative.
1102#pod
1103#pod Current API available since 0.001.
1104#pod
1105#pod =cut
1106
1107sub is_absolute { substr( $_[0]->dirname, 0, 1 ) eq '/' }
1108
1109sub is_relative { substr( $_[0]->dirname, 0, 1 ) ne '/' }
1110
1111#pod =method is_rootdir
1112#pod
1113#pod while ( ! $path->is_rootdir ) {
1114#pod $path = $path->parent;
1115#pod ...
1116#pod }
1117#pod
1118#pod Boolean for whether the path is the root directory of the volume. I.e. the
1119#pod C<dirname> is C<q[/]> and the C<basename> is C<q[]>.
1120#pod
1121#pod This works even on C<MSWin32> with drives and UNC volumes:
1122#pod
1123#pod path("C:/")->is_rootdir; # true
1124#pod path("//server/share/")->is_rootdir; #true
1125#pod
1126#pod Current API available since 0.038.
1127#pod
1128#pod =cut
1129
1130sub is_rootdir {
1131 my ($self) = @_;
1132 $self->_splitpath unless defined $self->[DIR];
1133 return $self->[DIR] eq '/' && $self->[FILE] eq '';
1134}
1135
1136#pod =method iterator
1137#pod
1138#pod $iter = path("/tmp")->iterator( \%options );
1139#pod
1140#pod Returns a code reference that walks a directory lazily. Each invocation
1141#pod returns a C<Path::Tiny> object or undef when the iterator is exhausted.
1142#pod
1143#pod $iter = path("/tmp")->iterator;
1144#pod while ( $path = $iter->() ) {
1145#pod ...
1146#pod }
1147#pod
1148#pod The current and parent directory entries ("." and "..") will not
1149#pod be included.
1150#pod
1151#pod If the C<recurse> option is true, the iterator will walk the directory
1152#pod recursively, breadth-first. If the C<follow_symlinks> option is also true,
1153#pod directory links will be followed recursively. There is no protection against
1154#pod loops when following links. If a directory is not readable, it will not be
1155#pod followed.
1156#pod
1157#pod The default is the same as:
1158#pod
1159#pod $iter = path("/tmp")->iterator( {
1160#pod recurse => 0,
1161#pod follow_symlinks => 0,
1162#pod } );
1163#pod
1164#pod For a more powerful, recursive iterator with built-in loop avoidance, see
1165#pod L<Path::Iterator::Rule>.
1166#pod
1167#pod See also L</visit>.
1168#pod
1169#pod Current API available since 0.016.
1170#pod
1171#pod =cut
1172
1173sub iterator {
1174 my $self = shift;
1175 my $args = _get_args( shift, qw/recurse follow_symlinks/ );
1176 my @dirs = $self;
1177 my $current;
1178 return sub {
1179 my $next;
1180 while (@dirs) {
1181 if ( ref $dirs[0] eq 'Path::Tiny' ) {
1182 if ( !-r $dirs[0] ) {
1183 # Directory is missing or not readable, so skip it. There
1184 # is still a race condition possible between the check and
1185 # the opendir, but we can't easily differentiate between
1186 # error cases that are OK to skip and those that we want
1187 # to be exceptions, so we live with the race and let opendir
1188 # be fatal.
1189 shift @dirs and next;
1190 }
1191 $current = $dirs[0];
1192 my $dh;
1193 opendir( $dh, $current->[PATH] )
1194 or $self->_throw( 'opendir', $current->[PATH] );
1195 $dirs[0] = $dh;
1196 if ( -l $current->[PATH] && !$args->{follow_symlinks} ) {
1197 # Symlink attack! It was a real dir, but is now a symlink!
1198 # N.B. we check *after* opendir so the attacker has to win
1199 # two races: replace dir with symlink before opendir and
1200 # replace symlink with dir before -l check above
1201 shift @dirs and next;
1202 }
1203 }
1204 while ( defined( $next = readdir $dirs[0] ) ) {
1205 next if $next eq '.' || $next eq '..';
1206 my $path = $current->child($next);
1207 push @dirs, $path
1208 if $args->{recurse} && -d $path && !( !$args->{follow_symlinks} && -l $path );
1209 return $path;
1210 }
1211 shift @dirs;
1212 }
1213 return;
1214 };
1215}
1216
1217#pod =method lines, lines_raw, lines_utf8
1218#pod
1219#pod @contents = path("/tmp/foo.txt")->lines;
1220#pod @contents = path("/tmp/foo.txt")->lines(\%options);
1221#pod @contents = path("/tmp/foo.txt")->lines_raw;
1222#pod @contents = path("/tmp/foo.txt")->lines_utf8;
1223#pod
1224#pod @contents = path("/tmp/foo.txt")->lines( { chomp => 1, count => 4 } );
1225#pod
1226#pod Returns a list of lines from a file. Optionally takes a hash-reference of
1227#pod options. Valid options are C<binmode>, C<count> and C<chomp>.
1228#pod
1229#pod If C<binmode> is provided, it will be set on the handle prior to reading.
1230#pod
1231#pod If a positive C<count> is provided, that many lines will be returned from the
1232#pod start of the file. If a negative C<count> is provided, the entire file will be
1233#pod read, but only C<abs(count)> will be kept and returned. If C<abs(count)>
1234#pod exceeds the number of lines in the file, all lines will be returned.
1235#pod
1236#pod If C<chomp> is set, any end-of-line character sequences (C<CR>, C<CRLF>, or
1237#pod C<LF>) will be removed from the lines returned.
1238#pod
1239#pod Because the return is a list, C<lines> in scalar context will return the number
1240#pod of lines (and throw away the data).
1241#pod
1242#pod $number_of_lines = path("/tmp/foo.txt")->lines;
1243#pod
1244#pod C<lines_raw> is like C<lines> with a C<binmode> of C<:raw>. We use C<:raw>
1245#pod instead of C<:unix> so PerlIO buffering can manage reading by line.
1246#pod
1247#pod C<lines_utf8> is like C<lines> with a C<binmode> of C<:raw:encoding(UTF-8)>
1248#pod (or L<PerlIO::utf8_strict>). If L<Unicode::UTF8> 0.58+ is installed, a raw
1249#pod UTF-8 slurp will be done and then the lines will be split. This is
1250#pod actually faster than relying on C<:encoding(UTF-8)>, though a bit memory
1251#pod intensive. If memory use is a concern, consider C<openr_utf8> and
1252#pod iterating directly on the handle.
1253#pod
1254#pod Current API available since 0.065.
1255#pod
1256#pod =cut
1257
1258sub lines {
1259 my $self = shift;
1260 my $args = _get_args( shift, qw/binmode chomp count/ );
1261 my $binmode = $args->{binmode};
1262 $binmode = ( ( caller(0) )[10] || {} )->{'open<'} unless defined $binmode;
1263 my $fh = $self->filehandle( { locked => 1 }, "<", $binmode );
1264 my $chomp = $args->{chomp};
1265 # XXX more efficient to read @lines then chomp(@lines) vs map?
1266 if ( $args->{count} ) {
1267 my ( $counter, $mod, @result ) = ( 0, abs( $args->{count} ) );
1268 while ( my $line = <$fh> ) {
1269 $line =~ s/(?:\x{0d}?\x{0a}|\x{0d})$// if $chomp;
1270 $result[ $counter++ ] = $line;
1271 # for positive count, terminate after right number of lines
1272 last if $counter == $args->{count};
1273 # for negative count, eventually wrap around in the result array
1274 $counter %= $mod;
1275 }
1276 # reorder results if full and wrapped somewhere in the middle
1277 splice( @result, 0, 0, splice( @result, $counter ) )
1278 if @result == $mod && $counter % $mod;
1279 return @result;
1280 }
1281 elsif ($chomp) {
1282 return map { s/(?:\x{0d}?\x{0a}|\x{0d})$//; $_ } <$fh>; ## no critic
1283 }
1284 else {
1285 return wantarray ? <$fh> : ( my $count =()= <$fh> );
1286 }
1287}
1288
1289sub lines_raw {
1290 my $self = shift;
1291 my $args = _get_args( shift, qw/binmode chomp count/ );
1292 if ( $args->{chomp} && !$args->{count} ) {
1293 return split /\n/, slurp_raw($self); ## no critic
1294 }
1295 else {
1296 $args->{binmode} = ":raw";
1297 return lines( $self, $args );
1298 }
1299}
1300
130113µs11µsmy $CRLF = qr/(?:\x{0d}?\x{0a}|\x{0d})/;
# spent 1µs making 1 call to Path::Tiny::CORE:qr
1302
1303sub lines_utf8 {
1304 my $self = shift;
1305 my $args = _get_args( shift, qw/binmode chomp count/ );
1306 if ( ( defined($HAS_UU) ? $HAS_UU : ( $HAS_UU = _check_UU() ) )
1307 && $args->{chomp}
1308 && !$args->{count} )
1309 {
1310 my $slurp = slurp_utf8($self);
1311 $slurp =~ s/$CRLF$//; # like chomp, but full CR?LF|CR
1312 return split $CRLF, $slurp, -1; ## no critic
1313 }
1314 elsif ( defined($HAS_PU) ? $HAS_PU : ( $HAS_PU = _check_PU() ) ) {
1315 $args->{binmode} = ":unix:utf8_strict";
1316 return lines( $self, $args );
1317 }
1318 else {
1319 $args->{binmode} = ":raw:encoding(UTF-8)";
1320 return lines( $self, $args );
1321 }
1322}
1323
1324#pod =method mkpath
1325#pod
1326#pod path("foo/bar/baz")->mkpath;
1327#pod path("foo/bar/baz")->mkpath( \%options );
1328#pod
1329#pod Like calling C<make_path> from L<File::Path>. An optional hash reference
1330#pod is passed through to C<make_path>. Errors will be trapped and an exception
1331#pod thrown. Returns the list of directories created or an empty list if
1332#pod the directories already exist, just like C<make_path>.
1333#pod
1334#pod Current API available since 0.001.
1335#pod
1336#pod =cut
1337
1338sub mkpath {
1339 my ( $self, $args ) = @_;
1340 $args = {} unless ref $args eq 'HASH';
1341 my $err;
1342 $args->{error} = \$err unless defined $args->{error};
1343 require File::Path;
1344 my @dirs = File::Path::make_path( $self->[PATH], $args );
1345 if ( $err && @$err ) {
1346 my ( $file, $message ) = %{ $err->[0] };
1347 Carp::croak("mkpath failed for $file: $message");
1348 }
1349 return @dirs;
1350}
1351
1352#pod =method move
1353#pod
1354#pod path("foo.txt")->move("bar.txt");
1355#pod
1356#pod Move the current path to the given destination path using Perl's
1357#pod built-in L<rename|perlfunc/rename> function. Returns the result
1358#pod of the C<rename> function (except it throws an exception if it fails).
1359#pod
1360#pod Current API available since 0.001.
1361#pod
1362#pod =cut
1363
1364
# spent 879µs (265+614) within Path::Tiny::move which was called 16 times, avg 55µs/call: # 16 times (265µs+614µs) by Path::Tiny::spew at line 1869, avg 55µs/call
sub move {
13651613µs my ( $self, $dst ) = @_;
1366
136716806µs32634µs return rename( $self->[PATH], $dst )
# spent 614µs making 16 calls to Path::Tiny::CORE:rename, avg 38µs/call # spent 20µs making 16 calls to Path::Tiny::__ANON__[Path/Tiny.pm:30], avg 1µs/call
1368 || $self->_throw( 'rename', $self->[PATH] . "' -> '$dst" );
1369}
1370
1371#pod =method openr, openw, openrw, opena
1372#pod
1373#pod $fh = path("foo.txt")->openr($binmode); # read
1374#pod $fh = path("foo.txt")->openr_raw;
1375#pod $fh = path("foo.txt")->openr_utf8;
1376#pod
1377#pod $fh = path("foo.txt")->openw($binmode); # write
1378#pod $fh = path("foo.txt")->openw_raw;
1379#pod $fh = path("foo.txt")->openw_utf8;
1380#pod
1381#pod $fh = path("foo.txt")->opena($binmode); # append
1382#pod $fh = path("foo.txt")->opena_raw;
1383#pod $fh = path("foo.txt")->opena_utf8;
1384#pod
1385#pod $fh = path("foo.txt")->openrw($binmode); # read/write
1386#pod $fh = path("foo.txt")->openrw_raw;
1387#pod $fh = path("foo.txt")->openrw_utf8;
1388#pod
1389#pod Returns a file handle opened in the specified mode. The C<openr> style methods
1390#pod take a single C<binmode> argument. All of the C<open*> methods have
1391#pod C<open*_raw> and C<open*_utf8> equivalents that use C<:raw> and
1392#pod C<:raw:encoding(UTF-8)>, respectively.
1393#pod
1394#pod An optional hash reference may be used to pass options. The only option is
1395#pod C<locked>. If true, handles opened for writing, appending or read-write are
1396#pod locked with C<LOCK_EX>; otherwise, they are locked for C<LOCK_SH>.
1397#pod
1398#pod $fh = path("foo.txt")->openrw_utf8( { locked => 1 } );
1399#pod
1400#pod See L</filehandle> for more on locking.
1401#pod
1402#pod Current API available since 0.011.
1403#pod
1404#pod =cut
1405
1406# map method names to corresponding open mode
140714µsmy %opens = (
1408 opena => ">>",
1409 openr => "<",
1410 openw => ">",
1411 openrw => "+<"
1412);
1413
141416µswhile ( my ( $k, $v ) = each %opens ) {
141522.54ms248µs
# spent 29µs (10+19) within Path::Tiny::BEGIN@1415 which was called: # once (10µs+19µs) by RBM::BEGIN@5 at line 1415
no strict 'refs';
# spent 29µs making 1 call to Path::Tiny::BEGIN@1415 # spent 19µs making 1 call to strict::unimport
1416 # must check for lexical IO mode hint
1417 *{$k} = sub {
1418 my ( $self, @args ) = @_;
1419 my $args = ( @args && ref $args[0] eq 'HASH' ) ? shift @args : {};
1420 $args = _get_args( $args, qw/locked/ );
1421 my ($binmode) = @args;
1422 $binmode = ( ( caller(0) )[10] || {} )->{ 'open' . substr( $v, -1, 1 ) }
1423 unless defined $binmode;
1424 $self->filehandle( $args, $v, $binmode );
1425411µs };
1426 *{ $k . "_raw" } = sub {
1427 my ( $self, @args ) = @_;
1428 my $args = ( @args && ref $args[0] eq 'HASH' ) ? shift @args : {};
1429 $args = _get_args( $args, qw/locked/ );
1430 $self->filehandle( $args, $v, ":raw" );
1431410µs };
1432 *{ $k . "_utf8" } = sub {
1433 my ( $self, @args ) = @_;
1434 my $args = ( @args && ref $args[0] eq 'HASH' ) ? shift @args : {};
1435 $args = _get_args( $args, qw/locked/ );
1436 $self->filehandle( $args, $v, ":raw:encoding(UTF-8)" );
143749µs };
1438}
1439
1440#pod =method parent
1441#pod
1442#pod $parent = path("foo/bar/baz")->parent; # foo/bar
1443#pod $parent = path("foo/wibble.txt")->parent; # foo
1444#pod
1445#pod $parent = path("foo/bar/baz")->parent(2); # foo
1446#pod
1447#pod Returns a C<Path::Tiny> object corresponding to the parent directory of the
1448#pod original directory or file. An optional positive integer argument is the number
1449#pod of parent directories upwards to return. C<parent> by itself is equivalent to
1450#pod C<parent(1)>.
1451#pod
1452#pod Current API available since 0.014.
1453#pod
1454#pod =cut
1455
1456# XXX this is ugly and coverage is incomplete. I think it's there for windows
1457# so need to check coverage there and compare
1458sub parent {
1459 my ( $self, $level ) = @_;
1460 $level = 1 unless defined $level && $level > 0;
1461 $self->_splitpath unless defined $self->[FILE];
1462 my $parent;
1463 if ( length $self->[FILE] ) {
1464 if ( $self->[FILE] eq '.' || $self->[FILE] eq ".." ) {
1465 $parent = path( $self->[PATH] . "/.." );
1466 }
1467 else {
1468 $parent = path( _non_empty( $self->[VOL] . $self->[DIR] ) );
1469 }
1470 }
1471 elsif ( length $self->[DIR] ) {
1472 # because of symlinks, any internal updir requires us to
1473 # just add more updirs at the end
1474 if ( $self->[DIR] =~ m{(?:^\.\./|/\.\./|/\.\.$)} ) {
1475 $parent = path( $self->[VOL] . $self->[DIR] . "/.." );
1476 }
1477 else {
1478 ( my $dir = $self->[DIR] ) =~ s{/[^\/]+/$}{/};
1479 $parent = path( $self->[VOL] . $dir );
1480 }
1481 }
1482 else {
1483 $parent = path( _non_empty( $self->[VOL] ) );
1484 }
1485 return $level == 1 ? $parent : $parent->parent( $level - 1 );
1486}
1487
1488sub _non_empty {
1489 my ($string) = shift;
1490 return ( ( defined($string) && length($string) ) ? $string : "." );
1491}
1492
1493#pod =method realpath
1494#pod
1495#pod $real = path("/baz/foo/../bar")->realpath;
1496#pod $real = path("foo/../bar")->realpath;
1497#pod
1498#pod Returns a new C<Path::Tiny> object with all symbolic links and upward directory
1499#pod parts resolved using L<Cwd>'s C<realpath>. Compared to C<absolute>, this is
1500#pod more expensive as it must actually consult the filesystem.
1501#pod
1502#pod If the parent path can't be resolved (e.g. if it includes directories that
1503#pod don't exist), an exception will be thrown:
1504#pod
1505#pod $real = path("doesnt_exist/foo")->realpath; # dies
1506#pod
1507#pod However, if the parent path exists and only the last component (e.g. filename)
1508#pod doesn't exist, the realpath will be the realpath of the parent plus the
1509#pod non-existent last component:
1510#pod
1511#pod $real = path("./aasdlfasdlf")->realpath; # works
1512#pod
1513#pod The underlying L<Cwd> module usually worked this way on Unix, but died on
1514#pod Windows (and some Unixes) if the full path didn't exist. As of version 0.064,
1515#pod it's safe to use anywhere.
1516#pod
1517#pod Current API available since 0.001.
1518#pod
1519#pod =cut
1520
1521# Win32 and some Unixes need parent path resolved separately so realpath
1522# doesn't throw an error resolving non-existent basename
1523sub realpath {
1524 my $self = shift;
1525 $self = $self->_resolve_symlinks;
1526 require Cwd;
1527 $self->_splitpath if !defined $self->[FILE];
1528 my $check_parent =
1529 length $self->[FILE] && $self->[FILE] ne '.' && $self->[FILE] ne '..';
1530 my $realpath = eval {
1531 # pure-perl Cwd can carp
1532 local $SIG{__WARN__} = sub { };
1533 Cwd::realpath( $check_parent ? $self->parent->[PATH] : $self->[PATH] );
1534 };
1535 # parent realpath must exist; not all Cwd::realpath will error if it doesn't
1536 $self->_throw("resolving realpath")
1537 unless defined $realpath && length $realpath && -e $realpath;
1538 return ( $check_parent ? path( $realpath, $self->[FILE] ) : path($realpath) );
1539}
1540
1541#pod =method relative
1542#pod
1543#pod $rel = path("/tmp/foo/bar")->relative("/tmp"); # foo/bar
1544#pod
1545#pod Returns a C<Path::Tiny> object with a path relative to a new base path
1546#pod given as an argument. If no argument is given, the current directory will
1547#pod be used as the new base path.
1548#pod
1549#pod If either path is already relative, it will be made absolute based on the
1550#pod current directly before determining the new relative path.
1551#pod
1552#pod The algorithm is roughly as follows:
1553#pod
1554#pod =for :list
1555#pod * If the original and new base path are on different volumes, an exception
1556#pod will be thrown.
1557#pod * If the original and new base are identical, the relative path is C<".">.
1558#pod * If the new base subsumes the original, the relative path is the original
1559#pod path with the new base chopped off the front
1560#pod * If the new base does not subsume the original, a common prefix path is
1561#pod determined (possibly the root directory) and the relative path will
1562#pod consist of updirs (C<"..">) to reach the common prefix, followed by the
1563#pod original path less the common prefix.
1564#pod
1565#pod Unlike C<File::Spec::abs2rel>, in the last case above, the calculation based
1566#pod on a common prefix takes into account symlinks that could affect the updir
1567#pod process. Given an original path "/A/B" and a new base "/A/C",
1568#pod (where "A", "B" and "C" could each have multiple path components):
1569#pod
1570#pod =for :list
1571#pod * Symlinks in "A" don't change the result unless the last component of A is
1572#pod a symlink and the first component of "C" is an updir.
1573#pod * Symlinks in "B" don't change the result and will exist in the result as
1574#pod given.
1575#pod * Symlinks and updirs in "C" must be resolved to actual paths, taking into
1576#pod account the possibility that not all path components might exist on the
1577#pod filesystem.
1578#pod
1579#pod Current API available since 0.001. New algorithm (that accounts for
1580#pod symlinks) available since 0.079.
1581#pod
1582#pod =cut
1583
1584sub relative {
1585 my ( $self, $base ) = @_;
1586 $base = path( defined $base && length $base ? $base : '.' );
1587
1588 # relative paths must be converted to absolute first
1589 $self = $self->absolute if $self->is_relative;
1590 $base = $base->absolute if $base->is_relative;
1591
1592 # normalize volumes if they exist
1593 $self = $self->absolute if !length $self->volume && length $base->volume;
1594 $base = $base->absolute if length $self->volume && !length $base->volume;
1595
1596 # can't make paths relative across volumes
1597 if ( !_same( $self->volume, $base->volume ) ) {
1598 Carp::croak("relative() can't cross volumes: '$self' vs '$base'");
1599 }
1600
1601 # if same absolute path, relative is current directory
1602 return path(".") if _same( $self->[PATH], $base->[PATH] );
1603
1604 # if base is a prefix of self, chop prefix off self
1605 if ( $base->subsumes($self) ) {
1606 $base = "" if $base->is_rootdir;
1607 my $relative = "$self";
1608 $relative =~ s{\A\Q$base/}{};
1609 return path($relative);
1610 }
1611
1612 # base is not a prefix, so must find a common prefix (even if root)
1613 my ( @common, @self_parts, @base_parts );
1614 @base_parts = split /\//, $base->_just_filepath;
1615
1616 # if self is rootdir, then common directory is root (shown as empty
1617 # string for later joins); otherwise, must be computed from path parts.
1618 if ( $self->is_rootdir ) {
1619 @common = ("");
1620 shift @base_parts;
1621 }
1622 else {
1623 @self_parts = split /\//, $self->_just_filepath;
1624
1625 while ( @self_parts && @base_parts && _same( $self_parts[0], $base_parts[0] ) ) {
1626 push @common, shift @base_parts;
1627 shift @self_parts;
1628 }
1629 }
1630
1631 # if there are any symlinks from common to base, we have a problem, as
1632 # you can't guarantee that updir from base reaches the common prefix;
1633 # we must resolve symlinks and try again; likewise, any updirs are
1634 # a problem as it throws off calculation of updirs needed to get from
1635 # self's path to the common prefix.
1636 if ( my $new_base = $self->_resolve_between( \@common, \@base_parts ) ) {
1637 return $self->relative($new_base);
1638 }
1639
1640 # otherwise, symlinks in common or from common to A don't matter as
1641 # those don't involve updirs
1642 my @new_path = ( ("..") x ( 0+ @base_parts ), @self_parts );
1643 return path(@new_path);
1644}
1645
1646sub _just_filepath {
1647 my $self = shift;
1648 my $self_vol = $self->volume;
1649 return "$self" if !length $self_vol;
1650
1651 ( my $self_path = "$self" ) =~ s{\A\Q$self_vol}{};
1652
1653 return $self_path;
1654}
1655
1656sub _resolve_between {
1657 my ( $self, $common, $base ) = @_;
1658 my $path = $self->volume . join( "/", @$common );
1659 my $changed = 0;
1660 for my $p (@$base) {
1661 $path .= "/$p";
1662 if ( $p eq '..' ) {
1663 $changed = 1;
1664 if ( -e $path ) {
1665 $path = path($path)->realpath->[PATH];
1666 }
1667 else {
1668 $path =~ s{/[^/]+/..$}{/};
1669 }
1670 }
1671 if ( -l $path ) {
1672 $changed = 1;
1673 $path = path($path)->realpath->[PATH];
1674 }
1675 }
1676 return $changed ? path($path) : undef;
1677}
1678
1679#pod =method remove
1680#pod
1681#pod path("foo.txt")->remove;
1682#pod
1683#pod This is just like C<unlink>, except for its error handling: if the path does
1684#pod not exist, it returns false; if deleting the file fails, it throws an
1685#pod exception.
1686#pod
1687#pod Current API available since 0.012.
1688#pod
1689#pod =cut
1690
1691sub remove {
1692 my $self = shift;
1693
1694 return 0 if !-e $self->[PATH] && !-l $self->[PATH];
1695
1696 return unlink( $self->[PATH] ) || $self->_throw('unlink');
1697}
1698
1699#pod =method remove_tree
1700#pod
1701#pod # directory
1702#pod path("foo/bar/baz")->remove_tree;
1703#pod path("foo/bar/baz")->remove_tree( \%options );
1704#pod path("foo/bar/baz")->remove_tree( { safe => 0 } ); # force remove
1705#pod
1706#pod Like calling C<remove_tree> from L<File::Path>, but defaults to C<safe> mode.
1707#pod An optional hash reference is passed through to C<remove_tree>. Errors will be
1708#pod trapped and an exception thrown. Returns the number of directories deleted,
1709#pod just like C<remove_tree>.
1710#pod
1711#pod If you want to remove a directory only if it is empty, use the built-in
1712#pod C<rmdir> function instead.
1713#pod
1714#pod rmdir path("foo/bar/baz/");
1715#pod
1716#pod Current API available since 0.013.
1717#pod
1718#pod =cut
1719
1720sub remove_tree {
1721 my ( $self, $args ) = @_;
1722 return 0 if !-e $self->[PATH] && !-l $self->[PATH];
1723 $args = {} unless ref $args eq 'HASH';
1724 my $err;
1725 $args->{error} = \$err unless defined $args->{error};
1726 $args->{safe} = 1 unless defined $args->{safe};
1727 require File::Path;
1728 my $count = File::Path::remove_tree( $self->[PATH], $args );
1729
1730 if ( $err && @$err ) {
1731 my ( $file, $message ) = %{ $err->[0] };
1732 Carp::croak("remove_tree failed for $file: $message");
1733 }
1734 return $count;
1735}
1736
1737#pod =method sibling
1738#pod
1739#pod $foo = path("/tmp/foo.txt");
1740#pod $sib = $foo->sibling("bar.txt"); # /tmp/bar.txt
1741#pod $sib = $foo->sibling("baz", "bam.txt"); # /tmp/baz/bam.txt
1742#pod
1743#pod Returns a new C<Path::Tiny> object relative to the parent of the original.
1744#pod This is slightly more efficient than C<< $path->parent->child(...) >>.
1745#pod
1746#pod Current API available since 0.058.
1747#pod
1748#pod =cut
1749
1750sub sibling {
1751 my $self = shift;
1752 return path( $self->parent->[PATH], @_ );
1753}
1754
1755#pod =method slurp, slurp_raw, slurp_utf8
1756#pod
1757#pod $data = path("foo.txt")->slurp;
1758#pod $data = path("foo.txt")->slurp( {binmode => ":raw"} );
1759#pod $data = path("foo.txt")->slurp_raw;
1760#pod $data = path("foo.txt")->slurp_utf8;
1761#pod
1762#pod Reads file contents into a scalar. Takes an optional hash reference which may
1763#pod be used to pass options. The only available option is C<binmode>, which is
1764#pod passed to C<binmode()> on the handle used for reading.
1765#pod
1766#pod C<slurp_raw> is like C<slurp> with a C<binmode> of C<:unix> for
1767#pod a fast, unbuffered, raw read.
1768#pod
1769#pod C<slurp_utf8> is like C<slurp> with a C<binmode> of
1770#pod C<:unix:encoding(UTF-8)> (or L<PerlIO::utf8_strict>). If L<Unicode::UTF8>
1771#pod 0.58+ is installed, a raw slurp will be done instead and the result decoded
1772#pod with C<Unicode::UTF8>. This is just as strict and is roughly an order of
1773#pod magnitude faster than using C<:encoding(UTF-8)>.
1774#pod
1775#pod B<Note>: C<slurp> and friends lock the filehandle before slurping. If
1776#pod you plan to slurp from a file created with L<File::Temp>, be sure to
1777#pod close other handles or open without locking to avoid a deadlock:
1778#pod
1779#pod my $tempfile = File::Temp->new(EXLOCK => 0);
1780#pod my $guts = path($tempfile)->slurp;
1781#pod
1782#pod Current API available since 0.004.
1783#pod
1784#pod =cut
1785
1786
# spent 14.5s (198ms+14.3) within Path::Tiny::slurp which was called 1992 times, avg 7.28ms/call: # 1992 times (198ms+14.3s) by RBM::input_file_need_dl at line 1805, avg 7.28ms/call
sub slurp {
178719921.35ms my $self = shift;
178819928.83ms199224.5ms my $args = _get_args( shift, qw/binmode/ );
# spent 24.5ms making 1992 calls to Path::Tiny::_get_args, avg 12µs/call
178919922.51ms my $binmode = $args->{binmode};
179019921.75ms $binmode = ( ( caller(0) )[10] || {} )->{'open<'} unless defined $binmode;
1791199213.7ms1992248ms my $fh = $self->filehandle( { locked => 1 }, "<", $binmode );
# spent 248ms making 1992 calls to Path::Tiny::filehandle, avg 125µs/call
1792199219.2ms19928.18ms if ( ( defined($binmode) ? $binmode : "" ) eq ":unix"
# spent 8.18ms making 1992 calls to Path::Tiny::CORE:ftsize, avg 4µs/call
1793 and my $size = -s $fh )
1794 {
17951992353µs my $buf;
1796199214.1s199214.0s read $fh, $buf, $size; # File::Slurp in a nutshell
# spent 14.0s making 1992 calls to Path::Tiny::CORE:read, avg 7.04ms/call
17971992112ms return $buf;
1798 }
1799 else {
1800 local $/;
1801 return scalar <$fh>;
1802 }
1803}
1804
1805398424.3ms199214.5s
# spent 16.8ms within Path::Tiny::slurp_raw which was called 1992 times, avg 8µs/call: # 1992 times (16.8ms+0s) by RBM::input_file_need_dl at line 718 of /root/tor-browser-build/rbm/lib/RBM.pm, avg 8µs/call
sub slurp_raw { $_[1] = { binmode => ":unix" }; goto &slurp }
# spent 14.5s making 1992 calls to Path::Tiny::slurp, avg 7.28ms/call
1806
1807sub slurp_utf8 {
1808 if ( defined($HAS_UU) ? $HAS_UU : ( $HAS_UU = _check_UU() ) ) {
1809 return Unicode::UTF8::decode_utf8( slurp( $_[0], { binmode => ":unix" } ) );
1810 }
1811 elsif ( defined($HAS_PU) ? $HAS_PU : ( $HAS_PU = _check_PU() ) ) {
1812 $_[1] = { binmode => ":unix:utf8_strict" };
1813 goto &slurp;
1814 }
1815 else {
1816 $_[1] = { binmode => ":raw:encoding(UTF-8)" };
1817 goto &slurp;
1818 }
1819}
1820
1821#pod =method spew, spew_raw, spew_utf8
1822#pod
1823#pod path("foo.txt")->spew(@data);
1824#pod path("foo.txt")->spew(\@data);
1825#pod path("foo.txt")->spew({binmode => ":raw"}, @data);
1826#pod path("foo.txt")->spew_raw(@data);
1827#pod path("foo.txt")->spew_utf8(@data);
1828#pod
1829#pod Writes data to a file atomically. The file is written to a temporary file in
1830#pod the same directory, then renamed over the original. An optional hash reference
1831#pod may be used to pass options. The only option is C<binmode>, which is passed to
1832#pod C<binmode()> on the handle used for writing.
1833#pod
1834#pod C<spew_raw> is like C<spew> with a C<binmode> of C<:unix> for a fast,
1835#pod unbuffered, raw write.
1836#pod
1837#pod C<spew_utf8> is like C<spew> with a C<binmode> of C<:unix:encoding(UTF-8)>
1838#pod (or L<PerlIO::utf8_strict>). If L<Unicode::UTF8> 0.58+ is installed, a raw
1839#pod spew will be done instead on the data encoded with C<Unicode::UTF8>.
1840#pod
1841#pod B<NOTE>: because the file is written to a temporary file and then renamed, the
1842#pod new file will wind up with permissions based on your current umask. This is a
1843#pod feature to protect you from a race condition that would otherwise give
1844#pod different permissions than you might expect. If you really want to keep the
1845#pod original mode flags, use L</append> with the C<truncate> option.
1846#pod
1847#pod Current API available since 0.011.
1848#pod
1849#pod =cut
1850
1851# XXX add "unsafe" option to disable flocking and atomic? Check benchmarks on append() first.
1852
# spent 8.96ms (1.48+7.48) within Path::Tiny::spew which was called 16 times, avg 560µs/call: # 16 times (1.48ms+7.48ms) by Path::Tiny::spew_utf8 at line 1880, avg 560µs/call
sub spew {
18531619µs my ( $self, @data ) = @_;
18541655µs my $args = ( @data && ref $data[0] eq 'HASH' ) ? shift @data : {};
18551654µs16200µs $args = _get_args( $args, qw/binmode/ );
# spent 200µs making 16 calls to Path::Tiny::_get_args, avg 13µs/call
18561620µs my $binmode = $args->{binmode};
1857 # get default binmode from caller's lexical scope (see "perldoc open")
1858168µs $binmode = ( ( caller(0) )[10] || {} )->{'open>'} unless defined $binmode;
1859
1860 # spewing need to follow the link
1861 # and create the tempfile in the same dir
18621679µs16294µs my $resolved_path = $self->_resolve_symlinks;
# spent 294µs making 16 calls to Path::Tiny::_resolve_symlinks, avg 18µs/call
1863
186416187µs32246µs my $temp = path( $resolved_path . $$ . int( rand( 2**31 ) ) );
# spent 189µs making 16 calls to Path::Tiny::path, avg 12µs/call # spent 56µs making 16 calls to Path::Tiny::__ANON__[Path/Tiny.pm:30], avg 4µs/call
186516115µs163.43ms my $fh = $temp->filehandle( { exclusive => 1, locked => 1 }, ">", $binmode );
# spent 3.43ms making 16 calls to Path::Tiny::filehandle, avg 215µs/call
1866161.08ms16814µs print {$fh} map { ref eq 'ARRAY' ? @$_ : $_ } @data;
# spent 814µs making 16 calls to Path::Tiny::CORE:print, avg 51µs/call
1867161.77ms161.61ms close $fh or $self->_throw( 'close', $temp->[PATH] );
# spent 1.61ms making 16 calls to Path::Tiny::CORE:close, avg 101µs/call
1868
186916250µs16879µs return $temp->move($resolved_path);
# spent 879µs making 16 calls to Path::Tiny::move, avg 55µs/call
1870}
1871
1872sub spew_raw { splice @_, 1, 0, { binmode => ":unix" }; goto &spew }
1873
1874
# spent 11.7ms (802µs+10.9) within Path::Tiny::spew_utf8 which was called 16 times, avg 733µs/call: # 15 times (742µs+10.2ms) by RBM::run_script at line 466 of /root/tor-browser-build/rbm/lib/RBM.pm, avg 731µs/call # once (60µs+706µs) by RBM::build_run at line 1058 of /root/tor-browser-build/rbm/lib/RBM.pm
sub spew_utf8 {
187516303µs11.84ms if ( defined($HAS_UU) ? $HAS_UU : ( $HAS_UU = _check_UU() ) ) {
# spent 1.84ms making 1 call to Path::Tiny::_check_UU
18761612µs my $self = shift;
1877 spew(
1878 $self,
1879 { binmode => ":unix" },
188032843µs329.08ms map { Unicode::UTF8::encode_utf8($_) } map { ref eq 'ARRAY' ? @$_ : $_ } @_
# spent 8.96ms making 16 calls to Path::Tiny::spew, avg 560µs/call # spent 120µs making 16 calls to Unicode::UTF8::encode_utf8, avg 8µs/call
1881 );
1882 }
1883 elsif ( defined($HAS_PU) ? $HAS_PU : ( $HAS_PU = _check_PU() ) ) {
1884 splice @_, 1, 0, { binmode => ":unix:utf8_strict" };
1885 goto &spew;
1886 }
1887 else {
1888 splice @_, 1, 0, { binmode => ":unix:encoding(UTF-8)" };
1889 goto &spew;
1890 }
1891}
1892
1893#pod =method stat, lstat
1894#pod
1895#pod $stat = path("foo.txt")->stat;
1896#pod $stat = path("/some/symlink")->lstat;
1897#pod
1898#pod Like calling C<stat> or C<lstat> from L<File::stat>.
1899#pod
1900#pod Current API available since 0.001.
1901#pod
1902#pod =cut
1903
1904# XXX break out individual stat() components as subs?
1905sub stat {
1906 my $self = shift;
1907 require File::stat;
1908 return File::stat::stat( $self->[PATH] ) || $self->_throw('stat');
1909}
1910
1911sub lstat {
1912 my $self = shift;
1913 require File::stat;
1914 return File::stat::lstat( $self->[PATH] ) || $self->_throw('lstat');
1915}
1916
1917#pod =method stringify
1918#pod
1919#pod $path = path("foo.txt");
1920#pod say $path->stringify; # same as "$path"
1921#pod
1922#pod Returns a string representation of the path. Unlike C<canonpath>, this method
1923#pod returns the path standardized with Unix-style C</> directory separators.
1924#pod
1925#pod Current API available since 0.001.
1926#pod
1927#pod =cut
1928
1929sub stringify { $_[0]->[PATH] }
1930
1931#pod =method subsumes
1932#pod
1933#pod path("foo/bar")->subsumes("foo/bar/baz"); # true
1934#pod path("/foo/bar")->subsumes("/foo/baz"); # false
1935#pod
1936#pod Returns true if the first path is a prefix of the second path at a directory
1937#pod boundary.
1938#pod
1939#pod This B<does not> resolve parent directory entries (C<..>) or symlinks:
1940#pod
1941#pod path("foo/bar")->subsumes("foo/bar/../baz"); # true
1942#pod
1943#pod If such things are important to you, ensure that both paths are resolved to
1944#pod the filesystem with C<realpath>:
1945#pod
1946#pod my $p1 = path("foo/bar")->realpath;
1947#pod my $p2 = path("foo/bar/../baz")->realpath;
1948#pod if ( $p1->subsumes($p2) ) { ... }
1949#pod
1950#pod Current API available since 0.048.
1951#pod
1952#pod =cut
1953
1954sub subsumes {
1955 my $self = shift;
1956 Carp::croak("subsumes() requires a defined, positive-length argument")
1957 unless defined $_[0];
1958 my $other = path(shift);
1959
1960 # normalize absolute vs relative
1961 if ( $self->is_absolute && !$other->is_absolute ) {
1962 $other = $other->absolute;
1963 }
1964 elsif ( $other->is_absolute && !$self->is_absolute ) {
1965 $self = $self->absolute;
1966 }
1967
1968 # normalize volume vs non-volume; do this after absolute path
1969 # adjustments above since that might add volumes already
1970 if ( length $self->volume && !length $other->volume ) {
1971 $other = $other->absolute;
1972 }
1973 elsif ( length $other->volume && !length $self->volume ) {
1974 $self = $self->absolute;
1975 }
1976
1977 if ( $self->[PATH] eq '.' ) {
1978 return !!1; # cwd subsumes everything relative
1979 }
1980 elsif ( $self->is_rootdir ) {
1981 # a root directory ("/", "c:/") already ends with a separator
1982 return $other->[PATH] =~ m{^\Q$self->[PATH]\E};
1983 }
1984 else {
1985 # exact match or prefix breaking at a separator
1986 return $other->[PATH] =~ m{^\Q$self->[PATH]\E(?:/|$)};
1987 }
1988}
1989
1990#pod =method touch
1991#pod
1992#pod path("foo.txt")->touch;
1993#pod path("foo.txt")->touch($epoch_secs);
1994#pod
1995#pod Like the Unix C<touch> utility. Creates the file if it doesn't exist, or else
1996#pod changes the modification and access times to the current time. If the first
1997#pod argument is the epoch seconds then it will be used.
1998#pod
1999#pod Returns the path object so it can be easily chained with other methods:
2000#pod
2001#pod # won't die if foo.txt doesn't exist
2002#pod $content = path("foo.txt")->touch->slurp;
2003#pod
2004#pod Current API available since 0.015.
2005#pod
2006#pod =cut
2007
2008sub touch {
2009 my ( $self, $epoch ) = @_;
2010 if ( !-e $self->[PATH] ) {
2011 my $fh = $self->openw;
2012 close $fh or $self->_throw('close');
2013 }
2014 if ( defined $epoch ) {
2015 utime $epoch, $epoch, $self->[PATH]
2016 or $self->_throw("utime ($epoch)");
2017 }
2018 else {
2019 # literal undef prevents warnings :-(
2020 utime undef, undef, $self->[PATH]
2021 or $self->_throw("utime ()");
2022 }
2023 return $self;
2024}
2025
2026#pod =method touchpath
2027#pod
2028#pod path("bar/baz/foo.txt")->touchpath;
2029#pod
2030#pod Combines C<mkpath> and C<touch>. Creates the parent directory if it doesn't exist,
2031#pod before touching the file. Returns the path object like C<touch> does.
2032#pod
2033#pod Current API available since 0.022.
2034#pod
2035#pod =cut
2036
2037sub touchpath {
2038 my ($self) = @_;
2039 my $parent = $self->parent;
2040 $parent->mkpath unless $parent->exists;
2041 $self->touch;
2042}
2043
2044#pod =method visit
2045#pod
2046#pod path("/tmp")->visit( \&callback, \%options );
2047#pod
2048#pod Executes a callback for each child of a directory. It returns a hash
2049#pod reference with any state accumulated during iteration.
2050#pod
2051#pod The options are the same as for L</iterator> (which it uses internally):
2052#pod C<recurse> and C<follow_symlinks>. Both default to false.
2053#pod
2054#pod The callback function will receive a C<Path::Tiny> object as the first argument
2055#pod and a hash reference to accumulate state as the second argument. For example:
2056#pod
2057#pod # collect files sizes
2058#pod my $sizes = path("/tmp")->visit(
2059#pod sub {
2060#pod my ($path, $state) = @_;
2061#pod return if $path->is_dir;
2062#pod $state->{$path} = -s $path;
2063#pod },
2064#pod { recurse => 1 }
2065#pod );
2066#pod
2067#pod For convenience, the C<Path::Tiny> object will also be locally aliased as the
2068#pod C<$_> global variable:
2069#pod
2070#pod # print paths matching /foo/
2071#pod path("/tmp")->visit( sub { say if /foo/ }, { recurse => 1} );
2072#pod
2073#pod If the callback returns a B<reference> to a false scalar value, iteration will
2074#pod terminate. This is not the same as "pruning" a directory search; this just
2075#pod stops all iteration and returns the state hash reference.
2076#pod
2077#pod # find up to 10 files larger than 100K
2078#pod my $files = path("/tmp")->visit(
2079#pod sub {
2080#pod my ($path, $state) = @_;
2081#pod $state->{$path}++ if -s $path > 102400
2082#pod return \0 if keys %$state == 10;
2083#pod },
2084#pod { recurse => 1 }
2085#pod );
2086#pod
2087#pod If you want more flexible iteration, use a module like L<Path::Iterator::Rule>.
2088#pod
2089#pod Current API available since 0.062.
2090#pod
2091#pod =cut
2092
2093sub visit {
2094 my $self = shift;
2095 my $cb = shift;
2096 my $args = _get_args( shift, qw/recurse follow_symlinks/ );
2097 Carp::croak("Callback for visit() must be a code reference")
2098 unless defined($cb) && ref($cb) eq 'CODE';
2099 my $next = $self->iterator($args);
2100 my $state = {};
2101 while ( my $file = $next->() ) {
2102 local $_ = $file;
2103 my $r = $cb->( $file, $state );
2104 last if ref($r) eq 'SCALAR' && !$$r;
2105 }
2106 return $state;
2107}
2108
2109#pod =method volume
2110#pod
2111#pod $vol = path("/tmp/foo.txt")->volume; # ""
2112#pod $vol = path("C:/tmp/foo.txt")->volume; # "C:"
2113#pod
2114#pod Returns the volume portion of the path. This is equivalent
2115#pod to what L<File::Spec> would give from C<splitpath> and thus
2116#pod usually is the empty string on Unix-like operating systems or the
2117#pod drive letter for an absolute path on C<MSWin32>.
2118#pod
2119#pod Current API available since 0.001.
2120#pod
2121#pod =cut
2122
2123sub volume {
2124 my ($self) = @_;
2125 $self->_splitpath unless defined $self->[VOL];
2126 return $self->[VOL];
2127}
2128
2129package Path::Tiny::Error;
2130
213112µsour @CARP_NOT = qw/Path::Tiny/;
2132
21332184µs287µs
# spent 49µs (11+38) within Path::Tiny::Error::BEGIN@2133 which was called: # once (11µs+38µs) by RBM::BEGIN@5 at line 2133
use overload ( q{""} => sub { (shift)->{msg} }, fallback => 1 );
# spent 49µs making 1 call to Path::Tiny::Error::BEGIN@2133 # spent 38µs making 1 call to overload::import
2134
2135sub throw {
2136 my ( $class, $op, $file, $err ) = @_;
2137 chomp( my $trace = Carp::shortmess );
2138 my $msg = "Error $op on '$file': $err$trace\n";
2139 die bless { op => $op, file => $file, err => $err, msg => $msg }, $class;
2140}
2141
2142124µs1;
2143
2144
2145# vim: ts=4 sts=4 sw=4 et:
2146
2147__END__
 
# spent 62µs within Path::Tiny::CORE:binmode which was called 32 times, avg 2µs/call: # 16 times (42µs+0s) by Path::Tiny::filehandle at line 1054, avg 3µs/call # 16 times (20µs+0s) by Path::Tiny::filehandle at line 1056, avg 1µs/call
sub Path::Tiny::CORE:binmode; # opcode
# spent 1.63ms within Path::Tiny::CORE:close which was called 17 times, avg 96µs/call: # 16 times (1.61ms+0s) by Path::Tiny::spew at line 1867, avg 101µs/call # once (11µs+0s) by Path::Tiny::append at line 551
sub Path::Tiny::CORE:close; # opcode
# spent 17.5ms within Path::Tiny::CORE:flock which was called 2009 times, avg 9µs/call: # 2009 times (17.5ms+0s) by Path::Tiny::filehandle at line 1090, avg 9µs/call
sub Path::Tiny::CORE:flock; # opcode
# spent 103µs within Path::Tiny::CORE:ftlink which was called 16 times, avg 6µs/call: # 16 times (103µs+0s) by Path::Tiny::_resolve_symlinks at line 441, avg 6µs/call
sub Path::Tiny::CORE:ftlink; # opcode
# spent 8.18ms within Path::Tiny::CORE:ftsize which was called 1992 times, avg 4µs/call: # 1992 times (8.18ms+0s) by Path::Tiny::slurp at line 1792, avg 4µs/call
sub Path::Tiny::CORE:ftsize; # opcode
# spent 1.93ms within Path::Tiny::CORE:match which was called 2025 times, avg 951ns/call: # 2025 times (1.93ms+0s) by Path::Tiny::path at line 262, avg 951ns/call
sub Path::Tiny::CORE:match; # opcode
# spent 123ms within Path::Tiny::CORE:open which was called 1993 times, avg 61µs/call: # 1993 times (123ms+0s) by Path::Tiny::filehandle at line 1087, avg 61µs/call
sub Path::Tiny::CORE:open; # opcode
# spent 854µs within Path::Tiny::CORE:print which was called 17 times, avg 50µs/call: # 16 times (814µs+0s) by Path::Tiny::spew at line 1866, avg 51µs/call # once (40µs+0s) by Path::Tiny::append at line 550
sub Path::Tiny::CORE:print; # opcode
# spent 6µs within Path::Tiny::CORE:qr which was called 6 times, avg 967ns/call: # once (2µs+0s) by RBM::BEGIN@5 at line 68 # once (1µs+0s) by RBM::BEGIN@5 at line 69 # once (1µs+0s) by RBM::BEGIN@5 at line 1301 # once (700ns+0s) by RBM::BEGIN@5 at line 70 # once (700ns+0s) by RBM::BEGIN@5 at line 72 # once (500ns+0s) by RBM::BEGIN@5 at line 71
sub Path::Tiny::CORE:qr; # opcode
# spent 14.0s within Path::Tiny::CORE:read which was called 1992 times, avg 7.04ms/call: # 1992 times (14.0s+0s) by Path::Tiny::slurp at line 1796, avg 7.04ms/call
sub Path::Tiny::CORE:read; # opcode
# spent 55µs within Path::Tiny::CORE:regcomp which was called 2 times, avg 28µs/call: # once (36µs+0s) by RBM::BEGIN@5 at line 72 # once (19µs+0s) by RBM::BEGIN@5 at line 71
sub Path::Tiny::CORE:regcomp; # opcode
# spent 614µs (593+20) within Path::Tiny::CORE:rename which was called 16 times, avg 38µs/call: # 16 times (593µs+20µs) by Path::Tiny::move at line 1367, avg 38µs/call
sub Path::Tiny::CORE:rename; # opcode
# spent 3.11ms within Path::Tiny::CORE:subst which was called 2041 times, avg 2µs/call: # 2025 times (3.04ms+0s) by Path::Tiny::path at line 258, avg 2µs/call # 16 times (65µs+0s) by Path::Tiny::filehandle at line 1052, avg 4µs/call
sub Path::Tiny::CORE:subst; # opcode
# spent 442µs within Path::Tiny::CORE:sysopen which was called 16 times, avg 28µs/call: # 16 times (442µs+0s) by Path::Tiny::filehandle at line 1048, avg 28µs/call
sub Path::Tiny::CORE:sysopen; # opcode
# spent 290µs within Path::Tiny::CORE:truncate which was called 16 times, avg 18µs/call: # 16 times (290µs+0s) by Path::Tiny::filehandle at line 1091, avg 18µs/call
sub Path::Tiny::CORE:truncate; # opcode
Report produced by the NYTProf 6.06 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.