[Summary view] [Print] [Text view]

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