Commits

Anonymous committed 734d26f

Added the ->next_obj and ->item_obj() APIs with the ::Result object.

Comments (0)

Files changed (4)

 inc/Test/Run/Builder.pm
 lib/File/Find/Object/Base.pm
 lib/File/Find/Object.pm
+lib/File/Find/Object/Result.pm
 Makefile.PL
 MANIFEST			This list of files
 META.yml            Module meta-data (added by MakeMaker)

lib/File/Find/Object.pm

 
 use base 'File::Find::Object::Base';
 
+use File::Find::Object::Result;
+
 __PACKAGE__->mk_accessors(qw(
     _dir_stack
-    item
+    item_obj
     _targets
     _target_index
 ));
     return File::Spec->catfile(@{$self->_current_components_copy()});
 }
 
-sub next {
+sub _calc_current_item_obj {
+    my $self = shift;
+
+    my $components = $self->_current_components_copy();
+    my $base = shift(@$components);
+    
+    my @basename = ();
+    my $path = $self->_current_path();
+    my $is_dir = -d $path;
+    if (! $is_dir)
+    {
+        @basename = (basename => pop(@$components));
+    }
+
+    return File::Find::Object::Result->new(
+        {
+            @basename,
+            path => $path,
+            is_dir => $is_dir,
+            dir_components => $components,
+            base => $base,
+        }
+    );
+}
+
+sub _calc_next_obj {
     my ($self) = @_;
     while (1) {
         if ($self->_process_current())
         {
-            return $self->item($self->_current_path());
+            return $self->_calc_current_item_obj();
         }
         if(!$self->_movenext) {
             if ($self->_me_die())
             {
-                return $self->item(undef);
+                return undef();
             }
         }
     }
 }
 
+sub next_obj {
+    my $self = shift;
+
+    my $obj = $self->_calc_next_obj();
+
+    return $self->item_obj($obj);
+}
+
+sub next {
+    my $self = shift;
+
+    $self->next_obj();
+
+    return $self->item();
+}
+
+sub item {
+    my $self = shift;
+
+    return $self->item_obj() ? $self->item_obj()->path() : undef;
+}
+
 sub _father
 {
     my ($self, $level) = @_;
 Returns the current filename found by the File::Find::Object object, i.e: the
 last value returned by next().
 
+=head2 next_obj
+
+Like next() only returns the result as a convenient 
+L<File::Find::Object::Result> object. C<< $ff->next() >> is equivalent to
+C<< $ff->next_obj()->path() >>.
+
+=head2 item_obj
+
+Like item() only returns the result as a convenient 
+L<File::Find::Object::Result> object. C<< $ff->item() >> is equivalent to
+C<< $ff->item_obj()->path() >>.
+
 =head2 $ff->set_traverse_to([@children])
 
 Sets the children to traverse to from the current node. Useful for pruning

lib/File/Find/Object/Result.pm

+# This program is free software, distributed under the same terms as 
+# Parrot.
+
+package File::Find::Object::Result;
+
+use strict;
+use warnings;
+
+use base 'Class::Accessor';
+
+__PACKAGE__->mk_accessors(qw(
+    base
+    basename
+    path
+    dir_components
+    is_dir
+));
+
+sub full_components
+{
+    my $self = shift;
+
+    return
+    [ 
+        @{$self->dir_components()},
+        ($self->is_dir() ? () : $self->basename()),
+    ];
+}
+
+1;
+
+=head1 NAME
+
+File::Find::Object::Result - a result class for File::Find::Object
+
+=head1 DESCRIPTION
+
+This is a class returning a single L<File::Find::Object> result as returned
+by its next_obj() method.
+
+=head1 METHODS
+
+=head2 $result->base()
+
+Returns the base directory from which searching began.
+
+=head2 $result->path()
+
+Returns the full path of the result. As such C<< $ffo->next_obj()->path() >>
+is equivalent to C<< $ffo->next() >> .
+
+=head2 $result->is_dir()
+
+Returns true if the result refers to a directory.
+
+=head2 $result->dir_components()
+
+The components of the directory part of the path starting from base() 
+(also the full path if the result is a directory) as an array reference.
+
+=head2 $result->basename()
+
+Returns the basename of the file (if it is a file and not a directory.)
+Otherwise - undef().
+
+=head2 $result->full_components()
+
+Returns the full components of the result with the basename if it is
+a file.
+
+=head1 SEE ALSO
+
+L<File::Find::Object>
 use strict;
 use warnings;
 
-use Test::More tests => 5;
+use Test::More tests => 21;
 
 BEGIN
 {
     chmod (0755, $t->get_path("$test_dir/bar"));
     rmtree($t->get_path("./$test_dir"))
 }
+
+{
+    my $tree =
+    {
+        'name' => "traverse-1/",
+        'subs' =>
+        [
+            {
+                'name' => "b.doc",
+                'contents' => "This file was spotted in the wild.",
+            },            
+            {
+                'name' => "a/",
+            },
+            {
+                'name' => "foo/",
+                'subs' =>
+                [
+                    {
+                        'name' => "yet/",
+                    },
+                ],
+            },
+        ],
+    };
+
+    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-1")
+        );
+
+    {
+        my $r = $ff->next_obj();
+
+        # TEST
+        is ($r->path(), $t->get_path("t/sample-data/traverse-1/"), "Path");
+
+        # TEST
+        is ($r->base(), $t->get_path("./t/sample-data/traverse-1"), "Base");
+
+        # TEST
+        is_deeply ($r->dir_components(), [], "Dir_Components are empty");
+
+        # TEST
+        ok ($r->is_dir(), "Is a directory");
+
+        # TEST
+        is_deeply ($r->full_components(), [], "Full components are empty");
+    }
+
+    {
+        my $r = $ff->next_obj();
+
+        # TEST
+        is ($r->path(), $t->get_path("t/sample-data/traverse-1/a"), "Path");
+
+        # TEST
+        is ($r->base(), $t->get_path("./t/sample-data/traverse-1"), "Base");
+
+        # TEST
+        is_deeply ($r->dir_components(), [qw(a)], "Dir_Components are 'a'");
+
+        # TEST
+        ok ($r->is_dir(), "Is a directory");
+
+        # TEST
+        is_deeply ($r->full_components(), [qw(a)], "Full components are 'a'");
+    }
+
+    {
+        my $r = $ff->next_obj();
+
+        # TEST
+        is ($r->path(), $t->get_path("t/sample-data/traverse-1/b.doc"), "Path");
+
+        # TEST
+        is ($r->base(), $t->get_path("./t/sample-data/traverse-1"), "Base");
+
+        # TEST
+        is_deeply ($r->dir_components(), [], "Dir_Components are empty");
+
+        # TEST
+        ok (!$r->is_dir(), "Not a directory");
+
+        # TEST
+        is_deeply ($r->full_components(), [qw(b.doc)], 
+            "Full components are 'b.doc'"
+        );
+
+        # TEST
+        is ($r->basename(), "b.doc", "Basename is 'b.doc'");
+    }
+
+=begin Hello
+    is_deeply(
+        \@results,
+        [(map { $t->get_path("t/sample-data/traverse-1/$_") }
+            ("", qw(
+                a
+                b.doc
+                foo
+                foo/yet
+            ))),
+         undef
+        ],
+        "Checking for regular, lexicographically sorted order",
+    );
+=end Hello
+
+=cut
+
+    rmtree($t->get_path("./t/sample-data/traverse-1"))
+}