File::Fu::Dir - a directoryname object

File-Fu documentation Contained in the File-Fu distribution.

Index

Code Index:

NAME

Top

File::Fu::Dir - a directoryname object

SYNOPSIS

Top

  use File::Fu;

  my $dir = File::Fu->dir("path/to/dir");
  $dir->e and warn "$dir exists";

  $dir->l and warn "$dir is a link to ", $dir->readlink;

  foreach my $entry ($dir->list) {
    warn $entry . ': ' . $entry->stat->size, "\n"
      if($entry->f);
  }

Constructor

Top

new

  my $dir = File::Fu::Dir->new($path);

  my $dir = File::Fu::Dir->new(@path);

Class Constants/Methods

Top

file_class

Return the corresponding file class for this dir object.

  my $fc = $class->file_class;

is_dir

Always true for a directory.

is_file

Always false for a directory.

temp_dir_class

  my $class = File::Fu::Dir->temp_dir_class;

temp_file_class

  my $class = File::Fu::Dir->temp_file_class;

Methods

Top

stringify

  my $string = $dir->stringify;

bare

Stringify without the trailing slash/assertion.

  my $str = $self->bare;

The trailing slash causes trouble when trying to address a symlink to a directory via a dir object. Thus, -l $dir doesn't work, but $dir->l does the same thing as -l $dir->bare.

file

Create a filename object with $dir as its parent.

  my $file = $dir->file($filename);

  my $file = $dir + $filename;

append

Append a string only to the last directory part.

  $dir->append('.tmp');

  $dir %= "something";

subdir

  $newdir = $dir->subdir('foo');

  $dir /= 'foo';

part

Returns the $i'th part of the directory list.

  my $part = $dir->part($i);

$dir->part(-1) is like $dir->basename, but not an object and not quite like File::Basename::basename() when it comes to the / directory.

end

Shorthand for part(-1);

parts

Retrieve the inner list of the directory's parts.

  my @parts = $dir->parts;

  my @parts = $dir->parts(0..2);

The returned parts will be contiguous, but the request can be a two-element list (and can also start or end at negative indices.)

  my @parts = $dir->parts(3, 7);

  my @parts = $dir->parts(3, -1);

  my @parts = $dir->parts(-5, -1);

slice

Returns a new dir object as the return of parts().

  my $slice = $dir->slice(0);

  my $slice = $dir->slice(0,3);

map

Execute a callback on each part of $dir. The sub should modify $_ (yes, this is slightly unlike the map() builtin.)

If $parts is defined as an integer or array reference of integers, it will be treated as a slice on the directory parts to which the map should be applied.

  $dir->map(sub {...}, [@parts]);

  $dir &= sub {s/foo$/bar/};

So, to modify only the first directory part:

  $dir->map(sub {s/foo$/bar/}, 0);

Properties

Top

is_cwd

True if the $dir represents a relative (e.g. '.') directory.

  my $bool = $dir->is_cwd;

basename

Returns the last part of the path as a Dir object.

  my $bit = $dir->basename;

dirname

Returns the parent parts of the path as a Dir object.

  my $parent = $dir->dirname;

absolute

Get an absolute name (without checking the filesystem.)

  my $abs = $dir->absolute;

absolutely

Get an absolute path (resolved on filesystem, so it must exist.)

  my $abs = $dir->absolutely;

Doing stuff

Top

open

Calls opendir(), but throws an error if it fails.

  my $dh = $dir->open;

Returns a directory handle, for e.g. readdir().

  my @files = map({$dir + $_} grep({$_ !~ m/^\./} readdir($dh)));

touch

