| 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 | File::HomeDir::BEGIN@9 |
| 1 | 1 | 1 | 540µs | 712µs | File::HomeDir::BEGIN@10 |
| 1 | 1 | 1 | 430µs | 1.33ms | File::HomeDir::_DRIVER |
| 1 | 1 | 1 | 16µs | 76µs | File::HomeDir::BEGIN@13 |
| 1 | 1 | 1 | 9µs | 9µs | File::HomeDir::BEGIN@5 |
| 1 | 1 | 1 | 8µs | 8µs | File::HomeDir::BEGIN@14 |
| 1 | 1 | 1 | 5µs | 6µs | File::HomeDir::BEGIN@6 |
| 1 | 1 | 1 | 4µs | 4µs | File::HomeDir::CORE:match (opcode) |
| 1 | 1 | 1 | 4µs | 9µs | File::HomeDir::_CLASS |
| 1 | 1 | 1 | 2µs | 2µs | File::HomeDir::BEGIN@7 |
| 1 | 1 | 1 | 2µs | 2µs | File::HomeDir::BEGIN@8 |
| 1 | 1 | 1 | 700ns | 700ns | File::HomeDir::TIE::TIEHASH |
| 0 | 0 | 0 | 0s | 0s | File::HomeDir::TIE::CLEAR |
| 0 | 0 | 0 | 0s | 0s | File::HomeDir::TIE::DELETE |
| 0 | 0 | 0 | 0s | 0s | File::HomeDir::TIE::EXISTS |
| 0 | 0 | 0 | 0s | 0s | File::HomeDir::TIE::FETCH |
| 0 | 0 | 0 | 0s | 0s | File::HomeDir::TIE::FIRSTKEY |
| 0 | 0 | 0 | 0s | 0s | File::HomeDir::TIE::NEXTKEY |
| 0 | 0 | 0 | 0s | 0s | File::HomeDir::TIE::STORE |
| 0 | 0 | 0 | 0s | 0s | File::HomeDir::TIE::_bad |
| 0 | 0 | 0 | 0s | 0s | File::HomeDir::home |
| 0 | 0 | 0 | 0s | 0s | File::HomeDir::my_data |
| 0 | 0 | 0 | 0s | 0s | File::HomeDir::my_desktop |
| 0 | 0 | 0 | 0s | 0s | File::HomeDir::my_dist_config |
| 0 | 0 | 0 | 0s | 0s | File::HomeDir::my_dist_data |
| 0 | 0 | 0 | 0s | 0s | File::HomeDir::my_documents |
| 0 | 0 | 0 | 0s | 0s | File::HomeDir::my_home |
| 0 | 0 | 0 | 0s | 0s | File::HomeDir::my_music |
| 0 | 0 | 0 | 0s | 0s | File::HomeDir::my_pictures |
| 0 | 0 | 0 | 0s | 0s | File::HomeDir::my_videos |
| 0 | 0 | 0 | 0s | 0s | File::HomeDir::users_data |
| 0 | 0 | 0 | 0s | 0s | File::HomeDir::users_desktop |
| 0 | 0 | 0 | 0s | 0s | File::HomeDir::users_documents |
| 0 | 0 | 0 | 0s | 0s | File::HomeDir::users_home |
| 0 | 0 | 0 | 0s | 0s | File::HomeDir::users_music |
| 0 | 0 | 0 | 0s | 0s | File::HomeDir::users_pictures |
| 0 | 0 | 0 | 0s | 0s | File::HomeDir::users_videos |
| 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 |