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); |
76fbd8c4 |
22 | $VERSION = "1.03_00"; |
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) = @_; |
132 | # Only unlink if unlink-ing is enabled |
6c254d95 |
133 | my $file = File::Spec->catfile(${*$dh}{io_dir_path}, $key); |
cf7fe8a2 |
134 | |
135 | return 0 |
136 | unless ${*$dh}{io_dir_unlink}; |
137 | |
138 | -d $file |
139 | ? rmdir($file) |
140 | : unlink($file); |
141 | } |
142 | |
143 | 1; |
144 | |
145 | __END__ |
146 | |
147 | =head1 NAME |
148 | |
149 | IO::Dir - supply object methods for directory handles |
150 | |
151 | =head1 SYNOPSIS |
152 | |
153 | use IO::Dir; |
154 | $d = new IO::Dir "."; |
155 | if (defined $d) { |
156 | while (defined($_ = $d->read)) { something($_); } |
157 | $d->rewind; |
158 | while (defined($_ = $d->read)) { something_else($_); } |
159 | undef $d; |
160 | } |
161 | |
162 | tie %dir, IO::Dir, "."; |
163 | foreach (keys %dir) { |
164 | print $_, " " , $dir{$_}->size,"\n"; |
165 | } |
166 | |
167 | =head1 DESCRIPTION |
168 | |
169 | The C<IO::Dir> package provides two interfaces to perl's directory reading |
170 | routines. |
171 | |
172 | The first interface is an object approach. C<IO::Dir> provides an object |
173 | constructor and methods, which are just wrappers around perl's built in |
174 | directory reading routines. |
175 | |
176 | =over 4 |
177 | |
178 | =item new ( [ DIRNAME ] ) |
179 | |
180 | C<new> is the constuctor for C<IO::Dir> objects. It accepts one optional |
181 | argument which, if given, C<new> will pass to C<open> |
182 | |
183 | =back |
184 | |
185 | The following methods are wrappers for the directory related functions built |
186 | into perl (the trailing `dir' has been removed from the names). See L<perlfunc> |
187 | for details of these functions. |
188 | |
189 | =over 4 |
190 | |
191 | =item open ( DIRNAME ) |
192 | |
193 | =item read () |
194 | |
195 | =item seek ( POS ) |
196 | |
197 | =item tell () |
198 | |
199 | =item rewind () |
200 | |
201 | =item close () |
202 | |
203 | =back |
204 | |
d1be9408 |
205 | C<IO::Dir> also provides an interface to reading directories via a tied |
cf7fe8a2 |
206 | HASH. The tied HASH extends the interface beyond just the directory |
207 | reading routines by the use of C<lstat>, from the C<File::stat> package, |
208 | C<unlink>, C<rmdir> and C<utime>. |
209 | |
210 | =over 4 |
211 | |
212 | =item tie %hash, IO::Dir, DIRNAME [, OPTIONS ] |
213 | |
214 | =back |
215 | |
216 | The keys of the HASH will be the names of the entries in the directory. |
217 | Reading a value from the hash will be the result of calling |
218 | C<File::stat::lstat>. Deleting an element from the hash will call C<unlink> |
219 | providing that C<DIR_UNLINK> is passed in the C<OPTIONS>. |
220 | |
221 | Assigning to an entry in the HASH will cause the time stamps of the file |
222 | to be modified. If the file does not exist then it will be created. Assigning |
223 | a single integer to a HASH element will cause both the access and |
224 | modification times to be changed to that value. Alternatively a reference to |
225 | an array of two values can be passed. The first array element will be used to |
226 | set the access time and the second element will be used to set the modification |
227 | time. |
228 | |
229 | =head1 SEE ALSO |
230 | |
231 | L<File::stat> |
232 | |
233 | =head1 AUTHOR |
234 | |
854822f1 |
235 | Graham Barr. Currently maintained by the Perl Porters. Please report all |
236 | bugs to <perl5-porters@perl.org>. |
cf7fe8a2 |
237 | |
238 | =head1 COPYRIGHT |
239 | |
240 | Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved. |
241 | This program is free software; you can redistribute it and/or |
242 | modify it under the same terms as Perl itself. |
243 | |
244 | =cut |