| Subject: | [PATCH] implement fmap_cont |
The attached patch implements the fmap_cont method, similar to the one
in Forest::Tree::Pure. It's an alternative to ->recurse, which allows
for more control over how the recursion happens.
| Subject: | 0001-implement-fmap_cont.patch |
From 3ae2c3aaba20430b6fd5db458f2a0a6b76774d99 Mon Sep 17 00:00:00 2001
From: Jesse Luehrs <doy@tozt.net>
Date: Thu, 8 Sep 2011 17:45:32 -0500
Subject: [PATCH] implement fmap_cont
---
lib/Path/Class/Dir.pm | 48 +++++++++++++++++++++++++++++++++++++++++++++
lib/Path/Class/File.pm | 11 ++++++++++
t/05-fmap_cont.t | 51 ++++++++++++++++++++++++++++++++++++++++++++++++
3 files changed, 110 insertions(+), 0 deletions(-)
create mode 100644 t/05-fmap_cont.t
diff --git a/lib/Path/Class/Dir.pm b/lib/Path/Class/Dir.pm
index e0506d6..20eda2a 100644
--- a/lib/Path/Class/Dir.pm
+++ b/lib/Path/Class/Dir.pm
@@ -135,6 +135,19 @@ sub remove {
rmdir( shift() );
}
+sub fmap_cont {
+ my $self = shift;
+ my ($callback, @args) = @_;
+ my @children = $self->children;
+ return $self->$callback(
+ sub {
+ my @inner_args = @_;
+ return map { $_->fmap_cont($callback, @inner_args) } @children;
+ },
+ @args
+ );
+}
+
sub recurse {
my $self = shift;
my %opts = (preorder => 1, depthfirst => 0, @_);
@@ -643,6 +656,41 @@ If an error occurs when opening the directory (for instance, it
doesn't exist or isn't readable), C<next()> will throw an exception
with the value of C<$!>.
+=item $dir->fmap_cont( sub { ... }, @args )
+
+Calls the given callback for the root, passing it a continuation
+function which, when called, will call this recursively on each of its
+children. The callback function should be of the form:
+
+ sub {
+ my ($child, $cont, @args) = @_;
+ # ...
+ }
+
+For instance, to calculate the number of files in a directory, you
+can do this:
+
+ my $nfiles = $dir->fmap_cont(sub {
+ my ($child, $cont) = @_;
+ return sum($cont->(), ($child->is_dir ? 0 : 1));
+ });
+
+or to calculate the maximum depth of a directory:
+
+ my $depth = $dir->fmap_cont(sub {
+ my ($child, $cont, $depth) = @_;
+ return max($cont->($depth + 1), $depth);
+ }, 0);
+
+You can also choose not to call the callback in certain situations:
+
+ $dir->fmap_cont(sub {
+ my ($child, $cont) = @_;
+ return if -l $child; # don't follow symlinks
+ # do something with $child
+ return $cont->();
+ });
+
=item $dir->recurse( callback => sub {...} )
Iterates through this directory and all of its children, and all of
diff --git a/lib/Path/Class/File.pm b/lib/Path/Class/File.pm
index 880bad7..c05b323 100644
--- a/lib/Path/Class/File.pm
+++ b/lib/Path/Class/File.pm
@@ -92,6 +92,12 @@ sub remove {
return not -e $file;
}
+sub fmap_cont {
+ my $self = shift;
+ my ($callback, @args) = @_;
+ return $self->$callback(sub { () }, @args);
+}
+
1;
__END__
@@ -308,6 +314,11 @@ a I<reading> mode.
The default C<iomode> is C<r>.
+=item $file->fmap_cont(sub { ... }, @args)
+
+Calls the given callback on $file. This doesn't do much on its own,
+but see the associated documentation in L<Path::Class::Dir>.
+
=item $file->remove()
This method will remove the file in a way that works well on all
diff --git a/t/05-fmap_cont.t b/t/05-fmap_cont.t
new file mode 100644
index 0000000..f079621
--- /dev/null
+++ b/t/05-fmap_cont.t
@@ -0,0 +1,51 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Cwd;
+use Test::More;
+use File::Temp qw(tempdir);
+
+plan tests => 4;
+
+use_ok 'Path::Class';
+
+my $cwd = getcwd;
+my $tmp = dir(tempdir(CLEANUP => 1));
+
+# Test recursive iteration through the following structure:
+# a
+# / \
+# b c
+# / \ \
+# d e f
+# / \ \
+# g h i
+(my $abe = $tmp->subdir(qw(a b e)))->mkpath;
+(my $acf = $tmp->subdir(qw(a c f)))->mkpath;
+$acf->file('i')->touch;
+$abe->file('h')->touch;
+$abe->file('g')->touch;
+$tmp->file(qw(a b d))->touch;
+
+my $a = $tmp->subdir('a');
+
+my $nnodes = $a->fmap_cont(sub {
+ my ($child, $cont) = @_;
+ return sum($cont->(), 1);
+});
+is($nnodes, 9);
+
+my $ndirs = $a->fmap_cont(sub {
+ my ($child, $cont) = @_;
+ return sum($cont->(), ($child->is_dir ? 1 : 0));
+});
+is($ndirs, 5);
+
+my $max_depth = $a->fmap_cont(sub {
+ my ($child, $cont, $depth) = @_;
+ return max($cont->($depth + 1), $depth);
+}, 0);
+is($max_depth, 3);
+
+sub sum { my $total = 0; $total += $_ for @_; $total }
+sub max { my $max = 0; for (@_) { $max = $_ if $_ > $max } $max }
--
1.7.6.1