Commit | Line | Data |
cf7fe8a2 |
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 | |
3b825e41 |
9 | use 5.006; |
cf7fe8a2 |
10 | |
11 | use strict; |
12 | use Carp; |
13 | use Symbol; |
14 | use Exporter; |
15 | use IO::File; |
17f410f9 |
16 | our(@ISA, $VERSION, @EXPORT_OK); |
cf7fe8a2 |
17 | use Tie::Hash; |
18 | use File::stat; |
6c254d95 |
19 | use File::Spec; |
cf7fe8a2 |
20 | |
21 | @ISA = qw(Tie::Hash Exporter); |
6f86311f |
22 | $VERSION = "1.06_01"; |
105cd853 |
23 | $VERSION = eval $VERSION; |
cf7fe8a2 |
24 | @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) = @_; |
bc3f1c14 |
41 | local($., $@, $!, $^E, $?); |
7692a1ed |
42 | no warnings 'io'; |
cf7fe8a2 |
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); |
6c254d95 |
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 !~ /:/) ); |
cf7fe8a2 |
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) = @_; |
6c254d95 |
113 | -e File::Spec->catfile(${*$dh}{io_dir_path}, $key); |
cf7fe8a2 |
114 | } |
115 | |
116 | sub FETCH { |
117 | my($dh,$key) = @_; |
6c254d95 |
118 | &lstat(File::Spec->catfile(${*$dh}{io_dir_path}, $key)); |
cf7fe8a2 |
119 | } |
120 | |
121 | sub STORE { |
122 | my($dh,$key,$data) = @_; |
123 | my($atime,$mtime) = ref($data) ? @$data : ($data,$data); |
6c254d95 |
124 | my $file = File::Spec->catfile(${*$dh}{io_dir_path}, $key); |
cf7fe8a2 |
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) = @_; |
cf7fe8a2 |
134 | |
c936d284 |
135 | # Only unlink if unlink-ing is enabled |
cf7fe8a2 |
136 | return 0 |
137 | unless ${*$dh}{io_dir_unlink}; |
138 | |
c936d284 |
139 | my $file = File::Spec->catfile(${*$dh}{io_dir_path}, $key); |
140 | |
cf7fe8a2 |
141 | -d $file |
142 | ? rmdir($file) |
143 | : unlink($file); |
144 | } |
145 | |
146 | 1; |
147 | |
148 | __END__ |
149 | |
150 | =head1 NAME |
151 | |
152 | IO::Dir - supply object methods for directory handles |
153 | |
154 | =head1 SYNOPSIS |
155 | |
156 | use IO::Dir; |
c936d284 |
157 | $d = IO::Dir->new("."); |
cf7fe8a2 |
158 | if (defined $d) { |
159 | while (defined($_ = $d->read)) { something($_); } |
160 | $d->rewind; |
161 | while (defined($_ = $d->read)) { something_else($_); } |
162 | undef $d; |
163 | } |
164 | |
c936d284 |
165 | tie %dir, 'IO::Dir', "."; |
cf7fe8a2 |
166 | foreach (keys %dir) { |
167 | print $_, " " , $dir{$_}->size,"\n"; |
168 | } |
169 | |
170 | =head1 DESCRIPTION |
171 | |
172 | The C<IO::Dir> package provides two interfaces to perl's directory reading |
173 | routines. |
174 | |
175 | The first interface is an object approach. C<IO::Dir> provides an object |
176 | constructor and methods, which are just wrappers around perl's built in |
177 | directory reading routines. |
178 | |
179 | =over 4 |
180 | |
181 | =item new ( [ DIRNAME ] ) |
182 | |
3c4b39be |
183 | C<new> is the constructor for C<IO::Dir> objects. It accepts one optional |
cf7fe8a2 |
184 | argument which, if given, C<new> will pass to C<open> |
185 | |
186 | =back |
187 | |
188 | The following methods are wrappers for the directory related functions built |
189 | into perl (the trailing `dir' has been removed from the names). See L<perlfunc> |
190 | for details of these functions. |
191 | |
192 | =over 4 |
193 | |
194 | =item open ( DIRNAME ) |
195 | |
196 | =item read () |
197 | |
198 | =item seek ( POS ) |
199 | |
200 | =item tell () |
201 | |
202 | =item rewind () |
203 | |
204 | =item close () |
205 | |
206 | =back |
207 | |
d1be9408 |
208 | C<IO::Dir> also provides an interface to reading directories via a tied |
c936d284 |
209 | hash. The tied hash extends the interface beyond just the directory |
cf7fe8a2 |
210 | reading routines by the use of C<lstat>, from the C<File::stat> package, |
211 | C<unlink>, C<rmdir> and C<utime>. |
212 | |
213 | =over 4 |
214 | |
c936d284 |
215 | =item tie %hash, 'IO::Dir', DIRNAME [, OPTIONS ] |
cf7fe8a2 |
216 | |
217 | =back |
218 | |
c936d284 |
219 | The keys of the hash will be the names of the entries in the directory. |
cf7fe8a2 |
220 | Reading a value from the hash will be the result of calling |
c936d284 |
221 | C<File::stat::lstat>. Deleting an element from the hash will |
222 | delete the corresponding file or subdirectory, |
223 | provided that C<DIR_UNLINK> is included in the C<OPTIONS>. |
cf7fe8a2 |
224 | |
c936d284 |
225 | Assigning to an entry in the hash will cause the time stamps of the file |
cf7fe8a2 |
226 | to be modified. If the file does not exist then it will be created. Assigning |
c936d284 |
227 | a single integer to a hash element will cause both the access and |
cf7fe8a2 |
228 | modification times to be changed to that value. Alternatively a reference to |
229 | an array of two values can be passed. The first array element will be used to |
230 | set the access time and the second element will be used to set the modification |
231 | time. |
232 | |
233 | =head1 SEE ALSO |
234 | |
235 | L<File::stat> |
236 | |
237 | =head1 AUTHOR |
238 | |
854822f1 |
239 | Graham Barr. Currently maintained by the Perl Porters. Please report all |
240 | bugs to <perl5-porters@perl.org>. |
cf7fe8a2 |
241 | |
242 | =head1 COPYRIGHT |
243 | |
c936d284 |
244 | Copyright (c) 1997-2003 Graham Barr <gbarr@pobox.com>. All rights reserved. |
cf7fe8a2 |
245 | This program is free software; you can redistribute it and/or |
246 | modify it under the same terms as Perl itself. |
247 | |
248 | =cut |