Move I18N::LangTags from ext/ to dist/
[perl.git] / ext / IO / lib / IO / Dir.pm
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.07";
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     local($., $@, $!, $^E, $?);
42     no warnings 'io';
43     closedir($dh);
44 }
45
46 sub open {
47     @_ == 2 or croak 'usage: $dh->open(DIRNAME)';
48     my ($dh, $dirname) = @_;
49     return undef
50         unless opendir($dh, $dirname);
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 !~ /:/) );
54     ${*$dh}{io_dir_path} = $dirname;
55     1;
56 }
57
58 sub close {
59     @_ == 1 or croak 'usage: $dh->close()';
60     my ($dh) = @_;
61     closedir($dh);
62 }
63
64 sub read {
65     @_ == 1 or croak 'usage: $dh->read()';
66     my ($dh) = @_;
67     readdir($dh);
68 }
69
70 sub seek {
71     @_ == 2 or croak 'usage: $dh->seek(POS)';
72     my ($dh,$pos) = @_;
73     seekdir($dh,$pos);
74 }
75
76 sub tell {
77     @_ == 1 or croak 'usage: $dh->tell()';
78     my ($dh) = @_;
79     telldir($dh);
80 }
81
82 sub rewind {
83     @_ == 1 or croak 'usage: $dh->rewind()';
84     my ($dh) = @_;
85     rewinddir($dh);
86 }
87
88 sub 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
100 sub FIRSTKEY {
101     my($dh) = @_;
102     $dh->rewind;
103     scalar $dh->read;
104 }
105
106 sub NEXTKEY {
107     my($dh) = @_;
108     scalar $dh->read;
109 }
110
111 sub EXISTS {
112     my($dh,$key) = @_;
113     -e File::Spec->catfile(${*$dh}{io_dir_path}, $key);
114 }
115
116 sub FETCH {
117     my($dh,$key) = @_;
118     &lstat(File::Spec->catfile(${*$dh}{io_dir_path}, $key));
119 }
120
121 sub STORE {
122     my($dh,$key,$data) = @_;
123     my($atime,$mtime) = ref($data) ? @$data : ($data,$data);
124     my $file = File::Spec->catfile(${*$dh}{io_dir_path}, $key);
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
132 sub DELETE {
133     my($dh,$key) = @_;
134
135     # Only unlink if unlink-ing is enabled
136     return 0
137         unless ${*$dh}{io_dir_unlink};
138
139     my $file = File::Spec->catfile(${*$dh}{io_dir_path}, $key);
140
141     -d $file
142         ? rmdir($file)
143         : unlink($file);
144 }
145
146 1;
147
148 __END__
149
150 =head1 NAME 
151
152 IO::Dir - supply object methods for directory handles
153
154 =head1 SYNOPSIS
155
156     use IO::Dir;
157     $d = IO::Dir->new(".");
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
165     tie %dir, 'IO::Dir', ".";
166     foreach (keys %dir) {
167         print $_, " " , $dir{$_}->size,"\n";
168     }
169
170 =head1 DESCRIPTION
171
172 The C<IO::Dir> package provides two interfaces to perl's directory reading
173 routines.
174
175 The first interface is an object approach. C<IO::Dir> provides an object
176 constructor and methods, which are just wrappers around perl's built in
177 directory reading routines.
178
179 =over 4
180
181 =item new ( [ DIRNAME ] )
182
183 C<new> is the constructor for C<IO::Dir> objects. It accepts one optional
184 argument which,  if given, C<new> will pass to C<open>
185
186 =back
187
188 The following methods are wrappers for the directory related functions built
189 into perl (the trailing `dir' has been removed from the names). See L<perlfunc>
190 for 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
208 C<IO::Dir> also provides an interface to reading directories via a tied
209 hash. The tied hash extends the interface beyond just the directory
210 reading routines by the use of C<lstat>, from the C<File::stat> package,
211 C<unlink>, C<rmdir> and C<utime>.
212
213 =over 4
214
215 =item tie %hash, 'IO::Dir', DIRNAME [, OPTIONS ]
216
217 =back
218
219 The keys of the hash will be the names of the entries in the directory. 
220 Reading a value from the hash will be the result of calling
221 C<File::stat::lstat>.  Deleting an element from the hash will 
222 delete the corresponding file or subdirectory,
223 provided that C<DIR_UNLINK> is included in the C<OPTIONS>.
224
225 Assigning to an entry in the hash will cause the time stamps of the file
226 to be modified. If the file does not exist then it will be created. Assigning
227 a single integer to a hash element will cause both the access and 
228 modification times to be changed to that value. Alternatively a reference to
229 an array of two values can be passed. The first array element will be used to
230 set the access time and the second element will be used to set the modification
231 time.
232
233 =head1 SEE ALSO
234
235 L<File::stat>
236
237 =head1 AUTHOR
238
239 Graham Barr. Currently maintained by the Perl Porters.  Please report all
240 bugs to <perl5-porters@perl.org>.
241
242 =head1 COPYRIGHT
243
244 Copyright (c) 1997-2003 Graham Barr <gbarr@pobox.com>. All rights reserved.
245 This program is free software; you can redistribute it and/or
246 modify it under the same terms as Perl itself.
247
248 =cut