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.10"; 23$VERSION = eval $VERSION; 24@EXPORT_OK = qw(DIR_UNLINK); 25 26sub DIR_UNLINK () { 1 } 27 28sub new { 29 @_ >= 1 && @_ <= 2 or croak 'usage: IO::Dir->new([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 local($., $@, $!, $^E, $?); 42 no warnings 'io'; 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); 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 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) = @_; 113 -e File::Spec->catfile(${*$dh}{io_dir_path}, $key); 114} 115 116sub FETCH { 117 my($dh,$key) = @_; 118 &lstat(File::Spec->catfile(${*$dh}{io_dir_path}, $key)); 119} 120 121sub 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 132sub 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 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; 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 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 183C<new> is the constructor for C<IO::Dir> objects. It accepts one optional 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 208C<IO::Dir> also provides an interface to reading directories via a tied 209hash. The tied hash extends the interface beyond just the directory 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 215=item tie %hash, 'IO::Dir', DIRNAME [, OPTIONS ] 216 217=back 218 219The keys of the hash will be the names of the entries in the directory. 220Reading a value from the hash will be the result of calling 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>. 224 225Assigning to an entry in the hash will cause the time stamps of the file 226to be modified. If the file does not exist then it will be created. Assigning 227a single integer to a hash element will cause both the access and 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 239Graham Barr. Currently maintained by the Perl Porters. Please report all 240bugs to <perlbug@perl.org>. 241 242=head1 COPYRIGHT 243 244Copyright (c) 1997-2003 Graham Barr <gbarr@pobox.com>. All rights reserved. 245This program is free software; you can redistribute it and/or 246modify it under the same terms as Perl itself. 247 248=cut 249