Commit | Line | Data |
---|---|---|
86530b38 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.03_00"; | |
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 | # Only unlink if unlink-ing is enabled | |
133 | my $file = File::Spec->catfile(${*$dh}{io_dir_path}, $key); | |
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 | ||
205 | C<IO::Dir> also provides an interface to reading directories via a tied | |
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 | ||
235 | Graham Barr. Currently maintained by the Perl Porters. Please report all | |
236 | bugs to <perl5-porters@perl.org>. | |
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 |