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