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