Anonymous avatar Anonymous committed 1f7b28f

- create

Comments (0)

Files changed (5)

+# $Id: Makefile.PL,v 1.1 2005/06/18 18:21:35 nanardon Exp $
+
+use ExtUtils::MakeMaker;
+
+sub MY::postamble {
+    <<MAKECHANGELOG;
+.PHONY: ChangeLog
+
+ChangeLog:
+	cvs2cl -W 400 -I ChangeLog --accum -U ../common/username
+	rm -f *.bak
+
+MAKECHANGELOG
+}
+
+WriteMakefile(
+    NAME	 => 'File::Find::Object',
+    VERSION_FROM => 'File/Find/Object.pm',
+);
+# $Id: Object.pm,v 1.1 2005/06/18 18:21:35 nanardon Exp $
+
+#- Olivier Thauvin <olivier.thauvin@aerov.jussieu.fr>
+
+#- This program is free software; you can redistribute it and/or modify
+#- it under the terms of the GNU General Public License as published by
+#- the Free Software Foundation; either version 2, or (at your option)
+#- any later version.
+#-
+#- This program is distributed in the hope that it will be useful,
+#- but WITHOUT ANY WARRANTY; without even the implied warranty of
+#- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#- GNU General Public License for more details.
+#-
+#- You should have received a copy of the GNU General Public License
+#- along with this program; if not, write to the Free Software
+#- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+package File::Find::Object;
+
+use strict;
+use warnings;
+use File::Find::Object::internal;
+
+our $VERSION = '0.0.1';
+
+sub new {
+    my ($class, $options, @files) = @_;
+    my $tree = {
+        _father => undef,
+        _current => undef,
+        files => [ @files ],
+        ind => -1,
+        
+        depth => $options->{depth},
+        nocrossfs => $options->{nocrossfs},
+        followlink => $options->{followlink},
+        nonet => $options->{nonet},
+        filter => $options->{filter},
+        callback => $options->{callback},
+    };
+    $tree->{_top} = $tree;
+    bless($tree, $class);
+}
+
+sub DESTROY {
+    my ($self) = @_;
+#    print STDERR join(" ", caller)."\n";
+#    printf STDERR "destroy `%s'\n", $self->{dir} || "--";
+}
+
+sub next {
+    my ($self) = @_;
+    while (1) {
+        my $current = $self->{_current} || $self;
+        $current->_process_current and return $current->current_path;
+        $current = $self->{_current} || $self;
+        if(!$current->movenext) {
+            $current->me_die and return undef;
+        }
+    }
+}
+
+sub movenext {
+    my ($self) = @_;
+    $self->{ind} > @{$self->{files}} and return;
+    $self->{ind}++;
+    $self->{currentfile} = ${$self->{files}}[$self->{ind}];
+    $self->{_action} = {};
+    1;
+}
+
+sub me_die {
+    my ($self) = @_;
+    1;
+}
+
+sub become_default {
+    my ($self) = @_;
+    $self->{_current} = undef;
+}
+
+sub set_current {
+    my ($self, $current) = @_;
+    $self->{_current} = $current;
+}
+
+# Return true if there is somthing next
+sub _process_current {
+    my ($self) = @_;
+   
+    $self->{currentfile} or return 0;
+
+    $self->isdot and return 0;
+    $self->filter or return 0;  
+
+    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());
+            }
+            return 1;
+        }
+            
+        if ($_ eq 'b') {
+            $self->check_subdir or next;
+            my $newtree = File::Find::Object::internal->new($self) or next;
+            $self->set_current($newtree);
+            return 0;
+        }
+    }
+    0
+}
+
+sub isdot {
+    0;
+}
+
+sub filter {
+    my ($self) = @_;
+    return defined($self->{_top}->{filter}) ?
+        $self->{_top}->{filter}->($self->current_path()) :
+        1;
+}
+
+sub check_subdir {
+    1;
+}
+
+sub current_path {
+    my ($self) = @_;
+    $self->{currentfile};
+}
+
+1

Object/internal.pm

