r38253 - in /trunk/libfile-find-object-perl: Changes META.yml debian/changelog lib/File/Find/Object.pm lib/File/Find/Object/PathComp.pm lib/File/Find/Object/Result.pm t/03traverse.t
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Fri Jun 19 01:02:35 UTC 2009
Author: jawnsy-guest
Date: Fri Jun 19 01:02:30 2009
New Revision: 38253
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=38253
Log:
New upstream release
-> Some small feature additions, like is_file and is_link
Modified:
trunk/libfile-find-object-perl/Changes
trunk/libfile-find-object-perl/META.yml
trunk/libfile-find-object-perl/debian/changelog
trunk/libfile-find-object-perl/lib/File/Find/Object.pm
trunk/libfile-find-object-perl/lib/File/Find/Object/PathComp.pm
trunk/libfile-find-object-perl/lib/File/Find/Object/Result.pm
trunk/libfile-find-object-perl/t/03traverse.t
Modified: trunk/libfile-find-object-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libfile-find-object-perl/Changes?rev=38253&op=diff
==============================================================================
--- trunk/libfile-find-object-perl/Changes (original)
+++ trunk/libfile-find-object-perl/Changes Fri Jun 19 01:02:30 2009
@@ -1,3 +1,13 @@
+0.2.1 - Thu Jun 18 18:01:24 IDT 2009
+ - Optimization: removed the _dir field of File::Find::Object::PathComp
+ and its _dir_copy copy-accessor, and replaced them all with passing
+ the $dir_str explicitly. This reduced the code considerably, and
+ eliminated a similar symptom to this one:
+ - http://en.wikipedia.org/wiki/Schlemiel_the_painter%27s_Algorithm
+ - Added the ->is_file() method to ::Result.
+ - Converted ::Result->is_dir() to use -d _
+ - Added ::Result->is_link().
+
0.2.0 - Sun Feb 22 11:52:06 IST 2009
- Optimization: now not checking for the existence of the callback() after
every iteration, in case it doesn't exist. Instead, the default_actions
Modified: trunk/libfile-find-object-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libfile-find-object-perl/META.yml?rev=38253&op=diff
==============================================================================
--- trunk/libfile-find-object-perl/META.yml (original)
+++ trunk/libfile-find-object-perl/META.yml Fri Jun 19 01:02:30 2009
@@ -1,6 +1,6 @@
---
name: File-Find-Object
-version: 0.2.0
+version: 0.2.1
author: []
abstract: An object oriented File::Find replacement
license: perl
@@ -21,7 +21,7 @@
provides:
File::Find::Object:
file: lib/File/Find/Object.pm
- version: 0.2.0
+ version: 0.2.1
File::Find::Object::Base:
file: lib/File/Find/Object/Base.pm
File::Find::Object::DeepPath:
@@ -32,7 +32,7 @@
file: lib/File/Find/Object/Result.pm
File::Find::Object::TopPath:
file: lib/File/Find/Object.pm
-generated_by: Module::Build version 0.31
+generated_by: Module::Build version 0.33
meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.2.html
- version: 1.2
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
Modified: trunk/libfile-find-object-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libfile-find-object-perl/debian/changelog?rev=38253&op=diff
==============================================================================
--- trunk/libfile-find-object-perl/debian/changelog (original)
+++ trunk/libfile-find-object-perl/debian/changelog Fri Jun 19 01:02:30 2009
@@ -1,8 +1,12 @@
-libfile-find-object-perl (0.2.0-2) UNRELEASED; urgency=low
+libfile-find-object-perl (0.2.1-1) UNRELEASED; urgency=low
+ * New upstream release
+ -> Some small feature additions, like is_file and is_link
+
+ [ Nathan Handler ]
* debian/watch: Update to ignore development releases.
- -- Nathan Handler <nhandler at ubuntu.com> Sat, 06 Jun 2009 01:34:06 +0000
+ -- Jonathan Yu <frequency at cpan.org> Thu, 18 Jun 2009 16:52:33 -0400
libfile-find-object-perl (0.2.0-1) unstable; urgency=low
Modified: trunk/libfile-find-object-perl/lib/File/Find/Object.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libfile-find-object-perl/lib/File/Find/Object.pm?rev=38253&op=diff
==============================================================================
--- trunk/libfile-find-object-perl/lib/File/Find/Object.pm (original)
+++ trunk/libfile-find-object-perl/lib/File/Find/Object.pm Fri Jun 19 01:02:30 2009
@@ -15,7 +15,6 @@
my $self = {};
bless $self, $class;
- $self->_dir([ @{$top->_curr_comps()} ]);
$self->_stat_ret($top->_top_stat_copy());
my $find = { %{$from->_inodes()} };
@@ -26,8 +25,6 @@
$self->_set_inodes($find);
$self->_last_dir_scanned(undef);
-
- $from->_dir($self->_dir_copy());
$top->_fill_actions($self);
@@ -175,7 +172,7 @@
use Carp;
-our $VERSION = '0.2.0';
+our $VERSION = '0.2.1';
sub new {
my ($class, $options, @targets) = @_;
@@ -237,6 +234,9 @@
dir_components => \@comps,
base => shift(@comps),
stat_ret => scalar($self->_top_stat_copy()),
+ is_file => scalar(-f _),
+ is_dir => scalar(-d _),
+ is_link => $self->_top_is_link(),
};
if ($self->_curr_not_a_dir())
@@ -497,7 +497,7 @@
sub _warn_about_loop
{
my $self = shift;
- my $ptr = shift;
+ my $component_idx = shift;
# Don't pass strings directly to the format.
# Instead - use %s
@@ -505,8 +505,10 @@
warn(
sprintf(
"Avoid loop %s => %s\n",
- $ptr->_dir_as_string(),
- $self->_curr_path()
+ File::Spec->catdir(
+ @{$self->_curr_comps()}[0 .. $component_idx]
+ ),
+ $self->_curr_path(),
)
);
@@ -520,7 +522,7 @@
my $lookup = $self->_current->_inodes;
if (exists($lookup->{$key})) {
- $self->_warn_about_loop($self->_dir_stack->[$lookup->{$key}]);
+ $self->_warn_about_loop($lookup->{$key});
return 1;
}
else {
@@ -565,7 +567,9 @@
sub _open_dir {
my $self = shift;
- return $self->_current()->_component_open_dir();
+ return $self->_current()->_component_open_dir(
+ $self->_curr_path()
+ );
}
sub set_traverse_to
@@ -588,8 +592,6 @@
sub get_current_node_files_list
{
my $self = shift;
-
- $self->_current->_dir($self->_curr_comps());
# _open_dir can return undef if $self->_current is not a directory.
if ($self->_open_dir())
Modified: trunk/libfile-find-object-perl/lib/File/Find/Object/PathComp.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libfile-find-object-perl/lib/File/Find/Object/PathComp.pm?rev=38253&op=diff
==============================================================================
--- trunk/libfile-find-object-perl/lib/File/Find/Object/PathComp.pm (original)
+++ trunk/libfile-find-object-perl/lib/File/Find/Object/PathComp.pm Fri Jun 19 01:02:30 2009
@@ -14,7 +14,6 @@
(qw(
_actions
_curr_file
- _dir
_files
_last_dir_scanned
_open_dir_ret
@@ -30,7 +29,6 @@
use File::Spec;
__PACKAGE__->_make_copy_methods([qw(
- _dir
_files
_traverse_to
)]
@@ -44,13 +42,6 @@
sub _inode
{
return shift->_stat_ret->[1];
-}
-
-sub _dir_as_string
-{
- my $self = shift;
-
- return File::Spec->catdir(@{$self->_dir()});
}
sub _is_same_inode
@@ -73,9 +64,10 @@
sub _should_scan_dir
{
my $self = shift;
+ my $dir_str = shift;
if (defined($self->_last_dir_scanned()) &&
- ($self->_last_dir_scanned() eq $self->_dir_as_string()
+ ($self->_last_dir_scanned() eq $dir_str
)
)
{
@@ -83,7 +75,7 @@
}
else
{
- $self->_last_dir_scanned($self->_dir_as_string());
+ $self->_last_dir_scanned($dir_str);
return 1;
}
}
@@ -91,8 +83,9 @@
sub _set_up_dir
{
my $self = shift;
+ my $dir_str = shift;
- $self->_files($self->_calc_dir_files());
+ $self->_files($self->_calc_dir_files($dir_str));
$self->_traverse_to($self->_files_copy());
@@ -102,10 +95,11 @@
sub _calc_dir_files
{
my $self = shift;
+ my $dir_str = shift;
my $handle;
my @files;
- if (!opendir($handle, $self->_dir_as_string()))
+ if (!opendir($handle, $dir_str))
{
# Handle this error gracefully.
}
@@ -121,13 +115,14 @@
sub _component_open_dir
{
my $self = shift;
+ my $dir_str = shift;
- if (!$self->_should_scan_dir())
+ if (!$self->_should_scan_dir($dir_str))
{
return $self->_open_dir_ret();
}
- return $self->_set_up_dir();
+ return $self->_set_up_dir($dir_str);
}
sub _next_traverse_to
Modified: trunk/libfile-find-object-perl/lib/File/Find/Object/Result.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libfile-find-object-perl/lib/File/Find/Object/Result.pm?rev=38253&op=diff
==============================================================================
--- trunk/libfile-find-object-perl/lib/File/Find/Object/Result.pm (original)
+++ trunk/libfile-find-object-perl/lib/File/Find/Object/Result.pm Fri Jun 19 01:02:30 2009
@@ -10,6 +10,9 @@
(map { $_ => $_ } (qw(
base
basename
+ is_dir
+ is_file
+ is_link
path
dir_components
stat_ret
@@ -27,11 +30,6 @@
bless $self, $class;
return $self;
-}
-
-sub is_dir
-{
- return S_ISDIR(shift->stat_ret->[2]);
}
sub full_components
@@ -75,6 +73,15 @@
Returns true if the result refers to a directory.
+=head2 $result->is_file()
+
+Returns true if the result refers to a plain file (equivalent to the Perl
+C<-f> operator).
+
+=head2 $result->is_link()
+
+Returns true if the result is a symbolic link.
+
=head2 $result->dir_components()
The components of the directory part of the path starting from base()
Modified: trunk/libfile-find-object-perl/t/03traverse.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libfile-find-object-perl/t/03traverse.t?rev=38253&op=diff
==============================================================================
--- trunk/libfile-find-object-perl/t/03traverse.t (original)
+++ trunk/libfile-find-object-perl/t/03traverse.t Fri Jun 19 01:02:30 2009
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use Test::More tests => 43;
+use Test::More tests => 46;
BEGIN
{
@@ -363,6 +363,9 @@
ok ($r->is_dir(), "Is a directory");
# TEST
+ ok (!$r->is_link(), "Not a link");
+
+ # TEST
is_deeply ($r->full_components(), [], "Full components are empty");
}
@@ -399,6 +402,9 @@
# TEST
ok (!$r->is_dir(), "Not a directory");
+
+ # TEST
+ ok (!$r->is_link(), "Not a link");
# TEST
is_deeply ($r->full_components(), [qw(b.doc)],
@@ -681,3 +687,63 @@
rmtree($t->get_path("./t/sample-data/traverse-1"));
}
+
+{
+ my $tree =
+ {
+ 'name' => "traverse-1/",
+ 'subs' =>
+ [
+ {
+ 'name' => "b.doc",
+ 'contents' => "This file was spotted in the wild.",
+ },
+ {
+ 'name' => "a/",
+ },
+ {
+ 'name' => "foo/",
+ 'subs' =>
+ [
+ {
+ 'name' => "file.txt",
+ 'contents' => "A file that should come before yet/",
+ },
+ {
+ '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 @results;
+
+ while (my $r = $ff->next_obj())
+ {
+ if ($r->is_file())
+ {
+ push @results, $r->path();
+ }
+ }
+
+ # TEST
+ is_deeply(
+ \@results,
+ [
+ map { $t->get_path("t/sample-data/traverse-1/$_") }
+ (qw(b.doc foo/file.txt))
+ ],
+ "Checking for regular, lexicographically sorted order",
+ );
+
+ rmtree($t->get_path("./t/sample-data/traverse-1"))
+}
More information about the Pkg-perl-cvs-commits
mailing list