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); |
35a60386 |
22 | $VERSION = "1.05"; |
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) = @_; |
41 | closedir($dh); |
42 | } |
43 | |
44 | sub open { |
45 | @_ == 2 or croak 'usage: $dh->open(DIRNAME)'; |
46 | my ($dh, $dirname) = @_; |
47 | return undef |
48 | unless opendir($dh, $dirname); |
6c254d95 |
49 | # a dir name should always have a ":" in it; assume dirname is |
50 | # in current directory |
51 | $dirname = ':' . $dirname if ( ($^O eq 'MacOS') && ($dirname !~ /:/) ); |
cf7fe8a2 |
52 | ${*$dh}{io_dir_path} = $dirname; |
53 | 1; |
54 | } |
55 | |
56 | sub close { |
57 | @_ == 1 or croak 'usage: $dh->close()'; |
58 | my ($dh) = @_; |
59 | closedir($dh); |
60 | } |
61 | |
62 | sub read { |
63 | @_ == 1 or croak 'usage: $dh->read()'; |
64 | my ($dh) = @_; |
65 | readdir($dh); |
66 | } |
67 | |
68 | sub seek { |
69 | @_ == 2 or croak 'usage: $dh->seek(POS)'; |
70 | my ($dh,$pos) = @_; |
71 | seekdir($dh,$pos); |
72 | } |
73 | |
74 | sub tell { |
75 | @_ == 1 or croak 'usage: $dh->tell()'; |
76 | my ($dh) = @_; |
77 | telldir($dh); |
78 | } |
79 | |
80 | sub rewind { |
81 | @_ == 1 or croak 'usage: $dh->rewind()'; |
82 | my ($dh) = @_; |
83 | rewinddir($dh); |
84 | } |
85 | |
86 | sub TIEHASH { |
87 | my($class,$dir,$options) = @_; |
88 | |
89 | my $dh = $class->new($dir) |
90 | or return undef; |
91 | |
92 | $options ||= 0; |
93 | |
94 | ${*$dh}{io_dir_unlink} = $options & DIR_UNLINK; |
95 | $dh; |
96 | } |
97 | |
98 | sub FIRSTKEY { |
99 | my($dh) = @_; |
100 | $dh->rewind; |
101 | scalar $dh->read; |
102 | } |
103 | |
104 | sub NEXTKEY { |
105 | my($dh) = @_; |
106 | scalar $dh->read; |
107 | } |
108 | |
109 | sub EXISTS { |
110 | my($dh,$key) = @_; |
6c254d95 |
111 | -e File::Spec->catfile(${*$dh}{io_dir_path}, $key); |
cf7fe8a2 |
112 | } |
113 | |
114 | sub FETCH { |
115 | my($dh,$key) = @_; |
6c254d95 |
116 | &lstat(File::Spec->catfile(${*$dh}{io_dir_path}, $key)); |
cf7fe8a2 |
117 | } |
118 | |
119 | sub STORE { |
120 | my($dh,$key,$data) = @_; |
121 | my($atime,$mtime) = ref($data) ? @$data : ($data,$data); |
6c254d95 |
122 | my $file = File::Spec->catfile(${*$dh}{io_dir_path}, $key); |
cf7fe8a2 |
123 | unless(-e $file) { |
124 | my $io = IO::File->new($file,O_CREAT | O_RDWR); |
125 | $io->close if $io; |
126 | } |
127 | utime($atime,$mtime, $file); |
128 | } |
129 | |
130 | sub DELETE { |
131 | my($dh,$key) = @_; |
cf7fe8a2 |
132 | |
c936d284 |
133 | # Only unlink if unlink-ing is enabled |
cf7fe8a2 |
134 | return 0 |
135 | unless ${*$dh}{io_dir_unlink}; |
136 | |
c936d284 |
137 | my $file = File::Spec->catfile(${*$dh}{io_dir_path}, $key); |
138 | |
cf7fe8a2 |
139 | -d $file |
140 | ? rmdir($file) |
141 | : unlink($file); |
142 | } |
143 | |
144 | 1; |
145 | |
146 | __END__ |
147 | |
148 | =head1 NAME |
149 | |
150 | IO::Dir - supply object methods for directory handles |
151 | |
152 | =head1 SYNOPSIS |
153 | |
154 | use IO::Dir; |
c936d284 |
155 | $d = IO::Dir->new("."); |
cf7fe8a2 |
156 | if (defined $d) { |
157 | while (defined($_ = $d->read)) { something($_); } |
158 | $d->rewind; |
159 | while (defined($_ = $d->read)) { something_else($_); } |
160 | undef $d; |
161 | } |
162 | |
c936d284 |
163 | tie %dir, 'IO::Dir', "."; |
cf7fe8a2 |
164 | foreach (keys %dir) { |
165 | print $_, " " , $dir{$_}->size,"\n"; |
166 | } |
167 | |
168 | =head1 DESCRIPTION |
169 | |
170 | The C<IO::Dir> package provides two interfaces to perl's directory reading |
171 | routines. |
172 | |
173 | The first interface is an object approach. C<IO::Dir> provides an object |
174 | constructor and methods, which are just wrappers around perl's built in |
175 | directory reading routines. |
176 | |
177 | =over 4 |
178 | |
179 | =item new ( [ DIRNAME ] ) |
180 | |
3c4b39be |
181 | C<new> is the constructor for C<IO::Dir> objects. It accepts one optional |
cf7fe8a2 |
182 | argument which, if given, C<new> will pass to C<open> |
183 | |
184 | =back |
185 | |
186 | The following methods are wrappers for the directory related functions built |
187 | into perl (the trailing `dir' has been removed from the names). See L<perlfunc> |
188 | for details of these functions. |
189 | |
190 | =over 4 |
191 | |
192 | =item open ( DIRNAME ) |
193 | |
194 | =item read () |
195 | |
196 | =item seek ( POS ) |
197 | |
198 | =item tell () |
199 | |
200 | =item rewind () |
201 | |
202 | =item close () |
203 | |
204 | =back |
205 | |
d1be9408 |
206 | C<IO::Dir> also provides an interface to reading directories via a tied |
c936d284 |
207 | hash. The tied hash extends the interface beyond just the directory |
cf7fe8a2 |
208 | reading routines by the use of C<lstat>, from the C<File::stat> package, |
209 | C<unlink>, C<rmdir> and C<utime>. |
210 | |
211 | =over 4 |
212 | |
c936d284 |
213 | =item tie %hash, 'IO::Dir', DIRNAME [, OPTIONS ] |
cf7fe8a2 |
214 | |
215 | =back |
216 | |
c936d284 |
217 | The keys of the hash will be the names of the entries in the directory. |
cf7fe8a2 |
218 | Reading a value from the hash will be the result of calling |
c936d284 |
219 | C<File::stat::lstat>. Deleting an element from the hash will |
220 | delete the corresponding file or subdirectory, |
221 | provided that C<DIR_UNLINK> is included in the C<OPTIONS>. |
cf7fe8a2 |
222 | |
c936d284 |
223 | Assigning to an entry in the hash will cause the time stamps of the file |
cf7fe8a2 |
224 | to be modified. If the file does not exist then it will be created. Assigning |
c936d284 |
225 | a single integer to a hash element will cause both the access and |
cf7fe8a2 |
226 | modification times to be changed to that value. Alternatively a reference to |
227 | an array of two values can be passed. The first array element will be used to |
228 | set the access time and the second element will be used to set the modification |
229 | time. |
230 | |
231 | =head1 SEE ALSO |
232 | |
233 | L<File::stat> |
234 | |
235 | =head1 AUTHOR |
236 | |
854822f1 |
237 | Graham Barr. Currently maintained by the Perl Porters. Please report all |
238 | bugs to <perl5-porters@perl.org>. |
cf7fe8a2 |
239 | |
240 | =head1 COPYRIGHT |
241 | |
c936d284 |
242 | Copyright (c) 1997-2003 Graham Barr <gbarr@pobox.com>. All rights reserved. |
cf7fe8a2 |
243 | This program is free software; you can redistribute it and/or |
244 | modify it under the same terms as Perl itself. |
245 | |
246 | =cut |