Commit | Line | Data |
---|---|---|
920dae64 AT |
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 | use 5.006; | |
10 | ||
11 | use strict; | |
12 | use Carp; | |
13 | use Symbol; | |
14 | use Exporter; | |
15 | use IO::File; | |
16 | our(@ISA, $VERSION, @EXPORT_OK); | |
17 | use Tie::Hash; | |
18 | use File::stat; | |
19 | use File::Spec; | |
20 | ||
21 | @ISA = qw(Tie::Hash Exporter); | |
22 | $VERSION = "1.05"; | |
23 | $VERSION = eval $VERSION; | |
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); | |
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 !~ /:/) ); | |
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) = @_; | |
111 | -e File::Spec->catfile(${*$dh}{io_dir_path}, $key); | |
112 | } | |
113 | ||
114 | sub FETCH { | |
115 | my($dh,$key) = @_; | |
116 | &lstat(File::Spec->catfile(${*$dh}{io_dir_path}, $key)); | |
117 | } | |
118 | ||
119 | sub STORE { | |
120 | my($dh,$key,$data) = @_; | |
121 | my($atime,$mtime) = ref($data) ? @$data : ($data,$data); | |
122 | my $file = File::Spec->catfile(${*$dh}{io_dir_path}, $key); | |
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 | ||
133 | # Only unlink if unlink-ing is enabled | |
134 | return 0 | |
135 | unless ${*$dh}{io_dir_unlink}; | |
136 | ||
137 | my $file = File::Spec->catfile(${*$dh}{io_dir_path}, $key); | |
138 | ||
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; | |
155 | $d = IO::Dir->new("."); | |
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 | ||
163 | tie %dir, 'IO::Dir', "."; | |
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 | ||
181 | C<new> is the constructor for C<IO::Dir> objects. It accepts one optional | |
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 | ||
206 | C<IO::Dir> also provides an interface to reading directories via a tied | |
207 | hash. The tied hash extends the interface beyond just the directory | |
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 | ||
213 | =item tie %hash, 'IO::Dir', DIRNAME [, OPTIONS ] | |
214 | ||
215 | =back | |
216 | ||
217 | The keys of the hash will be the names of the entries in the directory. | |
218 | Reading a value from the hash will be the result of calling | |
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>. | |
222 | ||
223 | Assigning to an entry in the hash will cause the time stamps of the file | |
224 | to be modified. If the file does not exist then it will be created. Assigning | |
225 | a single integer to a hash element will cause both the access and | |
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 | ||
237 | Graham Barr. Currently maintained by the Perl Porters. Please report all | |
238 | bugs to <perl5-porters@perl.org>. | |
239 | ||
240 | =head1 COPYRIGHT | |
241 | ||
242 | Copyright (c) 1997-2003 Graham Barr <gbarr@pobox.com>. All rights reserved. | |
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 |