Commits

Anonymous committed fb97d94

Added set_traverse_to(), get_traverse_to(), and get_current_node_files().

  • Participants
  • Parent commits 57a3a6e

Comments (0)

Files changed (4)

 lib/File/Find/Object.pm
 Makefile.PL
 MANIFEST			This list of files
-META.yml
+META.yml            Module meta-data (added by MakeMaker)
 README
 t/01ffo.t
 t/02tree-create.t
 t/03traverse.t
 t/04destroy.t
+t/05prune.t
 t/lib/File/Find/Object/TreeCreate.pm
 tree
 t/sample-data/h.txt

lib/File/Find/Object.pm

     $self->dir($top->current_path($from));
     $self->idx($index);
 
-    bless($self, $class);
+    $self->_was_dir_scanned(0);
 
     $from->dir($self->dir());
 
 use base 'File::Find::Object::Base';
 
 __PACKAGE__->mk_accessors(qw(
+    _current_idx
     _dir_stack
     item
     _targets
     }
     $tree->_targets([ @targets ]);
     $tree->_target_index(-1);
+    $tree->_current_idx(-1);
 
     return $tree;
 }
 sub _current
 {
     my $self = shift;
-    return $self->_dir_stack()->[-1] || $self;
+
+    my $dir_stack = $self->_dir_stack();
+
+    if ($self->_current_idx < 0)
+    {
+        return $self;
+    }
+    else
+    {
+        return $dir_stack->[$self->_current_idx];
+    }
 }
 
 sub next {
 {
     my ($self, $current) = @_;
 
+    if (!defined($current))
+    {
+        require Data::Dumper;
+        print Data::Dumper->new([$self],['$self'])->Dump();
+        confess "Current is undef";
+    }
+
     if (!defined($current->idx()))
     {
         return undef;
 {
     my $self = shift;
     if ($self->_current->_curr_file(
-            shift(@{$self->_father($self->_current)->_files()})
+            shift(@{$self->_father($self->_current)->_traverse_to()})
        ))
     {
         $self->_current->_action({});
     if ($self eq $current)
     {
         @{$self->_dir_stack()} = ();
+        $self->_current_idx(-1);
     }
     else
     {
         while (scalar(@{$self->_dir_stack()}) != $current->idx() + 1)
         {
             pop(@{$self->_dir_stack()});
+            $self->_current_idx($self->_current_idx()-1);
         }
     }
 
         }
             
         if ($action eq 'b') {
-            $self->check_subdir($current) or next;
-            push @{$self->_dir_stack()}, 
-                File::Find::Object::PathComponent->new(
-                    $self,
-                    $current, 
-                    scalar(@{$self->_dir_stack()})
-                );
-            return 0;
+            my $status = $self->_recurse($current);
+            
+            if ($status eq "SKIP")
+            {
+                next;
+            }
+            else
+            {
+                $self->_current_idx($self->_current_idx()+1);
+                return $status;
+            }
         }
     }
     return 0;
 }
 
+sub _recurse
+{
+    my ($self, $current) = @_;
+    $self->check_subdir($current) or 
+        return "SKIP";
+    
+    push @{$self->_dir_stack()}, 
+        File::Find::Object::PathComponent->new(
+            $self,
+            $current,
+            scalar(@{$self->_dir_stack()})
+        );
+
+    return 0;
+}
+
 sub isdot
 {
     my ($self, $current) = @_;
 sub open_dir {
     my ($self, $current) = @_;
     opendir(my $handle, $current->dir()) or return undef;
+    my @files = (sort { $a cmp $b } File::Spec->no_upwards(readdir($handle)));
+    closedir($handle);
+
     $current->_files(
-        [ sort { $a cmp $b } File::Spec->no_upwards(readdir($handle)) ]
+        [ @files ]
     );
-    closedir($handle);
+    $current->_traverse_to(
+        [ @files ]
+    );
+
+    
     my @st = stat($current->dir());
     $current->inode($st[1]);
     $current->dev($st[0]);
     return 1;
 }
 
+sub set_traverse_to
+{
+    my ($self, $children) = @_;
+    $self->_current->_traverse_to([@$children]);
+}
+
+sub get_traverse_to
+{
+    my $self = shift;
+
+    return [ @{$self->_current->traverse_to()} ];
+}
+
+sub get_current_node_files_list
+{
+    my $self = shift;
+
+    # Remming out because it doesn't work.
+    # $self->_father($self->_current)->dir($self->_current->dir());
+
+    $self->_recurse($self->_current);
+
+    return [ @{$self->_current->_files()}];
+}
+
+
 1;
 
 __END__
 Returns the current filename found by the File::Find::Object object, i.e: the
 last value returned by next().
 
+=head2 $ff->set_traverse_to([@children])
+
+Sets the children to traverse to from the current node. Useful for pruning
+items to traverse.
+
+=head2 [@children] = $ff->get_traverse_to()
+
+Retrieves the children that will be traversed to.
+
+=head2 [@files] = $ff->get_current_node_files_list()
+
+Gets all the files that appear in the current directory. This value is
+constant for every node, and is useful to use as the basis of the argument
+for C<set_traverse_to()>.
+
 =head1 BUGS
 
 Currently works only on UNIX as it uses '/' as a path separator.

lib/File/Find/Object/Base.pm

     _files
     idx
     inode
+    _traverse_to
+    _was_dir_scanned
 ));
 
 1;
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+
+BEGIN
+{
+    use File::Spec;
+    use lib File::Spec->catdir(File::Spec->curdir(), "t", "lib");
+}
+
+use File::Find::Object::TreeCreate;
+use File::Find::Object;
+
+use File::Path;
+
+{
+    my $tree =
+    {
+        'name' => "traverse-2/",
+        'subs' =>
+        [
+            {
+                'name' => "b.doc",
+                'contents' => "This file was spotted in the wild.",
+            },            
+            {
+                'name' => "a/",
+            },
+            {
+                'name' => "foo/",
+                'subs' =>
+                [
+                    {
+                        'name' => "please-prune-me/",
+                        'subs' =>
+                        [
+                            {
+                                'name' => "a-non-reachable-dir/",
+                                'subs' =>
+                                [
+                                    {
+                                        'name' => "dir1/",
+                                    },
+                                    {
+                                        'name' => "dir2/",
+                                    },
+                                    {
+                                        'name' => 
+                                            "if-we-get-this-its-wrong.txt",
+                                        'content' => "Hi ho!",
+                                    },
+                                ],
+                            },                        
+                            {
+                                'name' => "h.rnd",
+                                'contents' => "This file is empty.",
+                            },
+                            {
+                                'name' => "lambda.calculus",
+                                'contents' => '\f \x (f (f x))'
+                            },
+                        ],
+                    },
+                ],
+            },
+        ],
+    };
+
+    my $t = File::Find::Object::TreeCreate->new();
+    $t->create_tree("./t/sample-data/", $tree);
+    my $ff = 
+        File::Find::Object->new(
+            {},
+            $t->get_path("./t/sample-data/traverse-2")
+        );
+    my @results;
+    for my $i (1 .. 7)
+    {
+        my $file = $ff->next();
+        if ($file eq 
+            $t->get_path("t/sample-data/traverse-2/foo/please-prune-me")
+           )
+        {
+            $ff->set_traverse_to(
+                [
+                    grep { $_ !~ /non-reachable/ } 
+                    @{$ff->get_current_node_files_list()}
+                ]
+            );
+        }
+        push @results, $file;
+    }
+    # TEST
+    is_deeply(
+        \@results,
+        [(map { $t->get_path("t/sample-data/traverse-2/$_") }
+            ("", 
+            qw(
+                a
+                b.doc
+                foo
+                foo/please-prune-me
+                foo/please-prune-me/h.rnd
+                foo/please-prune-me/lambda.calculus
+            )))
+        ],
+        "Checking for regular, lexicographically sorted order",
+    );
+
+    rmtree($t->get_path("./t/sample-data/traverse-2"))
+}
+