+# $Id: internal.pm,v 1.1 2005/06/18 18:22:49 nanardon Exp $
+
+#- Olivier Thauvin <olivier.thauvin@aerov.jussieu.fr>
+
+#- This program is free software; you can redistribute it and/or modify
+#- it under the terms of the GNU General Public License as published by
+#- the Free Software Foundation; either version 2, or (at your option)
+#- any later version.
+#-
+#- This program is distributed in the hope that it will be useful,
+#- but WITHOUT ANY WARRANTY; without even the implied warranty of
+#- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#- GNU General Public License for more details.
+#-
+#- You should have received a copy of the GNU General Public License
+#- along with this program; if not, write to the Free Software
+#- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+package File::Find::Object::internal;
+
+use strict;
+use warnings;
+use File::Find::Object;
+
+use vars qw(@ISA);
+@ISA = qw(File::Find::Object);
+
+sub new {
+    my ($class, $from) = @_;
+    my $self = $class->SUPER::new();
+    $self->{_father} = $from;
+    $self->{_top} = $from->{_top} || $from;
+    $self->{dir} = $from->current_path;
+
+    bless($self, $class);
+
+    return $self->open_dir ? $self : undef;
+}
+
+#sub DESTROY {
+#    my ($self) = @_;
+#}
+
+sub open_dir {
+    my ($self) = @_;
+    opendir($self->{_handle}, $self->{dir}) or return undef;
+    my @st = stat($self->{dir});
+    $self->{inode} = $st[1];
+    $self->{dev} = $st[0];
+    1
+}
+
+sub me_die {
+    my ($self) = @_;
+    $self->{_father}->become_default;
+    0
+}
+
+sub become_default {
+    my ($self) = @_;
+    $self->{_top}->{_current} = $self;
+    0
+}
+
+sub set_current {
+    my ($self, $current) = @_;
+    $self->{_top}->{_current} = $current;
+}
+
+sub current_path {
+    my ($self) = @_;
+    my $p = $self->{dir};
+    $p =~ s!/+$!!; #!
+    $p .= '/' . $self->{currentfile};
+}
+
+sub check_subdir {
+    my ($self) = @_;
+    my @st = stat($self->current_path());
+    !-d _ and return 0;
+    -l $self->current_path() && !$self->{_top}->{followlink} and return 0;
+    $st[0] < 0 && $self->{_top}->{nonet} 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]) {
+            $rc = 1;
+            last;
+        }
+        $ptr = $ptr->{_father};
+    }
+    if ($rc) {
+        printf(STDERR "Avoid loop $ptr->{_dir} => %s\n",
+            $self->current_path());
+        return 0;
+    }
+    1
+}
+
+sub movenext {
+    my ($self) = @_;
+    my $h = $self->{_handle};
+    if ($self->{currentfile} = readdir($h)) {
+        $self->{_action} = {};
+        return 1;
+    } else {
+        return 0;
+    }
+}
+
+sub isdot {
+    my ($self) = @_;
+    if ($self->{currentfile} eq '..' || $self->{currentfile} eq '.') {
+        return 1;
+    }
+    return 0;
+}
+
+1
+#!/usr/bin/perl
+
+# $Id: 01ffo.t,v 1.1 2005/06/18 18:21:35 nanardon Exp $
+
+use strict;
+use warnings;
+use Test::More tests => 3;
+
+use_ok('File::Find::Object', "Can use main NBackup::Tree");
+
+mkdir('t/dir');
+mkdir('t/dir/a');
+mkdir('t/dir/b');
+
+open(my $h, ">", 't/dir/file');
+close($h);
+
+symlink('.', 't/dir/link');
+
+
+my (@res1, @res2);
+my $tree = File::Find::Object->new(
+    {
+        callback => sub {
+            push(@res1, $_[0]);
+        }
+    },
+    't/dir'
+);
+
+ok($tree, "Can get tree object");
+
+while (my $r = $tree->next()) {
+    push(@res2, $r);
+}
+
+ok(scalar(@res1) == scalar(@res2), "Get same result from callback and next");
+#!/usr/bin/perl
+
+# $Id: tree,v 1.1 2005/06/18 18:21:35 nanardon Exp $
+
+use strict;
+use warnings;
+use File::Find::Object;
+
+my $tree = File::Find::Object->new({}, @ARGV);
+
+while (my $r = $tree->next()) {
+    print $r ."\n";
+}
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.