Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/5.12.3/x86_64-linux/IO/Dir.pm |
Statements | Executed 36 statements in 895µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 1.59ms | 5.25ms | BEGIN@18 | IO::Dir::
1 | 1 | 1 | 33µs | 33µs | BEGIN@9 | IO::Dir::
1 | 1 | 1 | 16µs | 32µs | BEGIN@42 | IO::Dir::
1 | 1 | 1 | 11µs | 166µs | BEGIN@15 | IO::Dir::
1 | 1 | 1 | 9µs | 43µs | BEGIN@13 | IO::Dir::
1 | 1 | 1 | 8µs | 8µs | BEGIN@17 | IO::Dir::
1 | 1 | 1 | 7µs | 18µs | BEGIN@14 | IO::Dir::
1 | 1 | 1 | 7µs | 38µs | BEGIN@12 | IO::Dir::
1 | 1 | 1 | 7µs | 7µs | BEGIN@19 | IO::Dir::
1 | 1 | 1 | 6µs | 8µs | BEGIN@11 | IO::Dir::
0 | 0 | 0 | 0s | 0s | DELETE | IO::Dir::
0 | 0 | 0 | 0s | 0s | DESTROY | IO::Dir::
0 | 0 | 0 | 0s | 0s | EXISTS | IO::Dir::
0 | 0 | 0 | 0s | 0s | FETCH | IO::Dir::
0 | 0 | 0 | 0s | 0s | FIRSTKEY | IO::Dir::
0 | 0 | 0 | 0s | 0s | NEXTKEY | IO::Dir::
0 | 0 | 0 | 0s | 0s | STORE | IO::Dir::
0 | 0 | 0 | 0s | 0s | TIEHASH | IO::Dir::
0 | 0 | 0 | 0s | 0s | close | IO::Dir::
0 | 0 | 0 | 0s | 0s | new | IO::Dir::
0 | 0 | 0 | 0s | 0s | open | IO::Dir::
0 | 0 | 0 | 0s | 0s | read | IO::Dir::
0 | 0 | 0 | 0s | 0s | rewind | IO::Dir::
0 | 0 | 0 | 0s | 0s | seek | IO::Dir::
0 | 0 | 0 | 0s | 0s | tell | IO::Dir::
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 | 3 | 42µs | 1 | 33µs | # spent 33µs within IO::Dir::BEGIN@9 which was called:
# once (33µs+0s) by SQL::Translator::BEGIN@37 at line 9 # spent 33µs making 1 call to IO::Dir::BEGIN@9 |
10 | |||||
11 | 3 | 16µs | 2 | 9µs | # spent 8µs (6+2) within IO::Dir::BEGIN@11 which was called:
# once (6µs+2µs) by SQL::Translator::BEGIN@37 at line 11 # spent 8µs making 1 call to IO::Dir::BEGIN@11
# spent 2µs making 1 call to strict::import |
12 | 3 | 16µs | 2 | 68µs | # spent 38µs (7+31) within IO::Dir::BEGIN@12 which was called:
# once (7µs+31µs) by SQL::Translator::BEGIN@37 at line 12 # spent 38µs making 1 call to IO::Dir::BEGIN@12
# spent 31µs making 1 call to Exporter::import |
13 | 3 | 19µs | 2 | 76µs | # spent 43µs (9+33) within IO::Dir::BEGIN@13 which was called:
# once (9µs+33µs) by SQL::Translator::BEGIN@37 at line 13 # spent 43µs making 1 call to IO::Dir::BEGIN@13
# spent 33µs making 1 call to Exporter::import |
14 | 3 | 16µs | 2 | 28µs | # spent 18µs (7+10) within IO::Dir::BEGIN@14 which was called:
# once (7µs+10µs) by SQL::Translator::BEGIN@37 at line 14 # spent 18µs making 1 call to IO::Dir::BEGIN@14
# spent 10µs making 1 call to Exporter::import |
15 | 3 | 33µs | 2 | 321µs | # spent 166µs (11+155) within IO::Dir::BEGIN@15 which was called:
# once (11µs+155µs) by SQL::Translator::BEGIN@37 at line 15 # spent 166µs making 1 call to IO::Dir::BEGIN@15
# spent 155µs making 1 call to Exporter::import |
16 | 1 | 400ns | our(@ISA, $VERSION, @EXPORT_OK); | ||
17 | 3 | 20µs | 1 | 8µs | # spent 8µs within IO::Dir::BEGIN@17 which was called:
# once (8µs+0s) by SQL::Translator::BEGIN@37 at line 17 # spent 8µs making 1 call to IO::Dir::BEGIN@17 |
18 | 3 | 87µs | 2 | 5.25ms | # spent 5.25ms (1.59+3.66) within IO::Dir::BEGIN@18 which was called:
# once (1.59ms+3.66ms) by SQL::Translator::BEGIN@37 at line 18 # spent 5.25ms making 1 call to IO::Dir::BEGIN@18
# spent 2µs making 1 call to File::stat::import |
19 | 3 | 119µs | 1 | 7µs | # spent 7µs within IO::Dir::BEGIN@19 which was called:
# once (7µs+0s) by SQL::Translator::BEGIN@37 at line 19 # spent 7µs making 1 call to IO::Dir::BEGIN@19 |
20 | |||||
21 | 1 | 34µs | @ISA = qw(Tie::Hash Exporter); | ||
22 | 1 | 600ns | $VERSION = "1.07"; | ||
23 | 1 | 20µs | $VERSION = eval $VERSION; # spent 2µs executing statements in string eval | ||
24 | 1 | 800ns | @EXPORT_OK = qw(DIR_UNLINK); | ||
25 | |||||
26 | sub DIR_UNLINK () { 1 } | ||||
27 | |||||
28 | sub new { | ||||
29 | @_ >= 1 && @_ <= 2 or croak 'usage: new IO::Dir [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 | 3 | 468µs | 2 | 48µs | # spent 32µs (16+16) within IO::Dir::BEGIN@42 which was called:
# once (16µs+16µs) by SQL::Translator::BEGIN@37 at line 42 # spent 32µs making 1 call to IO::Dir::BEGIN@42
# spent 16µ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 | 4µs | 1; | ||
147 | |||||
148 | __END__ |