Update the timestamp of a directory (croak if it doesn't exist.)

  $dir->touch;

list

  my @paths = $dir->list(all => 1);

lister

  my $subref = $dir->lister(all => 1);

contents

Equivelant to readdir. With the 'all' option true, returns hidden names too (but not the '.' and '..' entries.)

The return values are strings, not File::Fu objects.

  my @names = $dir->contents(all => 1);

iterate_contents

Returns a subref which will iterate over the directory's contents.

  my $subref = $dir->iterate_contents(all => 1);

find

Recursively search a directory's contents for items where the supplied coderef (matcher) returns true. The matcher will be invoked with the topic ($_) set to the current path (which is either a Dir or File object.) The return values will be File::Fu::File or File::Fu::Dir objects.

If your matcher returns true, the topic will be added to the return values.

  my @paths = $dir->find(sub {m/foo/});

There is a knob for controlling recursion, which is the first argument to your matcher.

  my @pm_files = $dir->find(sub {
    return shift->prune
      if($_->is_dir and $_->part(-1) =~ m/^\.svn$/);
    $_->is_file and m/\.pm$/;
  });
Differences from File::Find::find()

The invocant ($dir aka '.') is not examined (because this is an object method, there is always only one starting path.)

The topic is always absolute in the same sense as the invocant. That is, if $dir is relative to your current directory, then so are the topics and return values. If $dir is absolute, so are the topics and return values.

finder

Returns an iterator for finding files. This iterator does everything that find() does, but returns one path at a time. Returns undef when exhausted and zero when it is just taking a break.

  my $subref = $dir->finder(sub {$_->is_file and $_->file =~ m/foo/});

This allows a non-blocking find.

  while(defined(my $path = $subref->())) {
    $path or next; # 0 means 'not done yet'
    # do something with $path (a file or dir object)
  }

The find() method is implemented in terms of finder() by simply using a while() loop and accumulating the return values.

The FindKnob object

The FindKnob object allows you to control the next steps of find(). Methods called on it will typically return a value which also makes sense as a return value of your matcher sub. Thus the idiom:

  $dir->find(sub {return shift->prune if(condition); ...})
prune

Do not recurse into the topic directory. Returns false.

mkdir

Create the directory or croak with an error.

  $dir->mkdir;

  $dir->mkdir(0700);

create

Create the directory, with parents if needed.

  $dir->create;

rmdir

Remove the directory or croak with an error.

  $dir->rmdir;

remove

Remove the directory and all of its children.

  $dir->remove;


  $link->unlink;

Create a symlink which points to $dir.

  my $link = $dir->symlink($linkname);

Note that symlinks are relative to where they live, so if $dir is a relative path, it must be relative to $linkname.

  my $to = $file->readlink;

Changing Directories

Top

chdir

Change to the directory in self, returning a new '.' directory object.

  $dir = $dir->chdir;

chdir_for

Change to $dir and run the given subroutine. The sub will be passed a './' directory object.

  $dir->chdir_for(sub {...});

chdir_local

Change to $dir, but return to the current cwd when $token goes out of scope.

  my $token = $self->chdir_local;

Temporary Directories and Files

Top

These methods use the $dir object as a parent location for the temp path. To use your system's global temp space (e.g. '/tmp/'), just replace $dir with 'File::Fu'.

  File::Fu->temp_dir;              # '/tmp/'
  File::Fu->dir->temp_dir;         # './'
  File::Fu->dir("foo")->temp_dir;  # 'foo/'

  File::Fu->temp_file;             # '/tmp/'
  File::Fu->dir->temp_file;        # './'
  File::Fu->dir("foo")->temp_file; # 'foo/'

temp_dir

Return a temporary directory in $dir.

  my $dir = $dir->temp_dir;

temp_file

Return a filehandle to a temporary file in $dir.

  my $handle = $dir->temp_file;

AUTHOR

Top

Eric Wilhelm @ <ewilhelm at cpan dot org>

http://scratchcomputing.com/

BUGS

Top

If you found this module on CPAN, please report any bugs or feature requests through the web interface at http://rt.cpan.org. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.

If you pulled this development version from my /svn/, please contact me directly.

COPYRIGHT

Top

Copyright (C) 2008 Eric L. Wilhelm, All Rights Reserved.

NO WARRANTY

Top

Absolutely, positively NO WARRANTY, neither express or implied, is offered with this software. You use this software at your own risk. In case of loss, no person or entity owes you anything whatsoever. You have been warned.

LICENSE

Top

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

File-Fu documentation Contained in the File-Fu distribution. 
package File::Fu::Dir;
$VERSION = v0.0.7;

use warnings;
use strict;
use Carp;

use Cwd ();

use File::Path (); # for now

use File::Fu::Dir::Temp;
use File::Fu::File::Temp;


use base 'File::Fu::Base';

use overload (
  '+'  => 'file',
  '/'  => 'subdir',
);


sub new {
  my $package = shift;
  my $class = ref($package) || $package;
  my $self = {$class->_init(@_)};
  bless($self, $class);
  return($self);
} # end subroutine new definition
########################################################################


use constant top_class => 'File::Fu';
use constant file_class => 'File::Fu::File';
use constant token_class => 'File::Fu::Dir::Token';
use constant is_dir => 1;
use constant is_file => 0;

########################################################################


sub temp_dir_class {
  my $package = shift;
  my $class = ref($package) . '::Temp';
  $class = __PACKAGE__ . '::Temp' unless($class->can('new'));
  return($class);
} # end subroutine temp_dir_class definition
########################################################################


sub temp_file_class {
  my $package = shift;
  my $class = $package->file_class . '::Temp';
  $class = __PACKAGE__->file_class.'::Temp' unless($class->can('new'));
  return($class);
} # end subroutine temp_file_class definition
########################################################################


sub _init {
  my $class = shift;
  @_ or return(dirs => ['.']);
  my $dirs = [map({
    $_ eq '' ? ('') : split(/\/+/, $_)
  } @_)];
  @$dirs or $dirs = ['']; # XXX
  return(dirs => $dirs);
} # end subroutine _init definition
########################################################################


sub stringify {
  my $self = shift;
  #Carp::carp("stringify", overload::StrVal($self));
  #defined($self->{dirs}) or croak("how did this happen?");
  my @dirs = @{$self->{dirs}};
  #warn "I'm (", join(',', @{$self->{dirs}}), ")";
  @dirs or return('/');
  # TODO volume
  join('/', @dirs, ''); # always a trailing slash
} # end subroutine stringify definition
########################################################################


*l = sub {-l shift->bare};


sub bare {
  my $self = shift;
  my @dirs = @{$self->{dirs}};
  @dirs or return('/');
  # TODO volume
  join('/', @dirs); # always a trailing slash
} # end subroutine bare definition
########################################################################


sub file {
  my $self = shift;
  my ($name, $rev) = @_;
  $rev and croak("bah");

  # filename might have dir parts
  if($name =~ m#/#) {
    my $bit = $self->file_class->new($name);
    return $self->file_class->new_direct(
      dir  => $self->subdir($bit->dirname),
      file => $bit->basename
    );
  }

  return($self->file_class->new_direct(dir => $self, file => $name));
} # end subroutine file definition
########################################################################


sub append {
  my $self = shift;
  my ($bit, $rev) = @_;

  $rev and return($bit . "$self"); # stringify is out-of-order
  #carp("appending $bit");
  #$self = $self->clone;
  $self->{dirs}[-1] .= $bit;
  return($self);
} # end subroutine append definition
########################################################################


sub subdir {
  my $self = shift;
  my ($name, $rev) = @_;
  $rev and croak("bah");

  # appending to cwd means starting over
  return($self->new($name)) if($self->is_cwd);

  my %newbits = $self->_init($name);
  $self = $self->clone;
  push(@{$self->{dirs}}, @{$newbits{dirs}});
  $self;
} # end subroutine subdir definition
########################################################################


sub part {
  my $self = shift;
  my ($i) = @_;
  return($self->{dirs}[$i]);
} # end subroutine part definition
########################################################################


sub end {shift->part(-1)};


sub parts {
  my $self = shift;
  my @want = @_;
  @want or return(@{$self->{dirs}});
  if(@want == 2) {
    foreach my $end (@want) {
      $end = $#{$self->{dirs}} + 1 + $end if($end < 0);
    }
    if($want[0] > $want[1]) {
      croak("first endpoint '$want[0]' is after last '$want[1]'");
    }
    @want = $want[0]..$want[1];
  }
  # TODO else check contiguity?
  return(@{$self->{dirs}}[@want]);
} # end subroutine parts definition
########################################################################


sub slice {
  my $self = shift;
  $self = $self->clone;
  @{$self->{dirs}} = $self->parts(@_);
  return($self);
} # end subroutine slice definition
########################################################################


sub map :method {
  my $self = shift;
  my ($sub, $parts) = @_;
  my @parts = defined($parts) ? (ref($parts) ? @$parts : $parts) :
    0..($#{$self->{dirs}});
  # TODO actually use the parts() code for this
  # warn "@parts"; 
  foreach my $dir (@{$self->{dirs}}[@parts]) {
    local $_ = $dir;
    $sub->();
    $dir = $_;
  }
  $self;
} # end subroutine map definition
########################################################################


sub is_cwd {
  my $self = shift;

  my @dirs = @{$self->{dirs}};
  return(@dirs == 1 and $dirs[0] eq '.');
} # end subroutine is_cwd definition
########################################################################


sub basename {
  my $self = shift;
  return($self->new($self->{dirs}[-1]));
} # end subroutine basename definition
########################################################################


sub dirname {
  my $self = shift;
  $self = $self->clone;
  my $dirs = $self->{dirs};
  if(@$dirs == 1 and $dirs->[0] eq '') {
    return($self->new('/'));
  }
  pop(@$dirs);
  @$dirs or return($self->new);
  return($self);
} # end subroutine dirname definition
########################################################################


sub absolute {
  my $self = shift;
  return $self if $self->is_absolute;
  return $self->new(File::Spec->rel2abs($self->stringify));
} # end subroutine absolute definition
########################################################################


sub absolutely {
  my $self = shift;
  my $res = Cwd::abs_path($self->stringify);
  defined($res) or croak("$self absolutely() not found");
  return $self->new($res);
} # end subroutine absolutely definition
########################################################################


sub open :method {
  my $self = shift;

  opendir(my $dh, "$self") or die "cannot opendir '$self' $!";
  return($dh);
} # end subroutine open definition
########################################################################


sub touch {
  my $self = shift;
  $self->utime(time);
} # end subroutine touch definition
########################################################################


sub list {
  my $self = shift;

  map({my $d = $self/$_; -d $d ? $d : $self+$_} $self->contents(@_));
} # end subroutine list definition
########################################################################


sub lister {
  my $self = shift;
  my $csub = $self->iterate_contents(@_);
  my $sub = sub {
    $csub or return();
    while(defined(my $n = $csub->())) {
      my $d = $self/$n;
      return(-d $d->bare ? $d : $self+$n)
    }
    $csub = undef;
    return();
  };
  return($sub);
} # end subroutine lister definition
########################################################################


sub contents {
  my $self = shift;
  (@_ % 2) and croak('odd number of items in options hash');
  my %opts = @_;
  my $dh = $self->open;
  # XXX needs more cross-platformness
  $opts{all} and return(grep({$_ !~ m/^\.{1,2}$/} readdir($dh)));
  return(grep({$_ !~ m/^\./} readdir($dh)));
} # end subroutine contents definition
########################################################################


sub iterate_contents {
  my $self = shift;
  (@_ % 2) and croak('odd number of items in options hash');
  my %opts = @_;
  my $all = $opts{all};
  my $dh = $self->open;
  # XXX needs more cross-platformness
  return sub {
    $dh or return();
    while(defined(my $n = readdir($dh))) {
      if($all) {
        return($n) unless($n =~ m/^\.{1,2}$/);
      }
      else {
        return($n) unless($n =~ m/^\./);
      }
    }
    $dh = undef;
    return();
  };
} # end subroutine iterate_contents definition
########################################################################


sub find {
  my $self = shift;

  my @return;
  my $finder = $self->finder(@_);
  while(defined(my $ans = $finder->())) {
    $ans or next;
    push(@return, $ans);
  }
  return(@return);
} # end subroutine find definition
########################################################################


sub finder {
  my $self = shift;
  my ($matcher, @opt) = @_; # TODO support options e.g. loops

  my %opt = (all => 1);

  my $reader;
  my @stack;
  my $it = sub {
    my $loops = 0;
    FIND: {
      $reader ||= $self->lister(all => $opt{all});
      $loops++;
      if(defined(my $path = $reader->())) {
        if($path->is_dir and not $path->l) {
          push(@stack, [$self, $reader]);
          ($self, $reader) = ($path, undef);
        }
        local $_ = $path;
        my $ok = $matcher->(my $knob = File::Fu::Dir::FindKnob->new);
        if($knob->pruned and not $path->l) { # XXX nofollow assumption
          ($self, $reader) = @{pop(@stack)};
        }
        if($ok) {
          return($path);
        }
        redo FIND if($loops < 50);
        return(0); # no match, but continue
      }
      else {
        @stack or return();
        ($self, $reader) = @{pop(@stack)};
        redo FIND;
      }
    }
  };
  return($it);
} # end subroutine finder definition
########################################################################


BEGIN {
package File::Fu::Dir::FindKnob;
use Class::Accessor::Classy;
with 'new';
ri 'pruned';
no  Class::Accessor::Classy;
sub prune {shift->set_pruned(1); 0}
} # File::Fu::Dir::FindKnob
########################################################################


sub mkdir :method {
  my $self = shift;
  if(@_) {
    my $mode = shift(@_);
    mkdir($self, $mode) or croak("cannot mkdir('$self', $mode) $!");
  }
  else {
    mkdir($self) or croak("cannot mkdir('$self') $!");
  }
  return($self);
} # end subroutine mkdir definition
########################################################################


sub create {
  my $self = shift;
  # TODO pass mode, but the verbose parameter is silly (should have been
  # a callback or something -- so we'll end up reimplementing mkpath?)
  File::Path::mkpath("$self");
  return($self);
} # end subroutine create definition
########################################################################


sub rmdir :method {
  my $self = shift;
  rmdir($self) or croak("cannot rmdir('$self') $!");
} # end subroutine rmdir definition
########################################################################


sub remove {
  my $self = shift;
  my $dir = $self->stringify;
  File::Path::rmtree($dir);
  -e $dir and croak("rmtree failed"); # XXX rmtree is buggy
} # end subroutine remove definition
########################################################################


sub unlink :method {
  my $self = shift;
  $self->l or croak("not a link");
  unlink($self->bare) or croak("unlink '$self' failed $!");
} # end subroutine unlink definition
########################################################################


sub symlink :method {
  my $self = shift;
  my ($name) = @_;

  $name =~ s#/$##; # stringify and strip
  symlink($self, $name) or
    croak("symlink '$self' to '$name' failed $!");
  return($self->new($name));
} # end subroutine symlink definition
########################################################################


sub readlink :method {
  my $self = shift;
  my $name = readlink($self->bare);
  defined($name) or croak("cannot readlink '$self' $!");
  return($self->new($name));
} # end subroutine readlink definition
########################################################################


sub chdir :method {
  my $self = shift;
  chdir($self) or croak("cannot chdir '$self' $!");
  # should return a new '.' object ?
  return($self->new('.'));
} # end subroutine chdir definition
########################################################################


sub chdir_for {
  my $self = shift;
  my ($sub) = @_;
  # we need to guarantee that we return, so we must implement the scoped
  # version in order to implement the wrapper.
  my $dot = $self->chdir_local;
  # XXX bah.  the $token binds weirdly in 5.6.2
  return $sub->($self->new('.'));
} # end subroutine chdir_for definition
########################################################################


sub chdir_local {
  my $self = shift;
  my $now = $self->top_class->cwd;
  $self->chdir;
  return $self->token_class->new->return_to($now);
} # end subroutine chdir_local definition
########################################################################
BEGIN {
package File::Fu::Dir::Token;
our @ISA = qw('File::Fu::Dir);
sub return_to {
  my $self = shift(@_);
  $self->{return_to} = shift(@_) or croak("invalid usage");
  return($self);
}
sub DESTROY { my $ret = shift->{return_to} or return; $ret->chdir; }
}
########################################################################


sub temp_dir {
  my $self = shift;
  $self->temp_dir_class->new($self, @_);
} # end subroutine temp_dir definition
########################################################################


sub temp_file {
  my $self = shift;
  $self->temp_file_class->new($self, @_);
} # end subroutine temp_file definition
########################################################################


require File::Fu;
# vi:ts=2:sw=2:et:sta
1;