| Filename | /usr/lib/perl/5.18/IO/Dir.pm |
| Statements | Executed 26 statements in 1.10ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 564µs | 680µs | IO::Dir::BEGIN@17 |
| 1 | 1 | 1 | 521µs | 3.85ms | IO::Dir::BEGIN@15 |
| 1 | 1 | 1 | 504µs | 547µs | IO::Dir::BEGIN@13 |
| 1 | 1 | 1 | 15µs | 61µs | IO::Dir::BEGIN@18 |
| 1 | 1 | 1 | 15µs | 15µs | IO::Dir::BEGIN@9 |
| 1 | 1 | 1 | 9µs | 9µs | IO::Dir::BEGIN@19 |
| 1 | 1 | 1 | 9µs | 20µs | IO::Dir::BEGIN@42 |
| 1 | 1 | 1 | 7µs | 18µs | IO::Dir::BEGIN@14 |
| 1 | 1 | 1 | 6µs | 39µs | IO::Dir::BEGIN@12 |
| 1 | 1 | 1 | 6µs | 16µs | IO::Dir::BEGIN@11 |
| 0 | 0 | 0 | 0s | 0s | IO::Dir::DELETE |
| 0 | 0 | 0 | 0s | 0s | IO::Dir::DESTROY |
| 0 | 0 | 0 | 0s | 0s | IO::Dir::EXISTS |
| 0 | 0 | 0 | 0s | 0s | IO::Dir::FETCH |
| 0 | 0 | 0 | 0s | 0s | IO::Dir::FIRSTKEY |
| 0 | 0 | 0 | 0s | 0s | IO::Dir::NEXTKEY |
| 0 | 0 | 0 | 0s | 0s | IO::Dir::STORE |
| 0 | 0 | 0 | 0s | 0s | IO::Dir::TIEHASH |
| 0 | 0 | 0 | 0s | 0s | IO::Dir::close |
| 0 | 0 | 0 | 0s | 0s | IO::Dir::new |
| 0 | 0 | 0 | 0s | 0s | IO::Dir::open |
| 0 | 0 | 0 | 0s | 0s | IO::Dir::read |
| 0 | 0 | 0 | 0s | 0s | IO::Dir::rewind |
| 0 | 0 | 0 | 0s | 0s | IO::Dir::seek |
| 0 | 0 | 0 | 0s | 0s | IO::Dir::tell |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | # IO::Dir.pm | ||||
| 2 | # | ||||
| 3 | # Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved. | ||||
| 4 | # This program is free software; you can redistribute it and/or | ||||
| 5 | # modify it under the same terms as Perl itself. | ||||
| 6 | |||||
| 7 | package IO::Dir; | ||||
| 8 | |||||
| 9 | 2 | 41µs | 1 | 15µs | # spent 15µs within IO::Dir::BEGIN@9 which was called:
# once (15µs+0s) by Path::Class::Dir::BEGIN@12 at line 9 # spent 15µs making 1 call to IO::Dir::BEGIN@9 |
| 10 | |||||
| 11 | 2 | 21µs | 2 | 27µs | # spent 16µs (6+10) within IO::Dir::BEGIN@11 which was called:
# once (6µs+10µs) by Path::Class::Dir::BEGIN@12 at line 11 # spent 16µs making 1 call to IO::Dir::BEGIN@11
# spent 10µs making 1 call to strict::import |
| 12 | 2 | 19µs | 2 | 72µs | # spent 39µs (6+33) within IO::Dir::BEGIN@12 which was called:
# once (6µs+33µs) by Path::Class::Dir::BEGIN@12 at line 12 # spent 39µs making 1 call to IO::Dir::BEGIN@12
# spent 33µs making 1 call to Exporter::import |
| 13 | 2 | 81µs | 2 | 579µs | # spent 547µs (504+43) within IO::Dir::BEGIN@13 which was called:
# once (504µs+43µs) by Path::Class::Dir::BEGIN@12 at line 13 # spent 547µs making 1 call to IO::Dir::BEGIN@13
# spent 33µs making 1 call to Exporter::import |
| 14 | 2 | 18µs | 2 | 30µs | # spent 18µs (7+11) within IO::Dir::BEGIN@14 which was called:
# once (7µs+11µs) by Path::Class::Dir::BEGIN@12 at line 14 # spent 18µs making 1 call to IO::Dir::BEGIN@14
# spent 11µs making 1 call to Exporter::import |
| 15 | 2 | 90µs | 2 | 3.93ms | # spent 3.85ms (521µs+3.33) within IO::Dir::BEGIN@15 which was called:
# once (521µs+3.33ms) by Path::Class::Dir::BEGIN@12 at line 15 # spent 3.85ms making 1 call to IO::Dir::BEGIN@15
# spent 83µs making 1 call to Exporter::import |
| 16 | 1 | 300ns | our(@ISA, $VERSION, @EXPORT_OK); | ||
| 17 | 2 | 116µs | 1 | 680µs | # spent 680µs (564+116) within IO::Dir::BEGIN@17 which was called:
# once (564µs+116µs) by Path::Class::Dir::BEGIN@12 at line 17 # spent 680µs making 1 call to IO::Dir::BEGIN@17 |
| 18 | 2 | 36µs | 2 | 67µs | # spent 61µs (15+46) within IO::Dir::BEGIN@18 which was called:
# once (15µs+46µs) by Path::Class::Dir::BEGIN@12 at line 18 # spent 61µs making 1 call to IO::Dir::BEGIN@18
# spent 6µs making 1 call to File::stat::import |
| 19 | 2 | 177µs | 1 | 9µs | # spent 9µs within IO::Dir::BEGIN@19 which was called:
# once (9µs+0s) by Path::Class::Dir::BEGIN@12 at line 19 # spent 9µs making 1 call to IO::Dir::BEGIN@19 |
| 20 | |||||
| 21 | 1 | 6µs | @ISA = qw(Tie::Hash Exporter); | ||
| 22 | 1 | 200ns | $VERSION = "1.10"; | ||
| 23 | 1 | 10µs | $VERSION = eval $VERSION; # spent 2µs executing statements in string eval | ||
| 24 | 1 | 500ns | @EXPORT_OK = qw(DIR_UNLINK); | ||
| 25 | |||||
| 26 | sub DIR_UNLINK () { 1 } | ||||
| 27 | |||||
| 28 | sub new { | ||||
| 29 | @_ >= 1 && @_ <= 2 or croak 'usage: IO::Dir->new([DIRNAME])'; | ||||
| 30 | my $class = shift; | ||||
| 31 | my $dh = gensym; | ||||
| 32 | if (@_) { | ||||
| 33 | IO::Dir::open($dh, $_[0]) | ||||
| 34 | or return undef; | ||||
| 35 | } | ||||
| 36 | bless $dh, $class; | ||||
| 37 | } | ||||
| 38 | |||||
| 39 | sub DESTROY { | ||||
| 40 | my ($dh) = @_; | ||||
| 41 | local($., $@, $!, $^E, $?); | ||||
| 42 | 2 | 482µs | 2 | 31µs | # spent 20µs (9+11) within IO::Dir::BEGIN@42 which was called:
# once (9µs+11µs) by Path::Class::Dir::BEGIN@12 at line 42 # spent 20µs making 1 call to IO::Dir::BEGIN@42
# spent 11µs making 1 call to warnings::unimport |
| 43 | closedir($dh); | ||||
| 44 | } | ||||
| 45 | |||||
| 46 | sub open { | ||||
| 47 | @_ == 2 or croak 'usage: $dh->open(DIRNAME)'; | ||||
| 48 | my ($dh, $dirname) = @_; | ||||
| 49 | return undef | ||||
| 50 | unless opendir($dh, $dirname); | ||||
| 51 | # a dir name should always have a ":" in it; assume dirname is | ||||
| 52 | # in current directory | ||||
| 53 | $dirname = ':' . $dirname if ( ($^O eq 'MacOS') && ($dirname !~ /:/) ); | ||||
| 54 | ${*$dh}{io_dir_path} = $dirname; | ||||
| 55 | 1; | ||||
| 56 | } | ||||
| 57 | |||||
| 58 | sub close { | ||||
| 59 | @_ == 1 or croak 'usage: $dh->close()'; | ||||
| 60 | my ($dh) = @_; | ||||
| 61 | closedir($dh); | ||||
| 62 | } | ||||
| 63 | |||||
| 64 | sub read { | ||||
| 65 | @_ == 1 or croak 'usage: $dh->read()'; | ||||
| 66 | my ($dh) = @_; | ||||
| 67 | readdir($dh); | ||||
| 68 | } | ||||
| 69 | |||||
| 70 | sub seek { | ||||
| 71 | @_ == 2 or croak 'usage: $dh->seek(POS)'; | ||||
| 72 | my ($dh,$pos) = @_; | ||||
| 73 | seekdir($dh,$pos); | ||||
| 74 | } | ||||
| 75 | |||||
| 76 | sub tell { | ||||
| 77 | @_ == 1 or croak 'usage: $dh->tell()'; | ||||
| 78 | my ($dh) = @_; | ||||
| 79 | telldir($dh); | ||||
| 80 | } | ||||
| 81 | |||||
| 82 | sub rewind { | ||||
| 83 | @_ == 1 or croak 'usage: $dh->rewind()'; | ||||
| 84 | my ($dh) = @_; | ||||
| 85 | rewinddir($dh); | ||||
| 86 | } | ||||
| 87 | |||||
| 88 | sub TIEHASH { | ||||
| 89 | my($class,$dir,$options) = @_; | ||||
| 90 | |||||
| 91 | my $dh = $class->new($dir) | ||||
| 92 | or return undef; | ||||
| 93 | |||||
| 94 | $options ||= 0; | ||||
| 95 | |||||
| 96 | ${*$dh}{io_dir_unlink} = $options & DIR_UNLINK; | ||||
| 97 | $dh; | ||||
| 98 | } | ||||
| 99 | |||||
| 100 | sub FIRSTKEY { | ||||
| 101 | my($dh) = @_; | ||||
| 102 | $dh->rewind; | ||||
| 103 | scalar $dh->read; | ||||
| 104 | } | ||||
| 105 | |||||
| 106 | sub NEXTKEY { | ||||
| 107 | my($dh) = @_; | ||||
| 108 | scalar $dh->read; | ||||
| 109 | } | ||||
| 110 | |||||
| 111 | sub EXISTS { | ||||
| 112 | my($dh,$key) = @_; | ||||
| 113 | -e File::Spec->catfile(${*$dh}{io_dir_path}, $key); | ||||
| 114 | } | ||||
| 115 | |||||
| 116 | sub FETCH { | ||||
| 117 | my($dh,$key) = @_; | ||||
| 118 | &lstat(File::Spec->catfile(${*$dh}{io_dir_path}, $key)); | ||||
| 119 | } | ||||
| 120 | |||||
| 121 | sub STORE { | ||||
| 122 | my($dh,$key,$data) = @_; | ||||
| 123 | my($atime,$mtime) = ref($data) ? @$data : ($data,$data); | ||||
| 124 | my $file = File::Spec->catfile(${*$dh}{io_dir_path}, $key); | ||||
| 125 | unless(-e $file) { | ||||
| 126 | my $io = IO::File->new($file,O_CREAT | O_RDWR); | ||||
| 127 | $io->close if $io; | ||||
| 128 | } | ||||
| 129 | utime($atime,$mtime, $file); | ||||
| 130 | } | ||||
| 131 | |||||
| 132 | sub DELETE { | ||||
| 133 | my($dh,$key) = @_; | ||||
| 134 | |||||
| 135 | # Only unlink if unlink-ing is enabled | ||||
| 136 | return 0 | ||||
| 137 | unless ${*$dh}{io_dir_unlink}; | ||||
| 138 | |||||
| 139 | my $file = File::Spec->catfile(${*$dh}{io_dir_path}, $key); | ||||
| 140 | |||||
| 141 | -d $file | ||||
| 142 | ? rmdir($file) | ||||
| 143 | : unlink($file); | ||||
| 144 | } | ||||
| 145 | |||||
| 146 | 1 | 3µs | 1; | ||
| 147 | |||||
| 148 | __END__ |