← Index
NYTProf Performance Profile   « line view »
For /home/ss5/perl5/perlbrew/perls/perl-5.22.0/bin/benchmarkanything-storage
  Run on Mon Jan 29 16:55:34 2018
Reported on Mon Jan 29 16:57:07 2018

Filename/home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/File/HomeDir.pm
StatementsExecuted 29 statements in 1.03ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1111.37ms1.75msFile::HomeDir::::BEGIN@9 File::HomeDir::BEGIN@9
111540µs712µsFile::HomeDir::::BEGIN@10 File::HomeDir::BEGIN@10
111430µs1.33msFile::HomeDir::::_DRIVER File::HomeDir::_DRIVER
11116µs76µsFile::HomeDir::::BEGIN@13 File::HomeDir::BEGIN@13
1119µs9µsFile::HomeDir::::BEGIN@5 File::HomeDir::BEGIN@5
1118µs8µsFile::HomeDir::::BEGIN@14 File::HomeDir::BEGIN@14
1115µs6µsFile::HomeDir::::BEGIN@6 File::HomeDir::BEGIN@6
1114µs4µsFile::HomeDir::::CORE:match File::HomeDir::CORE:match (opcode)
1114µs9µsFile::HomeDir::::_CLASS File::HomeDir::_CLASS
1112µs2µsFile::HomeDir::::BEGIN@7 File::HomeDir::BEGIN@7
1112µs2µsFile::HomeDir::::BEGIN@8 File::HomeDir::BEGIN@8
111700ns700nsFile::HomeDir::TIE::::TIEHASHFile::HomeDir::TIE::TIEHASH
0000s0sFile::HomeDir::TIE::::CLEARFile::HomeDir::TIE::CLEAR
0000s0sFile::HomeDir::TIE::::DELETEFile::HomeDir::TIE::DELETE
0000s0sFile::HomeDir::TIE::::EXISTSFile::HomeDir::TIE::EXISTS
0000s0sFile::HomeDir::TIE::::FETCHFile::HomeDir::TIE::FETCH
0000s0sFile::HomeDir::TIE::::FIRSTKEYFile::HomeDir::TIE::FIRSTKEY
0000s0sFile::HomeDir::TIE::::NEXTKEYFile::HomeDir::TIE::NEXTKEY
0000s0sFile::HomeDir::TIE::::STOREFile::HomeDir::TIE::STORE
0000s0sFile::HomeDir::TIE::::_badFile::HomeDir::TIE::_bad
0000s0sFile::HomeDir::::home File::HomeDir::home
0000s0sFile::HomeDir::::my_data File::HomeDir::my_data
0000s0sFile::HomeDir::::my_desktop File::HomeDir::my_desktop
0000s0sFile::HomeDir::::my_dist_config File::HomeDir::my_dist_config
0000s0sFile::HomeDir::::my_dist_data File::HomeDir::my_dist_data
0000s0sFile::HomeDir::::my_documents File::HomeDir::my_documents
0000s0sFile::HomeDir::::my_home File::HomeDir::my_home
0000s0sFile::HomeDir::::my_music File::HomeDir::my_music
0000s0sFile::HomeDir::::my_pictures File::HomeDir::my_pictures
0000s0sFile::HomeDir::::my_videos File::HomeDir::my_videos
0000s0sFile::HomeDir::::users_data File::HomeDir::users_data
0000s0sFile::HomeDir::::users_desktop File::HomeDir::users_desktop
0000s0sFile::HomeDir::::users_documents File::HomeDir::users_documents
0000s0sFile::HomeDir::::users_home File::HomeDir::users_home
0000s0sFile::HomeDir::::users_music File::HomeDir::users_music
0000s0sFile::HomeDir::::users_pictures File::HomeDir::users_pictures
0000s0sFile::HomeDir::::users_videos File::HomeDir::users_videos
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package File::HomeDir;
2
3# See POD at end for documentation
4
5224µs19µs
# spent 9µs within File::HomeDir::BEGIN@5 which was called: # once (9µs+0s) by BenchmarkAnything::Config::_read_config at line 5
use 5.00503;
# spent 9µs making 1 call to File::HomeDir::BEGIN@5
6213µs27µs
# spent 6µs (5+1) within File::HomeDir::BEGIN@6 which was called: # once (5µs+1µs) by BenchmarkAnything::Config::_read_config at line 6
use strict;
# spent 6µs making 1 call to File::HomeDir::BEGIN@6 # spent 1µs making 1 call to strict::import
7210µs12µs
# spent 2µs within File::HomeDir::BEGIN@7 which was called: # once (2µs+0s) by BenchmarkAnything::Config::_read_config at line 7
use Carp ();
# spent 2µs making 1 call to File::HomeDir::BEGIN@7
829µs12µs
# spent 2µs within File::HomeDir::BEGIN@8 which was called: # once (2µs+0s) by BenchmarkAnything::Config::_read_config at line 8
use Config ();
# spent 2µs making 1 call to File::HomeDir::BEGIN@8
9254µs11.75ms
# spent 1.75ms (1.37+381µs) within File::HomeDir::BEGIN@9 which was called: # once (1.37ms+381µs) by BenchmarkAnything::Config::_read_config at line 9
use File::Spec ();
# spent 1.75ms making 1 call to File::HomeDir::BEGIN@9
10282µs1712µs
# spent 712µs (540+171) within File::HomeDir::BEGIN@10 which was called: # once (540µs+171µs) by BenchmarkAnything::Config::_read_config at line 10
use File::Which ();
# spent 712µs making 1 call to File::HomeDir::BEGIN@10
11
12# Globals
13255µs2137µs
# spent 76µs (16+61) within File::HomeDir::BEGIN@13 which was called: # once (16µs+61µs) by BenchmarkAnything::Config::_read_config at line 13
use vars qw{$VERSION @ISA @EXPORT @EXPORT_OK $IMPLEMENTED_BY};
# spent 76µs making 1 call to File::HomeDir::BEGIN@13 # spent 61µs making 1 call to vars::import
14
# spent 8µs within File::HomeDir::BEGIN@14 which was called: # once (8µs+0s) by BenchmarkAnything::Config::_read_config at line 43
BEGIN {
151300ns $VERSION = '1.00';
16
17 # Inherit manually
181300ns require Exporter;
1913µs @ISA = qw{ Exporter };
201400ns @EXPORT = qw{ home };
2115µs @EXPORT_OK = qw{
22 home
23 my_home
24 my_desktop
25 my_documents
26 my_music
27 my_pictures
28 my_videos
29 my_data
30 my_dist_config
31 my_dist_data
32 users_home
33 users_desktop
34 users_documents
35 users_music
36 users_pictures
37 users_videos
38 users_data
39 };
40
41 # %~ doesn't need (and won't take) exporting, as it's a magic
42 # symbol name that's always looked for in package 'main'.
431710µs18µs}
# spent 8µs making 1 call to File::HomeDir::BEGIN@14
44
45# Inlined Params::Util functions
46
# spent 9µs (4+4) within File::HomeDir::_CLASS which was called: # once (4µs+4µs) by File::HomeDir::_DRIVER at line 50
sub _CLASS ($) {
47110µs14µs (defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s) ? $_[0] : undef;
# spent 4µs making 1 call to File::HomeDir::CORE:match
48}
49
# spent 1.33ms (430µs+899µs) within File::HomeDir::_DRIVER which was called: # once (430µs+899µs) by BenchmarkAnything::Config::_read_config at line 81
sub _DRIVER ($$) {
50132µs210µs (defined _CLASS($_[0]) and eval "require $_[0];" and ! $@ and $_[0]->isa($_[1]) and $_[0] ne $_[1]) ? $_[0] : undef;
# spent 9µs making 1 call to File::HomeDir::_CLASS # spent 1µs making 1 call to UNIVERSAL::isa
# spent 59µs executing statements in string eval
51}
52
53# Platform detection
5414µs1256µsif ( $IMPLEMENTED_BY ) {
# spent 256µs making 1 call to File::Which::which
55 # Allow for custom HomeDir classes
56 # Leave it as the existing value
57} elsif ( $^O eq 'MSWin32' ) {
58 # All versions of Windows
59 $IMPLEMENTED_BY = 'File::HomeDir::Windows';
60} elsif ( $^O eq 'darwin') {
61 # 1st: try Mac::SystemDirectory by chansen
62 if ( eval { require Mac::SystemDirectory; 1 } ) {
63 $IMPLEMENTED_BY = 'File::HomeDir::Darwin::Cocoa';
64 } elsif ( eval { require Mac::Files; 1 } ) {
65 # 2nd try Mac::Files: Carbon - unmaintained since 2006 except some 64bit fixes
66 $IMPLEMENTED_BY = 'File::HomeDir::Darwin::Carbon';
67 } else {
68 # 3rd: fallback: pure perl
69 $IMPLEMENTED_BY = 'File::HomeDir::Darwin';
70 }
71} elsif ( $^O eq 'MacOS' ) {
72 # Legacy Mac OS
73 $IMPLEMENTED_BY = 'File::HomeDir::MacOS9';
74} elsif ( File::Which::which('xdg-user-dir') ) {
75 # freedesktop unixes
761300ns $IMPLEMENTED_BY = 'File::HomeDir::FreeDesktop';
77} else {
78 # Default to Unix semantics
79 $IMPLEMENTED_BY = 'File::HomeDir::Unix';
80}
8112µs11.33msunless ( _DRIVER($IMPLEMENTED_BY, 'File::HomeDir::Driver') ) {
# spent 1.33ms making 1 call to File::HomeDir::_DRIVER
82 Carp::croak("Missing or invalid File::HomeDir driver $IMPLEMENTED_BY");
83}
84
- -
89#####################################################################
90# Current User Methods
91
92sub my_home {
93 $IMPLEMENTED_BY->my_home;
94}
95
96sub my_desktop {
97 $IMPLEMENTED_BY->can('my_desktop')
98 ? $IMPLEMENTED_BY->my_desktop
99 : Carp::croak("The my_desktop method is not implemented on this platform");
100}
101
102sub my_documents {
103 $IMPLEMENTED_BY->can('my_documents')
104 ? $IMPLEMENTED_BY->my_documents
105 : Carp::croak("The my_documents method is not implemented on this platform");
106}
107
108sub my_music {
109 $IMPLEMENTED_BY->can('my_music')
110 ? $IMPLEMENTED_BY->my_music
111 : Carp::croak("The my_music method is not implemented on this platform");
112}
113
114sub my_pictures {
115 $IMPLEMENTED_BY->can('my_pictures')
116 ? $IMPLEMENTED_BY->my_pictures
117 : Carp::croak("The my_pictures method is not implemented on this platform");
118}
119
120sub my_videos {
121 $IMPLEMENTED_BY->can('my_videos')
122 ? $IMPLEMENTED_BY->my_videos
123 : Carp::croak("The my_videos method is not implemented on this platform");
124}
125
126sub my_data {
127 $IMPLEMENTED_BY->can('my_data')
128 ? $IMPLEMENTED_BY->my_data
129 : Carp::croak("The my_data method is not implemented on this platform");
130}
131
132
133sub my_dist_data {
134 my $params = ref $_[-1] eq 'HASH' ? pop : {};
135 my $dist = pop or Carp::croak("The my_dist_data method requires an argument");
136 my $data = my_data();
137
138 # If datadir is not defined, there's nothing we can do: bail out
139 # and return nothing...
140 return undef unless defined $data;
141
142 # On traditional unixes, hide the top-level directory
143 my $var = $data eq home()
144 ? File::Spec->catdir( $data, '.perl', 'dist', $dist )
145 : File::Spec->catdir( $data, 'Perl', 'dist', $dist );
146
147 # directory exists: return it
148 return $var if -d $var;
149
150 # directory doesn't exist: check if we need to create it...
151 return undef unless $params->{create};
152
153 # user requested directory creation
154 require File::Path;
155 File::Path::mkpath( $var );
156 return $var;
157}
158
159sub my_dist_config {
160 my $params = ref $_[-1] eq 'HASH' ? pop : {};
161 my $dist = pop or Carp::croak("The my_dist_config method requires an argument");
162
163 # not all platforms support a specific my_config() method
164 my $config = $IMPLEMENTED_BY->can('my_config')
165 ? $IMPLEMENTED_BY->my_config
166 : $IMPLEMENTED_BY->my_documents;
167
168 # If neither configdir nor my_documents is defined, there's
169 # nothing we can do: bail out and return nothing...
170 return undef unless defined $config;
171
172 # On traditional unixes, hide the top-level dir
173 my $etc = $config eq home()
174 ? File::Spec->catdir( $config, '.perl', $dist )
175 : File::Spec->catdir( $config, 'Perl', $dist );
176
177 # directory exists: return it
178 return $etc if -d $etc;
179
180 # directory doesn't exist: check if we need to create it...
181 return undef unless $params->{create};
182
183 # user requested directory creation
184 require File::Path;
185 File::Path::mkpath( $etc );
186 return $etc;
187}
188
- -
192#####################################################################
193# General User Methods
194
195sub users_home {
196 $IMPLEMENTED_BY->can('users_home')
197 ? $IMPLEMENTED_BY->users_home( $_[-1] )
198 : Carp::croak("The users_home method is not implemented on this platform");
199}
200
201sub users_desktop {
202 $IMPLEMENTED_BY->can('users_desktop')
203 ? $IMPLEMENTED_BY->users_desktop( $_[-1] )
204 : Carp::croak("The users_desktop method is not implemented on this platform");
205}
206
207sub users_documents {
208 $IMPLEMENTED_BY->can('users_documents')
209 ? $IMPLEMENTED_BY->users_documents( $_[-1] )
210 : Carp::croak("The users_documents method is not implemented on this platform");
211}
212
213sub users_music {
214 $IMPLEMENTED_BY->can('users_music')
215 ? $IMPLEMENTED_BY->users_music( $_[-1] )
216 : Carp::croak("The users_music method is not implemented on this platform");
217}
218
219sub users_pictures {
220 $IMPLEMENTED_BY->can('users_pictures')
221 ? $IMPLEMENTED_BY->users_pictures( $_[-1] )
222 : Carp::croak("The users_pictures method is not implemented on this platform");
223}
224
225sub users_videos {
226 $IMPLEMENTED_BY->can('users_videos')
227 ? $IMPLEMENTED_BY->users_videos( $_[-1] )
228 : Carp::croak("The users_videos method is not implemented on this platform");
229}
230
231sub users_data {
232 $IMPLEMENTED_BY->can('users_data')
233 ? $IMPLEMENTED_BY->users_data( $_[-1] )
234 : Carp::croak("The users_data method is not implemented on this platform");
235}
236
- -
241#####################################################################
242# Legacy Methods
243
244# Find the home directory of an arbitrary user
245sub home (;$) {
246 # Allow to be called as a method
247 if ( $_[0] and $_[0] eq 'File::HomeDir' ) {
248 shift();
249 }
250
251 # No params means my home
252 return my_home() unless @_;
253
254 # Check the param
255 my $name = shift;
256 if ( ! defined $name ) {
257 Carp::croak("Can't use undef as a username");
258 }
259 if ( ! length $name ) {
260 Carp::croak("Can't use empty-string (\"\") as a username");
261 }
262
263 # A dot also means my home
264 ### Is this meant to mean File::Spec->curdir?
265 if ( $name eq '.' ) {
266 return my_home();
267 }
268
269 # Now hand off to the implementor
270 $IMPLEMENTED_BY->users_home($name);
271}
272
- -
277#####################################################################
278# Tie-Based Interface
279
280# Okay, things below this point get scary
281
282CLASS: {
283 # Make the class for the %~ tied hash:
284 package File::HomeDir::TIE;
285
286 # Make the singleton object.
287 # (We don't use the hash for anything, though)
288 ### THEN WHY MAKE IT???
2891700ns my $SINGLETON = bless {};
290
29113µs
# spent 700ns within File::HomeDir::TIE::TIEHASH which was called: # once (700ns+0s) by BenchmarkAnything::Config::_read_config at line 322
sub TIEHASH { $SINGLETON }
292
293 sub FETCH {
294 # Catch a bad username
295 unless ( defined $_[1] ) {
296 Carp::croak("Can't use undef as a username");
297 }
298
299 # Get our homedir
300 unless ( length $_[1] ) {
301 return File::HomeDir::my_home();
302 }
303
304 # Get a named user's homedir
305 Carp::carp("The tied %~ hash has been deprecated");
306 return File::HomeDir::home($_[1]);
307 }
308
309 sub STORE { _bad('STORE') }
310 sub EXISTS { _bad('EXISTS') }
311 sub DELETE { _bad('DELETE') }
312 sub CLEAR { _bad('CLEAR') }
313 sub FIRSTKEY { _bad('FIRSTKEY') }
314 sub NEXTKEY { _bad('NEXTKEY') }
315
316 sub _bad ($) {
317 Carp::croak("You can't $_[0] with the %~ hash")
318 }
319}
320
321# Do the actual tie of the global %~ variable
32224µs1700nstie %~, 'File::HomeDir::TIE';
# spent 700ns making 1 call to File::HomeDir::TIE::TIEHASH
323
32417µs1;
325
326__END__
 
# spent 4µs within File::HomeDir::CORE:match which was called: # once (4µs+0s) by File::HomeDir::_CLASS at line 47
sub File::HomeDir::CORE:match; # opcode