1package Path::Class::Dir; 2 3$VERSION = '0.18'; 4 5use strict; 6use Path::Class::File; 7use Path::Class::Entity; 8use Carp(); 9use base qw(Path::Class::Entity); 10 11use IO::Dir (); 12use File::Path (); 13 14sub new { 15 my $self = shift->SUPER::new(); 16 17 # If the only arg is undef, it's probably a mistake. Without this 18 # special case here, we'd return the root directory, which is a 19 # lousy thing to do to someone when they made a mistake. Return 20 # undef instead. 21 return if @_==1 && !defined($_[0]); 22 23 my $s = $self->_spec; 24 25 my $first = (@_ == 0 ? $s->curdir : 26 $_[0] eq '' ? (shift, $s->rootdir) : 27 shift() 28 ); 29 30 ($self->{volume}, my $dirs) = $s->splitpath( $s->canonpath($first) , 1); 31 $self->{dirs} = [$s->splitdir($s->catdir($dirs, @_))]; 32 33 return $self; 34} 35 36sub is_dir { 1 } 37 38sub as_foreign { 39 my ($self, $type) = @_; 40 41 my $foreign = do { 42 local $self->{file_spec_class} = $self->_spec_class($type); 43 $self->SUPER::new; 44 }; 45 46 # Clone internal structure 47 $foreign->{volume} = $self->{volume}; 48 my ($u, $fu) = ($self->_spec->updir, $foreign->_spec->updir); 49 $foreign->{dirs} = [ map {$_ eq $u ? $fu : $_} @{$self->{dirs}}]; 50 return $foreign; 51} 52 53sub stringify { 54 my $self = shift; 55 my $s = $self->_spec; 56 return $s->catpath($self->{volume}, 57 $s->catdir(@{$self->{dirs}}), 58 ''); 59} 60 61sub volume { shift()->{volume} } 62 63sub file { 64 local $Path::Class::Foreign = $_[0]->{file_spec_class} if $_[0]->{file_spec_class}; 65 return Path::Class::File->new(@_); 66} 67 68sub dir_list { 69 my $self = shift; 70 my $d = $self->{dirs}; 71 return @$d unless @_; 72 73 my $offset = shift; 74 if ($offset < 0) { $offset = $#$d + $offset + 1 } 75 76 return wantarray ? @$d[$offset .. $#$d] : $d->[$offset] unless @_; 77 78 my $length = shift; 79 if ($length < 0) { $length = $#$d + $length + 1 - $offset } 80 return @$d[$offset .. $length + $offset - 1]; 81} 82 83sub subdir { 84 my $self = shift; 85 return $self->new($self, @_); 86} 87 88sub parent { 89 my $self = shift; 90 my $dirs = $self->{dirs}; 91 my ($curdir, $updir) = ($self->_spec->curdir, $self->_spec->updir); 92 93 if ($self->is_absolute) { 94 my $parent = $self->new($self); 95 pop @{$parent->{dirs}}; 96 return $parent; 97 98 } elsif ($self eq $curdir) { 99 return $self->new($updir); 100 101 } elsif (!grep {$_ ne $updir} @$dirs) { # All updirs 102 return $self->new($self, $updir); # Add one more 103 104 } elsif (@$dirs == 1) { 105 return $self->new($curdir); 106 107 } else { 108 my $parent = $self->new($self); 109 pop @{$parent->{dirs}}; 110 return $parent; 111 } 112} 113 114sub relative { 115 # File::Spec->abs2rel before version 3.13 returned the empty string 116 # when the two paths were equal - work around it here. 117 my $self = shift; 118 my $rel = $self->_spec->abs2rel($self->stringify, @_); 119 return $self->new( length $rel ? $rel : $self->_spec->curdir ); 120} 121 122sub open { IO::Dir->new(@_) } 123sub mkpath { File::Path::mkpath(shift()->stringify, @_) } 124sub rmtree { File::Path::rmtree(shift()->stringify, @_) } 125 126sub remove { 127 rmdir( shift() ); 128} 129 130sub recurse { 131 my $self = shift; 132 my %opts = (preorder => 1, depthfirst => 0, @_); 133 134 my $callback = $opts{callback} 135 or Carp::croak( "Must provide a 'callback' parameter to recurse()" ); 136 137 my @queue = ($self); 138 139 my $visit_entry; 140 my $visit_dir = 141 $opts{depthfirst} && $opts{preorder} 142 ? sub { 143 my $dir = shift; 144 $callback->($dir); 145 unshift @queue, $dir->children; 146 } 147 : $opts{preorder} 148 ? sub { 149 my $dir = shift; 150 $callback->($dir); 151 push @queue, $dir->children; 152 } 153 : sub { 154 my $dir = shift; 155 $visit_entry->($_) foreach $dir->children; 156 $callback->($dir); 157 }; 158 159 $visit_entry = sub { 160 my $entry = shift; 161 if ($entry->is_dir) { $visit_dir->($entry) } # Will call $callback 162 else { $callback->($entry) } 163 }; 164 165 while (@queue) { 166 $visit_entry->( shift @queue ); 167 } 168} 169 170sub children { 171 my ($self, %opts) = @_; 172 173 my $dh = $self->open or Carp::croak( "Can't open directory $self: $!" ); 174 175 my @out; 176 while (defined(my $entry = $dh->read)) { 177 # XXX What's the right cross-platform way to do this? 178 next if (!$opts{all} && ($entry eq '.' || $entry eq '..')); 179 push @out, $self->file($entry); 180 $out[-1] = $self->subdir($entry) if -d $out[-1]; 181 } 182 return @out; 183} 184 185sub next { 186 my $self = shift; 187 unless ($self->{dh}) { 188 $self->{dh} = $self->open or Carp::croak( "Can't open directory $self: $!" ); 189 } 190 191 my $next = $self->{dh}->read; 192 unless (defined $next) { 193 delete $self->{dh}; 194 return undef; 195 } 196 197 # Figure out whether it's a file or directory 198 my $file = $self->file($next); 199 $file = $self->subdir($next) if -d $file; 200 return $file; 201} 202 203sub subsumes { 204 my ($self, $other) = @_; 205 die "No second entity given to subsumes()" unless $other; 206 207 $other = $self->new($other) unless UNIVERSAL::isa($other, __PACKAGE__); 208 $other = $other->dir unless $other->is_dir; 209 210 if ($self->is_absolute) { 211 $other = $other->absolute; 212 } elsif ($other->is_absolute) { 213 $self = $self->absolute; 214 } 215 216 $self = $self->cleanup; 217 $other = $other->cleanup; 218 219 if ($self->volume) { 220 return 0 unless $other->volume eq $self->volume; 221 } 222 223 # The root dir subsumes everything (but ignore the volume because 224 # we've already checked that) 225 return 1 if "@{$self->{dirs}}" eq "@{$self->new('')->{dirs}}"; 226 227 my $i = 0; 228 while ($i <= $#{ $self->{dirs} }) { 229 return 0 if $i > $#{ $other->{dirs} }; 230 return 0 if $self->{dirs}[$i] ne $other->{dirs}[$i]; 231 $i++; 232 } 233 return 1; 234} 235 236sub contains { 237 my ($self, $other) = @_; 238 return !!(-d $self and (-e $other or -l $other) and $self->subsumes($other)); 239} 240 2411; 242__END__ 243 244=head1 NAME 245 246Path::Class::Dir - Objects representing directories 247 248=head1 SYNOPSIS 249 250 use Path::Class qw(dir); # Export a short constructor 251 252 my $dir = dir('foo', 'bar'); # Path::Class::Dir object 253 my $dir = Path::Class::Dir->new('foo', 'bar'); # Same thing 254 255 # Stringifies to 'foo/bar' on Unix, 'foo\bar' on Windows, etc. 256 print "dir: $dir\n"; 257 258 if ($dir->is_absolute) { ... } 259 if ($dir->is_relative) { ... } 260 261 my $v = $dir->volume; # Could be 'C:' on Windows, empty string 262 # on Unix, 'Macintosh HD:' on Mac OS 263 264 $dir->cleanup; # Perform logical cleanup of pathname 265 $dir->resolve; # Perform physical cleanup of pathname 266 267 my $file = $dir->file('file.txt'); # A file in this directory 268 my $subdir = $dir->subdir('george'); # A subdirectory 269 my $parent = $dir->parent; # The parent directory, 'foo' 270 271 my $abs = $dir->absolute; # Transform to absolute path 272 my $rel = $abs->relative; # Transform to relative path 273 my $rel = $abs->relative('/foo'); # Relative to /foo 274 275 print $dir->as_foreign('Mac'); # :foo:bar: 276 print $dir->as_foreign('Win32'); # foo\bar 277 278 # Iterate with IO::Dir methods: 279 my $handle = $dir->open; 280 while (my $file = $handle->read) { 281 $file = $dir->file($file); # Turn into Path::Class::File object 282 ... 283 } 284 285 # Iterate with Path::Class methods: 286 while (my $file = $dir->next) { 287 # $file is a Path::Class::File or Path::Class::Dir object 288 ... 289 } 290 291 292=head1 DESCRIPTION 293 294The C<Path::Class::Dir> class contains functionality for manipulating 295directory names in a cross-platform way. 296 297=head1 METHODS 298 299=over 4 300 301=item $dir = Path::Class::Dir->new( <dir1>, <dir2>, ... ) 302 303=item $dir = dir( <dir1>, <dir2>, ... ) 304 305Creates a new C<Path::Class::Dir> object and returns it. The 306arguments specify names of directories which will be joined to create 307a single directory object. A volume may also be specified as the 308first argument, or as part of the first argument. You can use 309platform-neutral syntax: 310 311 my $dir = dir( 'foo', 'bar', 'baz' ); 312 313or platform-native syntax: 314 315 my $dir = dir( 'foo/bar/baz' ); 316 317or a mixture of the two: 318 319 my $dir = dir( 'foo/bar', 'baz' ); 320 321All three of the above examples create relative paths. To create an 322absolute path, either use the platform native syntax for doing so: 323 324 my $dir = dir( '/var/tmp' ); 325 326or use an empty string as the first argument: 327 328 my $dir = dir( '', 'var', 'tmp' ); 329 330If the second form seems awkward, that's somewhat intentional - paths 331like C</var/tmp> or C<\Windows> aren't cross-platform concepts in the 332first place (many non-Unix platforms don't have a notion of a "root 333directory"), so they probably shouldn't appear in your code if you're 334trying to be cross-platform. The first form is perfectly natural, 335because paths like this may come from config files, user input, or 336whatever. 337 338As a special case, since it doesn't otherwise mean anything useful and 339it's convenient to define this way, C<< Path::Class::Dir->new() >> (or 340C<dir()>) refers to the current directory (C<< File::Spec->curdir >>). 341To get the current directory as an absolute path, do C<< 342dir()->absolute >>. 343 344Finally, as another special case C<dir(undef)> will return undef, 345since that's usually an accident on the part of the caller, and 346returning the root directory would be a nasty surprise just asking for 347trouble a few lines later. 348 349=item $dir->stringify 350 351This method is called internally when a C<Path::Class::Dir> object is 352used in a string context, so the following are equivalent: 353 354 $string = $dir->stringify; 355 $string = "$dir"; 356 357=item $dir->volume 358 359Returns the volume (e.g. C<C:> on Windows, C<Macintosh HD:> on Mac OS, 360etc.) of the directory object, if any. Otherwise, returns the empty 361string. 362 363=item $dir->is_dir 364 365Returns a boolean value indicating whether this object represents a 366directory. Not surprisingly, C<Path::Class::File> objects always 367return false, and C<Path::Class::Dir> objects always return true. 368 369=item $dir->is_absolute 370 371Returns true or false depending on whether the directory refers to an 372absolute path specifier (like C</usr/local> or C<\Windows>). 373 374=item $dir->is_relative 375 376Returns true or false depending on whether the directory refers to a 377relative path specifier (like C<lib/foo> or C<./dir>). 378 379=item $dir->cleanup 380 381Performs a logical cleanup of the file path. For instance: 382 383 my $dir = dir('/foo//baz/./foo')->cleanup; 384 # $dir now represents '/foo/baz/foo'; 385 386=item $dir->resolve 387 388Performs a physical cleanup of the file path. For instance: 389 390 my $dir = dir('/foo//baz/../foo')->resolve; 391 # $dir now represents '/foo/foo', assuming no symlinks 392 393This actually consults the filesystem to verify the validity of the 394path. 395 396=item $file = $dir->file( <dir1>, <dir2>, ..., <file> ) 397 398Returns a C<Path::Class::File> object representing an entry in C<$dir> 399or one of its subdirectories. Internally, this just calls C<< 400Path::Class::File->new( @_ ) >>. 401 402=item $subdir = $dir->subdir( <dir1>, <dir2>, ... ) 403 404Returns a new C<Path::Class::Dir> object representing a subdirectory 405of C<$dir>. 406 407=item $parent = $dir->parent 408 409Returns the parent directory of C<$dir>. Note that this is the 410I<logical> parent, not necessarily the physical parent. It really 411means we just chop off entries from the end of the directory list 412until we cain't chop no more. If the directory is relative, we start 413using the relative forms of parent directories. 414 415The following code demonstrates the behavior on absolute and relative 416directories: 417 418 $dir = dir('/foo/bar'); 419 for (1..6) { 420 print "Absolute: $dir\n"; 421 $dir = $dir->parent; 422 } 423 424 $dir = dir('foo/bar'); 425 for (1..6) { 426 print "Relative: $dir\n"; 427 $dir = $dir->parent; 428 } 429 430 ########### Output on Unix ################ 431 Absolute: /foo/bar 432 Absolute: /foo 433 Absolute: / 434 Absolute: / 435 Absolute: / 436 Absolute: / 437 Relative: foo/bar 438 Relative: foo 439 Relative: . 440 Relative: .. 441 Relative: ../.. 442 Relative: ../../.. 443 444=item @list = $dir->children 445 446Returns a list of C<Path::Class::File> and/or C<Path::Class::Dir> 447objects listed in this directory, or in scalar context the number of 448such objects. Obviously, it is necessary for C<$dir> to 449exist and be readable in order to find its children. 450 451Note that the children are returned as subdirectories of C<$dir>, 452i.e. the children of F<foo> will be F<foo/bar> and F<foo/baz>, not 453F<bar> and F<baz>. 454 455Ordinarily C<children()> will not include the I<self> and I<parent> 456entries C<.> and C<..> (or their equivalents on non-Unix systems), 457because that's like I'm-my-own-grandpa business. If you do want all 458directory entries including these special ones, pass a true value for 459the C<all> parameter: 460 461 @c = $dir->children(); # Just the children 462 @c = $dir->children(all => 1); # All entries 463 464=item $abs = $dir->absolute 465 466Returns a C<Path::Class::Dir> object representing C<$dir> as an 467absolute path. An optional argument, given as either a string or a 468C<Path::Class::Dir> object, specifies the directory to use as the base 469of relativity - otherwise the current working directory will be used. 470 471=item $rel = $dir->relative 472 473Returns a C<Path::Class::Dir> object representing C<$dir> as a 474relative path. An optional argument, given as either a string or a 475C<Path::Class::Dir> object, specifies the directory to use as the base 476of relativity - otherwise the current working directory will be used. 477 478=item $boolean = $dir->subsumes($other) 479 480Returns true if this directory spec subsumes the other spec, and false 481otherwise. Think of "subsumes" as "contains", but we only look at the 482I<specs>, not whether C<$dir> actually contains C<$other> on the 483filesystem. 484 485The C<$other> argument may be a C<Path::Class::Dir> object, a 486C<Path::Class::File> object, or a string. In the latter case, we 487assume it's a directory. 488 489 # Examples: 490 dir('foo/bar' )->subsumes(dir('foo/bar/baz')) # True 491 dir('/foo/bar')->subsumes(dir('/foo/bar/baz')) # True 492 dir('foo/bar' )->subsumes(dir('bar/baz')) # False 493 dir('/foo/bar')->subsumes(dir('foo/bar')) # False 494 495 496=item $boolean = $dir->contains($other) 497 498Returns true if this directory actually contains C<$other> on the 499filesystem. C<$other> doesn't have to be a direct child of C<$dir>, 500it just has to be subsumed. 501 502=item $foreign = $dir->as_foreign($type) 503 504Returns a C<Path::Class::Dir> object representing C<$dir> as it would 505be specified on a system of type C<$type>. Known types include 506C<Unix>, C<Win32>, C<Mac>, C<VMS>, and C<OS2>, i.e. anything for which 507there is a subclass of C<File::Spec>. 508 509Any generated objects (subdirectories, files, parents, etc.) will also 510retain this type. 511 512=item $foreign = Path::Class::Dir->new_foreign($type, @args) 513 514Returns a C<Path::Class::Dir> object representing C<$dir> as it would 515be specified on a system of type C<$type>. Known types include 516C<Unix>, C<Win32>, C<Mac>, C<VMS>, and C<OS2>, i.e. anything for which 517there is a subclass of C<File::Spec>. 518 519The arguments in C<@args> are the same as they would be specified in 520C<new()>. 521 522=item @list = $dir->dir_list([OFFSET, [LENGTH]]) 523 524Returns the list of strings internally representing this directory 525structure. Each successive member of the list is understood to be an 526entry in its predecessor's directory list. By contract, C<< 527Path::Class->new( $dir->dir_list ) >> should be equivalent to C<$dir>. 528 529The semantics of this method are similar to Perl's C<splice> or 530C<substr> functions; they return C<LENGTH> elements starting at 531C<OFFSET>. If C<LENGTH> is omitted, returns all the elements starting 532at C<OFFSET> up to the end of the list. If C<LENGTH> is negative, 533returns the elements from C<OFFSET> onward except for C<-LENGTH> 534elements at the end. If C<OFFSET> is negative, it counts backward 535C<OFFSET> elements from the end of the list. If C<OFFSET> and 536C<LENGTH> are both omitted, the entire list is returned. 537 538In a scalar context, C<dir_list()> with no arguments returns the 539number of entries in the directory list; C<dir_list(OFFSET)> returns 540the single element at that offset; C<dir_list(OFFSET, LENGTH)> returns 541the final element that would have been returned in a list context. 542 543=item $fh = $dir->open() 544 545Passes C<$dir> to C<< IO::Dir->open >> and returns the result as an 546C<IO::Dir> object. If the opening fails, C<undef> is returned and 547C<$!> is set. 548 549=item $dir->mkpath($verbose, $mode) 550 551Passes all arguments, including C<$dir>, to C<< File::Path::mkpath() 552>> and returns the result (a list of all directories created). 553 554=item $dir->rmtree($verbose, $cautious) 555 556Passes all arguments, including C<$dir>, to C<< File::Path::rmtree() 557>> and returns the result (the number of files successfully deleted). 558 559=item $dir->remove() 560 561Removes the directory, which must be empty. Returns a boolean value 562indicating whether or not the directory was successfully removed. 563This method is mainly provided for consistency with 564C<Path::Class::File>'s C<remove()> method. 565 566=item $dir_or_file = $dir->next() 567 568A convenient way to iterate through directory contents. The first 569time C<next()> is called, it will C<open()> the directory and read the 570first item from it, returning the result as a C<Path::Class::Dir> or 571C<Path::Class::File> object (depending, of course, on its actual 572type). Each subsequent call to C<next()> will simply iterate over the 573directory's contents, until there are no more items in the directory, 574and then the undefined value is returned. For example, to iterate 575over all the regular files in a directory: 576 577 while (my $file = $dir->next) { 578 next unless -f $file; 579 my $fh = $file->open('r') or die "Can't read $file: $!"; 580 ... 581 } 582 583If an error occurs when opening the directory (for instance, it 584doesn't exist or isn't readable), C<next()> will throw an exception 585with the value of C<$!>. 586 587=item $dir->recurse( callback => sub {...} ) 588 589Iterates through this directory and all of its children, and all of 590its children's children, etc., calling the C<callback> subroutine for 591each entry. This is a lot like what the C<File::Find> module does, 592and of course C<File::Find> will work fine on C<Path::Class> objects, 593but the advantage of the C<recurse()> method is that it will also feed 594your callback routine C<Path::Class> objects rather than just pathname 595strings. 596 597The C<recurse()> method requires a C<callback> parameter specifying 598the subroutine to invoke for each entry. It will be passed the 599C<Path::Class> object as its first argument. 600 601C<recurse()> also accepts two boolean parameters, C<depthfirst> and 602C<preorder> that control the order of recursion. The default is a 603preorder, breadth-first search, i.e. C<< depthfirst => 0, preorder => 1 >>. 604At the time of this writing, all combinations of these two parameters 605are supported I<except> C<< depthfirst => 0, preorder => 0 >>. 606 607=item $st = $file->stat() 608 609Invokes C<< File::stat::stat() >> on this directory and returns a 610C<File::stat> object representing the result. 611 612=item $st = $file->lstat() 613 614Same as C<stat()>, but if C<$file> is a symbolic link, C<lstat()> 615stats the link instead of the directory the link points to. 616 617=back 618 619=head1 AUTHOR 620 621Ken Williams, kwilliams@cpan.org 622 623=head1 SEE ALSO 624 625Path::Class, Path::Class::File, File::Spec 626 627=cut 628