root/lang/perl/Path-Extended/trunk/lib/Path/Extended/Dir.pm @ 30946

Revision 30946, 7.1 kB (checked in by charsbar, 6 years ago)

Path-Extended: fixed unstable compat test; better pod coverage; better subsclassing; added "basename" to dir; close before rmdir, and after children; 0.10 -> CPAN

  • Property svn:eol-style set to native
Line 
1package Path::Extended::Dir;
2
3use strict;
4use warnings;
5use base qw( Path::Extended::Entity );
6use Path::Extended::File;
7
8sub _initialize {
9  my ($self, @args) = @_;
10
11  my $dir = @args ? File::Spec->catdir( @args ) : File::Spec->curdir;
12
13  $self->{_absolute} = 1; # always true for ::Extended::Dir
14  $self->{is_dir}    = 1;
15  $self->{path}      = $self->_unixify( File::Spec->rel2abs($dir) );
16
17  $self;
18}
19
20sub new_from_file {
21  my ($class, $file) = @_;
22
23  require File::Basename;
24  my $dir = File::Basename::dirname( $file );
25
26  my $self = $class->new( $dir );
27}
28
29sub _parts {
30  my ($self, $abs) = @_;
31
32  my $path = $abs ? $self->absolute : $self->_path;
33  my ($vol, $dir, $file) = File::Spec->splitpath( $path );
34  return split '/', "$dir$file";
35}
36
37sub basename {
38  my $self = shift;
39
40  return ($self->_parts)[-1];
41}
42
43sub open {
44  my $self = shift;
45
46  $self->close if $self->is_open;
47
48  opendir my $dh, $self->absolute
49    or do { $self->log( error => $! ); return; };
50
51  return $dh if $self->{_compat} && defined wantarray;
52
53  $self->{handle} = $dh;
54
55  $self;
56}
57
58sub close {
59  my $self = shift;
60
61  if ( my $dh = delete $self->{handle} ) {
62    closedir $dh;
63  }
64}
65
66sub read {
67  my $self = shift;
68
69  return unless $self->is_open;
70
71  my $dh = $self->_handle;
72  readdir $dh;
73}
74
75sub seek {
76  my ($self, $pos) = @_;
77
78  return unless $self->is_open;
79
80  my $dh = $self->_handle;
81  seekdir $dh, $pos || 0;
82}
83
84sub tell {
85  my $self = shift;
86
87  return unless $self->is_open;
88
89  my $dh = $self->_handle;
90  telldir $dh;
91}
92
93sub rewind {
94  my $self = shift;
95
96  return unless $self->is_open;
97
98  my $dh = $self->_handle;
99  rewinddir $dh;
100}
101
102sub find {
103  my ($self, $rule, %options) = @_;
104
105  $self->_find( file => $rule, %options );
106}
107
108sub find_dir {
109  my ($self, $rule, %options) = @_;
110
111  $self->_find( directory => $rule, %options );
112}
113
114sub _find {
115  my ($self, $type, $rule, %options) = @_;
116
117  return unless $type =~ /^(?:directory|file)$/;
118
119  require File::Find::Rule;
120
121  my @items = grep { $_->relative !~ m{/\.} }
122              map  { $self->_related( $type, $_ ) }
123              File::Find::Rule->$type->name($rule)->in($self->absolute);
124
125  if ( $options{callback} ) {
126    @items = $options{callback}->( @items );
127  }
128
129  return @items;
130}
131
132sub rmdir {
133  my $self = shift;
134
135  $self->close if $self->is_open;
136
137  if ( $self->exists ) {
138    require File::Path;
139    eval { File::Path::rmtree( $self->absolute ) };
140    do { $self->log( error => $@ ); return; } if $@;
141  }
142  $self;
143}
144
145*rmtree = *remove = \&rmdir;
146
147sub mkdir {
148  my $self = shift;
149
150  unless ( $self->exists ) {
151    require File::Path;
152    eval { File::Path::mkpath( $self->absolute ) };
153    do { $self->log( error => $@ ); return; } if $@;
154  }
155  $self;
156}
157
158*mkpath = \&mkdir;
159
160sub next {
161   my $self = shift;
162
163  $self->open unless $self->is_open;
164  my $next = $self->read;
165  unless ( defined $next ) {
166    $self->close;
167    return;
168  }
169  if ( -d File::Spec->catdir( $self->absolute, $next ) ) {
170    return $self->_related( dir => $next );
171  }
172  else {
173    return $self->_related( file => $next );
174  }
175}
176
177sub file   { shift->_related( file => @_ ); }
178sub subdir { shift->_related( dir  => @_ ); }
179
180sub children {
181  my ($self, %options) = @_;
182
183  my $dh = $self->open or Carp::croak "Can't open directory $self: $!";
184
185  my @children;
186  while ( my $entry = readdir $dh ) {
187    next if (!$options{all} && ( $entry eq '.' || $entry eq '..' ));
188    my $type = ( -d File::Spec->catdir($self->absolute, $entry) )
189               ? 'dir' : 'file';
190    push @children, $self->_related( $type => $entry );
191  }
192  $self->close;
193  return @children;
194}
195
196sub recurse { # ripped from Path::Class::Dir
197  my $self = shift;
198  my %opts = (preorder => 1, depthfirst => 0, @_);
199
200  my $callback = $opts{callback}
201    or Carp::croak "Must provide a 'callback' parameter to recurse()";
202
203  my @queue = ($self);
204
205  my $visit_entry;
206  my $visit_dir =
207    $opts{depthfirst} && $opts{preorder}
208    ? sub {
209      my $dir = shift;
210      $callback->($dir);
211      unshift @queue, $dir->children;
212    }
213    : $opts{preorder}
214    ? sub {
215      my $dir = shift;
216      $callback->($dir);
217      push @queue, $dir->children;
218    }
219    : sub {
220      my $dir = shift;
221      $visit_entry->($_) foreach $dir->children;
222      $callback->($dir);
223    };
224
225  $visit_entry = sub {
226    my $entry = shift;
227    if ($entry->is_dir) { $visit_dir->($entry) }
228    else { $callback->($entry) }
229  };
230
231  while (@queue) {
232    $visit_entry->( shift @queue );
233  }
234}
235
2361;
237
238__END__
239
240=head1 NAME
241
242Path::Extended::Dir
243
244=head1 SYNOPSIS
245
246  use Path::Extended::Dir;
247
248  my $dir = Path::Extended::Dir->new('path/to/somewhere');
249  my $parent_dir = Path::Extended::Dir->new_from_file('path/to/some.file');
250
251  foreach my $file ( $dir->find('*.txt') ) {
252    print $file->relative, "\n";  # each $file is a L<Path::Extended::File> object.
253  }
254
255=head1 DESCRIPTION
256
257This class implements several directory-specific methods. See also L<Path::Class::Entity> for common methods like copy and move.
258
259=head1 METHODS
260
261=head2 new, new_from_file
262
263takes a path or parts of a path of a directory (or a file in the case of C<new_from_file>), and creates a L<Path::Extended::Dir> object. If the path specified is a relative one, it will be converted to the absolute one internally.
264
265=head2 basename
266
267returns the last part of the directory.
268
269=head2 open, close, read, seek, tell, rewind
270
271are simple wrappers of the corresponding built-in functions (with the trailing 'dir').
272
273=head2 mkdir, mkpath
274
275makes the directory via C<File::Path::mkpath>.
276
277=head2 rmdir, rmtree, remove
278
279removes the directory via C<File::Path::rmtree>.
280
281=head2 find, find_dir
282
283takes a L<File::Find::Rule>'s rule and a hash option, and returns C<Path::Extended::*> objects of the matched files (C<find>) or directories (C<find_dir>) under the directory the $self object points to. Options are:
284
285=over 4
286
287=item callback
288
289You can pass a code reference to filter the objects.
290
291=back
292
293=head2 next
294
295  while (my $file = $dir->next) {
296    next unless -f $file;
297    $file->openr or die "Can't read $file: $!";
298    ...
299  }
300
301returns a L<Path::Extended::Dir> or L<Path::Extended::File> object while iterating through the directory (or C<undef> when there's no more items there). The directory will be open with the first C<next>, and close with the last C<next>.
302
303=head2 children
304
305returns a list of L<Path::Extended::Class::File> and/or L<Path::Extended::Class::Dir> objects listed in the directory. See L<Path::Class::Dir> for details.
306
307=head2 file, subdir
308
309returns a child L<Path::Extended::Class::File>/L<Path::Extended::Class::Dir> object in the directory.
310
311=head2 recurse
312
313  dir('path/to/somewhere')->recurse( callback => sub {
314    my $file_or_dir = shift;
315    ...
316  });
317
318takes a hash and iterates through the directory and all its subdirectories recursively, and call the callback function for each entry. Options are:
319
320=over 4
321
322=item callback
323
324a code reference to call for each entry.
325
326=item depthfirst, preorder
327
328flags to change the order of processing.
329
330=back
331
332=head1 AUTHOR
333
334Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
335
336=head1 COPYRIGHT AND LICENSE
337
338Copyright (C) 2008 by Kenichi Ishigaki.
339
340This program is free software; you can redistribute it and/or
341modify it under the same terms as Perl itself.
342
343=cut
Note: See TracBrowser for help on using the browser.