Filename | /home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/File/HomeDir.pm |
Statements | Executed 29 statements in 1.03ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 1.37ms | 1.75ms | BEGIN@9 | File::HomeDir::
1 | 1 | 1 | 540µs | 712µs | BEGIN@10 | File::HomeDir::
1 | 1 | 1 | 430µs | 1.33ms | _DRIVER | File::HomeDir::
1 | 1 | 1 | 16µs | 76µs | BEGIN@13 | File::HomeDir::
1 | 1 | 1 | 9µs | 9µs | BEGIN@5 | File::HomeDir::
1 | 1 | 1 | 8µs | 8µs | BEGIN@14 | File::HomeDir::
1 | 1 | 1 | 5µs | 6µs | BEGIN@6 | File::HomeDir::
1 | 1 | 1 | 4µs | 4µs | CORE:match (opcode) | File::HomeDir::
1 | 1 | 1 | 4µs | 9µs | _CLASS | File::HomeDir::
1 | 1 | 1 | 2µs | 2µs | BEGIN@7 | File::HomeDir::
1 | 1 | 1 | 2µs | 2µs | BEGIN@8 | File::HomeDir::
1 | 1 | 1 | 700ns | 700ns | TIEHASH | File::HomeDir::TIE::
0 | 0 | 0 | 0s | 0s | CLEAR | File::HomeDir::TIE::
0 | 0 | 0 | 0s | 0s | DELETE | File::HomeDir::TIE::
0 | 0 | 0 | 0s | 0s | EXISTS | File::HomeDir::TIE::
0 | 0 | 0 | 0s | 0s | FETCH | File::HomeDir::TIE::
0 | 0 | 0 | 0s | 0s | FIRSTKEY | File::HomeDir::TIE::
0 | 0 | 0 | 0s | 0s | NEXTKEY | File::HomeDir::TIE::
0 | 0 | 0 | 0s | 0s | STORE | File::HomeDir::TIE::
0 | 0 | 0 | 0s | 0s | _bad | File::HomeDir::TIE::
0 | 0 | 0 | 0s | 0s | home | File::HomeDir::
0 | 0 | 0 | 0s | 0s | my_data | File::HomeDir::
0 | 0 | 0 | 0s | 0s | my_desktop | File::HomeDir::
0 | 0 | 0 | 0s | 0s | my_dist_config | File::HomeDir::
0 | 0 | 0 | 0s | 0s | my_dist_data | File::HomeDir::
0 | 0 | 0 | 0s | 0s | my_documents | File::HomeDir::
0 | 0 | 0 | 0s | 0s | my_home | File::HomeDir::
0 | 0 | 0 | 0s | 0s | my_music | File::HomeDir::
0 | 0 | 0 | 0s | 0s | my_pictures | File::HomeDir::
0 | 0 | 0 | 0s | 0s | my_videos | File::HomeDir::
0 | 0 | 0 | 0s | 0s | users_data | File::HomeDir::
0 | 0 | 0 | 0s | 0s | users_desktop | File::HomeDir::
0 | 0 | 0 | 0s | 0s | users_documents | File::HomeDir::
0 | 0 | 0 | 0s | 0s | users_home | File::HomeDir::
0 | 0 | 0 | 0s | 0s | users_music | File::HomeDir::
0 | 0 | 0 | 0s | 0s | users_pictures | File::HomeDir::
0 | 0 | 0 | 0s | 0s | users_videos | File::HomeDir::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package File::HomeDir; | ||||
2 | |||||
3 | # See POD at end for documentation | ||||
4 | |||||
5 | 2 | 24µs | 1 | 9µs | # spent 9µs within File::HomeDir::BEGIN@5 which was called:
# once (9µs+0s) by BenchmarkAnything::Config::_read_config at line 5 # spent 9µs making 1 call to File::HomeDir::BEGIN@5 |
6 | 2 | 13µs | 2 | 7µ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 # spent 6µs making 1 call to File::HomeDir::BEGIN@6
# spent 1µs making 1 call to strict::import |
7 | 2 | 10µs | 1 | 2µs | # spent 2µs within File::HomeDir::BEGIN@7 which was called:
# once (2µs+0s) by BenchmarkAnything::Config::_read_config at line 7 # spent 2µs making 1 call to File::HomeDir::BEGIN@7 |
8 | 2 | 9µs | 1 | 2µs | # spent 2µs within File::HomeDir::BEGIN@8 which was called:
# once (2µs+0s) by BenchmarkAnything::Config::_read_config at line 8 # spent 2µs making 1 call to File::HomeDir::BEGIN@8 |
9 | 2 | 54µs | 1 | 1.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 # spent 1.75ms making 1 call to File::HomeDir::BEGIN@9 |
10 | 2 | 82µs | 1 | 712µ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 # spent 712µs making 1 call to File::HomeDir::BEGIN@10 |
11 | |||||
12 | # Globals | ||||
13 | 2 | 55µs | 2 | 137µ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 # 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 | ||||
15 | 1 | 300ns | $VERSION = '1.00'; | ||
16 | |||||
17 | # Inherit manually | ||||
18 | 1 | 300ns | require Exporter; | ||
19 | 1 | 3µs | @ISA = qw{ Exporter }; | ||
20 | 1 | 400ns | @EXPORT = qw{ home }; | ||
21 | 1 | 5µ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'. | ||||
43 | 1 | 710µs | 1 | 8µ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 | ||||
47 | 1 | 10µs | 1 | 4µ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 | ||||
50 | 1 | 32µs | 2 | 10µ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 | ||||
54 | 1 | 4µs | 1 | 256µs | if ( $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 | ||||
76 | 1 | 300ns | $IMPLEMENTED_BY = 'File::HomeDir::FreeDesktop'; | ||
77 | } else { | ||||
78 | # Default to Unix semantics | ||||
79 | $IMPLEMENTED_BY = 'File::HomeDir::Unix'; | ||||
80 | } | ||||
81 | 1 | 2µs | 1 | 1.33ms | unless ( _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 | |||||
92 | sub my_home { | ||||
93 | $IMPLEMENTED_BY->my_home; | ||||
94 | } | ||||
95 | |||||
96 | sub 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 | |||||
102 | sub 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 | |||||
108 | sub 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 | |||||
114 | sub 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 | |||||
120 | sub 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 | |||||
126 | sub 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 | |||||
133 | sub 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 | |||||
159 | sub 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 | |||||
195 | sub 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 | |||||
201 | sub 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 | |||||
207 | sub 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 | |||||
213 | sub 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 | |||||
219 | sub 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 | |||||
225 | sub 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 | |||||
231 | sub 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 | ||||
245 | sub 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 | |||||
282 | CLASS: { | ||||
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??? | ||||
289 | 1 | 700ns | my $SINGLETON = bless {}; | ||
290 | |||||
291 | 1 | 3µs | # spent 700ns within File::HomeDir::TIE::TIEHASH which was called:
# once (700ns+0s) by BenchmarkAnything::Config::_read_config at line 322 | ||
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 | ||||
322 | 2 | 4µs | 1 | 700ns | tie %~, 'File::HomeDir::TIE'; # spent 700ns making 1 call to File::HomeDir::TIE::TIEHASH |
323 | |||||
324 | 1 | 7µs | 1; | ||
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 |