Merge 55080cc into 6f82229

lib/Path/Iterator/Rule.pm

@@ -179,6 +179,10 @@ sub _iter {
 
     return sub {
         LOOP: {
+              if ( ref $queue[0] eq 'CODE' ) {
+                  unshift @queue, shift(@queue)->();
+                  redo LOOP;
+              }
             my ( $item, $base, $depth, $origin ) = splice( @queue, 0, 4 );
             return unless $item;
             return $item->[0] if ref $item eq 'ARRAY'; # deferred for postorder
@@ -230,31 +234,34 @@ sub _iter {
                 else {
                     my @next;
                     my $depth_p1 = $depth + 1;
+                    my $next;
                     if ($can_children) {
-                        my @paths = $can_children->( $self, $item );
-                        if ($opt_sorted) {
-                            @paths = sort { "$a->[0]" cmp "$b->[0]" } @paths;
-                        }
-                        @next = map { ( $_->[1], $_->[0], $depth_p1, $origin ) } @paths;
+                        $next = sub {
+                            my @paths = $can_children->( $self, $item );
+                            if ($opt_sorted) {
+                                @paths = sort { "$a->[0]" cmp "$b->[0]" } @paths;
+                            }
+                            map { ( $_->[1], $_->[0], $depth_p1, $origin ) } @paths;
+                        };
                     }
                     else {
+                        $next = sub {
                         opendir( my $dh, $string_item );
                         if ($opt_sorted) {
-                            @next =
                               map { ( "$string_item/$_", $_, $depth_p1, $origin ) }
                               sort { $a cmp $b } grep { $_ ne "." && $_ ne ".." } readdir $dh;
                         }
                         else {
-                            @next =
                               map { ( "$string_item/$_", $_, $depth_p1, $origin ) }
                               grep { $_ ne "." && $_ ne ".." } readdir $dh;
                         }
+                    };
                     }
 
                     if ($opt_depthfirst) {
                         # for postorder, requeue as reference to signal it can be returned
                         # without being retested
-                        push @next,
+                        unshift @queue, 
                           [
                             (
                                   $opt_relative
@@ -264,11 +271,11 @@ sub _iter {
                           ],
                           $base, $depth, $origin
                           if $interest && $opt_depthfirst > 0;
-                        unshift @queue, @next;
+                        unshift @queue, $next;
                         redo LOOP if $opt_depthfirst > 0;
                     }
                     else {
-                        push @queue, @next;
+                        push @queue, $next;
                     }
                 }
             }

t/children-order.t

@@ -0,0 +1,109 @@
+use 5.006;
+use strict;
+use warnings;
+use Test::More 0.92;
+use File::Temp;
+use Test::Deep qw/cmp_deeply/;
+use File::pushd qw/pushd/;
+
+use lib 't/lib';
+use PCNTest;
+
+use Path::Iterator::Rule;
+
+{
+
+    package CheckOrder;
+
+    use parent 'Path::Iterator::Rule';
+    use PCNTest;
+
+    our $order;
+    our $td;
+
+    sub new {
+      ( my $class, $td, $order ) = @_;
+      $class->SUPER::new();
+    }
+
+    sub _children {
+        my $self = shift;
+        my $path = "" . shift;
+
+        push @$order, 'children:'. unixify( $path, $td );
+
+        opendir( my $dh, $path );
+        return map { [ $_, "$path/$_" ] }
+          grep { $_ ne "." && $_ ne ".." } readdir $dh;
+    }
+
+}
+
+#--------------------------------------------------------------------------#
+
+{
+    my @tree = qw(
+      aaaa.txt
+      bbbb.txt
+      cccc/dddd.txt
+      cccc/eeee/ffff.txt
+      gggg.txt
+    );
+
+    my @breadth = qw(
+      visit:.
+      children:.
+      visit:aaaa.txt
+      visit:bbbb.txt
+      visit:cccc
+      visit:gggg.txt
+      children:cccc
+      visit:cccc/dddd.txt
+      visit:cccc/eeee
+      children:cccc/eeee
+      visit:cccc/eeee/ffff.txt
+    );
+
+    my @depth_pre = qw(
+      visit:.
+      children:.
+      visit:aaaa.txt
+      visit:bbbb.txt
+      visit:cccc
+      children:cccc
+      visit:cccc/dddd.txt
+      visit:cccc/eeee
+      children:cccc/eeee
+      visit:cccc/eeee/ffff.txt
+      visit:gggg.txt
+    );
+
+    my $td = make_tree(@tree);
+
+    my ( $iter, @order );
+    my $rule = CheckOrder->new( $td, \@order );
+
+    @order = ();
+    my $visitor = sub {
+        push @order, 'visit:'.unixify($_, $td);
+    };
+
+    $rule->all( { depthfirst => 0, visitor => $visitor  }, $td );
+    cmp_deeply( \@order, \@breadth, "Breadth first iteration" )
+      or diag explain \@order;
+
+    @order = ();
+    $rule->all( { depthfirst => -1, visitor => $visitor }, $td );
+    cmp_deeply( \@order, \@depth_pre, "Depth first iteration (pre)" )
+      or diag explain \@order;
+
+    @order = ();
+    $rule->all( { depthfirst => 1, visitor => $visitor }, $td );
+
+    # post and pre have same visit/children pattern
+    cmp_deeply( \@order, \@depth_pre, "Depth first iteration (post)" )
+      or diag explain \@order;
+}
+
+done_testing;
+# COPYRIGHT