Anonymous avatar Anonymous committed 33a98d1

Fixed a bug where circular references prevented the module from being
destroyed when it goes out of scope.

Comments (0)

Files changed (4)

 t/01ffo.t
 t/02tree-create.t
 t/03traverse.t
+t/04destroy.t
 t/lib/File/Find/Object/TreeCreate.pm
 tree
 t/sample-data/h.txt

lib/File/Find/Object.pm

         filter => $options->{filter},
         callback => $options->{callback},
     };
-    $tree->{_top} = $tree;
     bless($tree, $class);
 }
 
+sub _top
+{
+    my $self = shift;
+    if (defined($self->{_top}))
+    {
+        return $self->{_top};
+    }
+    else
+    {
+        return $self;
+    }
+}
+
 sub DESTROY {
     my ($self) = @_;
 #    print STDERR join(" ", caller)."\n";
     $self->isdot and return 0;
     $self->filter or return 0;  
 
-    foreach ($self->{_top}->{depth} ? qw/b a/ : qw/a b/) {
+    foreach ($self->_top->{depth} ? qw/b a/ : qw/a b/) {
         if ($self->{_action}{$_}) {
             next;
         }
         $self->{_action}{$_} = 1;
         if($_ eq 'a') {
-            if ($self->{_top}->{callback}) {
-                $self->{_top}->{callback}->($self->current_path());
+            if ($self->_top->{callback}) {
+                $self->_top->{callback}->($self->current_path());
             }
             return 1;
         }
 
 sub filter {
     my ($self) = @_;
-    return defined($self->{_top}->{filter}) ?
-        $self->{_top}->{filter}->($self->current_path()) :
+    return defined($self->_top->{filter}) ?
+        $self->_top->{filter}->($self->current_path()) :
         1;
 }
 

lib/File/Find/Object/internal.pm

     my ($class, $from) = @_;
     my $self = {
         _father => $from,
-        _top => $from->{_top},
+        _top => $from->_top,
         dir => $from->current_path,
     };
 
 
 sub become_default {
     my ($self) = @_;
-    $self->{_top}->{_current} = $self;
+    $self->_top->{_current} = $self;
     0
 }
 
 sub set_current {
     my ($self, $current) = @_;
-    $self->{_top}->{_current} = $current;
+    $self->_top->{_current} = $current;
 }
 
 sub current_path {
     my ($self) = @_;
     my @st = stat($self->current_path());
     !-d _ and return 0;
-    -l $self->current_path() && !$self->{_top}->{followlink} and return 0;
-    $st[0] != $self->{dev} && $self->{_top}->{nocrossfs} and return 0;
+    -l $self->current_path() && !$self->_top->{followlink} and return 0;
+    $st[0] != $self->{dev} && $self->_top->{nocrossfs} and return 0;
     my $ptr = $self; my $rc;
     while($ptr->{_father}) {
         if($ptr->{inode} == $st[1] && $ptr->{dev} == $st[0]) {
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 2;
+
+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;
+
+package MyFFO;
+
+use vars qw(@ISA);
+
+@ISA=(qw(File::Find::Object));
+
+sub DESTROY
+{
+    my $self = shift;
+    $self->{'**DESTROY**'}->();
+}
+
+package main;
+
+my $destroy_counter = 0;
+sub my_destroy
+{
+    $destroy_counter++;
+}
+
+{
+    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 = 
+        MyFFO->new(
+            {},
+            $t->get_path("./t/sample-data/traverse-1")
+        );
+    $ff->{'**DESTROY**'} = \&my_destroy;
+    my @results;
+    for my $i (1 .. 6)
+    {
+        push @results, $ff->next();
+    }
+    # TEST
+    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",
+    );
+
+    rmtree($t->get_path("./t/sample-data/traverse-1"))
+}
+# TEST
+is ($destroy_counter, 1,
+    "Check that the object was destroyed when it goes out of scope."
+);
+
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.