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
7package IO::Dir;
8
9use 5.006;
10
11use strict;
12use Carp;
13use Symbol;
14use Exporter;
15use IO::File;
16our(@ISA, $VERSION, @EXPORT_OK);
17use Tie::Hash;
18use File::stat;
19use File::Spec;
20
21@ISA = qw(Tie::Hash Exporter);
22$VERSION = "1.05";
23$VERSION = eval $VERSION;
24@EXPORT_OK = qw(DIR_UNLINK);
25
26sub DIR_UNLINK () { 1 }
27
28sub 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
39sub DESTROY {
40    my ($dh) = @_;
41    closedir($dh);
42}
43
44sub 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
56sub close {
57    @_ == 1 or croak 'usage: $dh->close()';
58    my ($dh) = @_;
59    closedir($dh);
60}
61
62sub read {
63    @_ == 1 or croak 'usage: $dh->read()';
64    my ($dh) = @_;
65    readdir($dh);
66}
67
68sub seek {
69    @_ == 2 or croak 'usage: $dh->seek(POS)';
70    my ($dh,$pos) = @_;
71    seekdir($dh,$pos);
72}
73
74sub tell {
75    @_ == 1 or croak 'usage: $dh->tell()';
76    my ($dh) = @_;
77    telldir($dh);
78}
79
80sub rewind {
81    @_ == 1 or croak 'usage: $dh->rewind()';
82    my ($dh) = @_;
83    rewinddir($dh);
84}
85
86sub 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
98sub FIRSTKEY {
99    my($dh) = @_;
100    $dh->rewind;
101    scalar $dh->read;
102}
103
104sub NEXTKEY {
105    my($dh) = @_;
106    scalar $dh->read;
107}
108
109sub EXISTS {
110    my($dh,$key) = @_;
111    -e File::Spec->catfile(${*$dh}{io_dir_path}, $key);
112}
113
114sub FETCH {
115    my($dh,$key) = @_;
116    &lstat(File::Spec->catfile(${*$dh}{io_dir_path}, $key));
117}
118
119sub 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
130sub 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
1441;
145
146__END__
147
148=head1 NAME
149
150IO::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
170The C<IO::Dir> package provides two interfaces to perl's directory reading
171routines.
172
173The first interface is an object approach. C<IO::Dir> provides an object
174constructor and methods, which are just wrappers around perl's built in
175directory reading routines.
176
177=over 4
178
179=item new ( [ DIRNAME ] )
180
181C<new> is the constructor for C<IO::Dir> objects. It accepts one optional
182argument which,  if given, C<new> will pass to C<open>
183
184=back
185
186The following methods are wrappers for the directory related functions built
187into perl (the trailing `dir' has been removed from the names). See L<perlfunc>
188for 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
206C<IO::Dir> also provides an interface to reading directories via a tied
207hash. The tied hash extends the interface beyond just the directory
208reading routines by the use of C<lstat>, from the C<File::stat> package,
209C<unlink>, C<rmdir> and C<utime>.
210
211=over 4
212
213=item tie %hash, 'IO::Dir', DIRNAME [, OPTIONS ]
214
215=back
216
217The keys of the hash will be the names of the entries in the directory.
218Reading a value from the hash will be the result of calling
219C<File::stat::lstat>.  Deleting an element from the hash will
220delete the corresponding file or subdirectory,
221provided that C<DIR_UNLINK> is included in the C<OPTIONS>.
222
223Assigning to an entry in the hash will cause the time stamps of the file
224to be modified. If the file does not exist then it will be created. Assigning
225a single integer to a hash element will cause both the access and
226modification times to be changed to that value. Alternatively a reference to
227an array of two values can be passed. The first array element will be used to
228set the access time and the second element will be used to set the modification
229time.
230
231=head1 SEE ALSO
232
233L<File::stat>
234
235=head1 AUTHOR
236
237Graham Barr. Currently maintained by the Perl Porters.  Please report all
238bugs to <perl5-porters@perl.org>.
239
240=head1 COPYRIGHT
241
242Copyright (c) 1997-2003 Graham Barr <gbarr@pobox.com>. All rights reserved.
243This program is free software; you can redistribute it and/or
244modify it under the same terms as Perl itself.
245
246=cut
247