From 0e0e0d2059472f6815465ab92e7780eda36ed07e Mon Sep 17 00:00:00 2001 From: Packit Date: Sep 16 2020 12:12:42 +0000 Subject: perl-File-Find-Object-0.3.2 base --- diff --git a/Build.PL b/Build.PL new file mode 100644 index 0000000..0f9e179 --- /dev/null +++ b/Build.PL @@ -0,0 +1,74 @@ + +# This file was automatically generated by Dist::Zilla::Plugin::ModuleBuild v5.047. +use strict; +use warnings; + +use Module::Build 0.28; + + +my %module_build_args = ( + "build_requires" => { + "Module::Build" => "0.28" + }, + "configure_requires" => { + "ExtUtils::MakeMaker" => 0, + "Module::Build" => "0.28" + }, + "dist_abstract" => "An object oriented File::Find replacement", + "dist_author" => [ + "Shlomi Fish " + ], + "dist_name" => "File-Find-Object", + "dist_version" => "v0.3.2", + "license" => "artistic_2", + "module_name" => "File::Find::Object", + "recursive_test_files" => 1, + "requires" => { + "Carp" => 0, + "Class::XSAccessor" => 0, + "Fcntl" => 0, + "File::Spec" => 0, + "List::Util" => 0, + "integer" => 0, + "parent" => 0, + "perl" => "5.008", + "strict" => 0, + "warnings" => 0 + }, + "test_requires" => { + "File::Path" => 0, + "File::Spec" => 0, + "File::Temp" => 0, + "IO::Handle" => 0, + "IPC::Open3" => 0, + "Test::More" => 0, + "blib" => "1.01", + "lib" => 0, + "vars" => 0 + } +); + + +my %fallback_build_requires = ( + "File::Path" => 0, + "File::Spec" => 0, + "File::Temp" => 0, + "IO::Handle" => 0, + "IPC::Open3" => 0, + "Module::Build" => "0.28", + "Test::More" => 0, + "blib" => "1.01", + "lib" => 0, + "vars" => 0 +); + + +unless ( eval { Module::Build->VERSION(0.4004) } ) { + delete $module_build_args{test_requires}; + $module_build_args{build_requires} = \%fallback_build_requires; +} + +my $build = Module::Build->new(%module_build_args); + + +$build->create_build_script; diff --git a/Changes b/Changes new file mode 100644 index 0000000..49882ea --- /dev/null +++ b/Changes @@ -0,0 +1,308 @@ +0.3.2 2017-01-13 + - Made the version number consistent across the .pm files. + - https://bitbucket.org/shlomif/perl-file-find-object/issues/1/wrong-version-number + - Thanks to aer0 for the report. + +0.3.1 2017-01-09 + - Fixed an issue with tracking the depth of the inodes when detecting + a symlink loop. + - Detected by several cygwin reports. + +0.3.0 2016-09-11 + - Converted the build system to Dist-Zilla. + - Part of the impetus was removing the warning about + Test::TrailingSpace needed for the trailing whitespace tests + (which in turn requires this modules) which was reported to us as a + problem by someone (despite not being a real issue). + +0.2.13 2015-04-07 + - Clarified the documentation regarding the use/return of array + references. + +0.2.12 2014-11-28 + - Made sure no two t/*.t test scripts share temp paths. + - This caused failure with HARNESS_OPTIONS="j9". + - Thanks to ETHER for the report: + - http://www.cpantesters.org/cpan/report/2711a2ec-7401-11e4-8c78-d7697441a48b + +0.2.11 2014-03-26 + - Add $VERSION globally to all packages in lib/. + - This was done to silence some warnings from PAUSE. + - Add scripts/bump-version-number.pl to update it. + +0.2.10 2014-03-26 + - Correct a misspelling reported by dsteinbrunner. + - https://rt.cpan.org/Ticket/Display.html?id=94206 + - Fix Build.PL by excluding the 'license' URL from the resources. + - New versions of Module::Build add it automatically. + +0.2.9 2014-01-29 + - Convert from "use base" to the more modern "use parent". + - Minimal version on perl-5.008 (CPANTS Kwalitee). + - Add the LICENSE file - CPANTS Kwalitee. + +0.2.8 2013-08-17 + - Fix https://rt.cpan.org/Ticket/Display.html?id=87901 + - repository metadata duplication. + +0.2.7 2013-05-21 + - Convert this file to t/cpan-changes.t . + +0.2.6 2012-11-25 + - Correct a typo: + - see https://rt.cpan.org/Ticket/Display.html?id=81428 + - Thanks to Xavier Guimard for the report. + - Remove trailing space. + +0.2.5 2012-07-12 + - Add the scripts/tag-release.pl script to tag a release in the + Mercurial repository. + - The problem is that I'm using different conventions for the + names of the tags in different repositories and wish to introduce + some consistency. + +0.2.4 2012-07-12 + - Update the link to the new repository at bitbucket.org. + - Add cleanup for a temporary directory in the tests. + +0.2.3 2009-07-30 + - 0.2.2 seems to have been deleted. Re-uploading. + - thanks to lwpetre + +0.2.2 2009-06-25 + - added some META.yml resources. + - added META.yml keywords. + +0.2.1 2009-06-18 + - 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 2009-02-22 + - Optimization: now not checking for the existence of the callback() after + every iteration, in case it doesn't exist. Instead, the default_actions + is calculated according to its existence when the tree traverser + is initialized. + - Refactoring/Optimization: avoided having two _set_obj() methds by + calling _set_obj() from _run_cb(). + +0.1.9 2009-02-10 + - Added use integer to the modules, because they don't make use + of floating-point calculation. It may be a minor optimization, but then + again it may be not. + - Optimization: optimized the loop detection by having a hash lookup + of inodes in each path component, that are built incrementally and checked + for every subsequent node. + - Optimization: replaced the _top_it() of _me_die() with a normal method + with a conditional, as it was the only place where _top_it() was still + used. + - Optimization/Cleanup: _set_inodes() in ::DeepPath. + - Clarified the licensing blurbs of the .pm files. + +0.1.8 2009-01-19 + - Optimization/Refactoring: replaced the last call to ->_father with a + call to _current_father(). Removed ->_father and optimized + _current_father() . + - Optimization/Refactoring: refactored _become_default() to remove + the execessive use of $father and $father->idx(). Now ->idx() is + no longer needed and will be removed next. + - Optimization/Refactoring: removed the ->idx() method as it + was no longer used and needed. + - Optimization: instead of calling File::Find::Object::Result->new() + just bless to it. + - Optimization: now caching the filesystem device at + the top for nocrossfs(). + - Plus: rearranged the order of the checks in + _non_top__check_subdir_helper + - Optimization/Refactoring: made the _top_it method names saner, + and removed an unused one. + - Refactoring: refactored _check_subdir_helper_d() to make + the conditions clearer. + - Optimization: now compiling the _check_subdir_helper function + by eval ""'ing it because it contains many conditions that depend + on instance-wide and constant parameters. + - Cleanup: moved some POD'ed out functions to under rejects/ . + - Optimization: renamed _calc_next_obj() to next_obj(), as next_obj() + just called it directly. Cleaned up the rest of the logic in next_obj(). + - Bug fix: the nocrossfs option was fixed. Previously it used an undefined + method. + +0.1.7 2009-01-15 + - Fixed the check-for-link and for directory semantics on Windows + and other systems. Converted to "perldoc -f lstat" instead of + "perldoc -f stat", and using stat only for symbolic links to check + if they are directories. Now added a test for that. + - Fixed t/01ffo.t to check for the warning. + - Also see: http://www.nntp.perl.org/group/perl.perl5.porters/2009/01/msg143399.html + - Small optimization: converted a loop with: + while($ptr) { ... } continue { $ptr = $self->_father($ptr); } + to List::Util::first. + - Added more dependencies to Build.PL / Makefile.PL including + List::Util. + +0.1.6 2009-01-09 + - Converted the accessor generator to Class::XSAccessor instead + of Class::Accessor. After consulting Devel::NYTProf, it seemed that + the majority of the time of a simple File-Find-Object scan was spent + in Class::Accessor. Hopefully, this will make F-F-O run faster. + - A small optimization - added a flag to $self with whether the stack + is full or not. This is used inside _top_it() and _is_top(). + - A small optimization - implemented _current directly instead of + a _top / _non_top version - saved 2.5 seconds of runtime. + - A small optimization - got rid of _current_components_copy() (which + was useless because _current_components already returns a dynamic + reference) and replaced all calls with calls to _current_components(). + - A small optimization - ->dir() instead of ->_dir_copy() for + a function whose return value is dereferenced and flatted. + - A small optimization - now caching the results of _current_components + inside an accessor and updating it upon every change. + - A small optimization - now caching the results of _current_path() + upon every modification of _current_components, so File::Spec->catfile() + won't be called excessively. + - Optimization/Refactoring - changed the actions() handling so instead + of having the indices, we calculate an array of master actions at + start that correspond with the depth() parameter, and then assign it for + each PathComponent object in turn based on $top. This is instead of + the indexes and explicit calculations etc., which was both messier + and slower. + - Optimization/Refactoring - renamed _current_components() to + _curr_comps() and _current_path to _curr_path() to make them + shorter and faster. Added a comment explaining what they are. + - Optimization/Refactoring - optimized _calc_current_item_obj. + - Optimization - removed an _is_top() conditional in _recurse() that + was likely not to be evaluated, by re-arranging the order of _mystat + call. Now _mystat is not an action, but rather called explicitly. + _is_top() is now PODded-out because it's not used. + - Refactoring - made the top path component-handling object a separate + object (::PathTop) instead of $top/$tree . Hopefully, this will later + allow caching _current(), and having a unified directory stack. + - Refactoring - created a base class for Path-Components (i.e: ::PathTop + and ::PathComponent). Most of the methods out of ::Base belong there + so they were moved. This class inherits from ::Base, but there's not + a lot there anymore. + - Refactoring - renamed ::PathComponent as ::DeepPath and ::PathTop + as ::TopPath. Otherwise they could be confused with ::PathComp. + - Refactoring - made the first ::PathTop component the first element + in _dir_stack() so we won't need to keep in a distinct reference. All + the other elements moved 1 level down the stack. + - Optimization - now caching $top->_dir_stack()->[-1] into + $top->_current() as an accessor. + +0.1.5 2009-01-03 + - Unified the two calls to stat() (and several calls to other file + operators) in order to reduce the number of system calls/disk accesses + issued by File::Find::Object. + - Refactored the code from the last change and added + File::Find::Object::Result->stat_ret() for the return value of stat(). + +0.1.4 2008-12-25 + - Bug fix: made sure ->item_obj() is available on the first call + to the callback() and is properly synchronized with it. + +0.1.3 2008-11-12 + - Refactoring: converted _movenext() from pseudo-conditionals + to polymorphism by making it a method of ->_current(). + - Refactoring: extracted the _next_traverse_to() method. + - Bug fix (with possible correctness/SECURITY implications): + - now correctly handling files and directories whose filenames + are false in Perl - most notable "0". + +0.1.2 2008-10-26 + - Corrected the README. + - Now checking for inodes that are 0, when checking for cyclical trees, + as a fix for stat() calls on systems that do not support them. This should + fix Win32 test failures (and bad behaviour in general) like the following: - http://nntp.x.perl.org/group/perl.cpan.testers/2479582 + +0.1.1 2008-10-22 + - Potential Security Fix!!! No longer passing a filename directly to + the format in <> when warning on a loop. + - Bug fix - the check for a loop was broken. + - New Feature - Added the ->next_obj() and ->item_obj() methods + to return a File::Find::Object::Result object instead of a plain + path. + - Refactoring: + - No longer passing $current explicitly from one method to another + (hello EEK!). Instead, we reference $self->_current() + - Remmed out the DESTROY method as it was empty. + - Revamped the _action handling - an array instead of a hash. + - Created _top and _non_top methods delegated by _is_top using + _top_it() + - _current_idx() was eliminated - now it's just $#dir_stack. + - Created a _copy methods to create flat copies of array references. + - Extracted many methods. + - Switched Build.PL to inc/Test/Run/Builder.pm - that gives us: + - ./Build runtest + - ./Build distruntest + - ./Build tags + +0.1.0 2008-03-05 + - Now handling directories that cannot be opendir()'ed in a graceful + manner - just not traversing them further. + +0.0.9 2008-02-22 + - Now running canonpath() on the targets in the call to + File::Find::Object->new. That way, trailing slashes are omitted in + the results. + - Allow File::Find::Object to properly accept paths to regular + files as input paths. Fixes: + http://rt.cpan.org/Public/Bug/Display.html?id=33453 + Thanks to Sergey V Panteleev for reporting the bug. + - TODO : check behavior on traversing non-existant paths. + - Done. + - Now skipping non-existant files. + - Added a test for it in t/03traverse.t + +0.0.8 2007-07-31 + - added the empty PL_FILES key to the Makefile.PL to avoid running + Build.PL on older versions of EU::MM. + +0.0.7 2007-02-02 + - moved the tree script under the examples directory. + - added the LICENSE section to the POD. + - added t/pod.t and t/pod-coverage.t and made sure the module + has full POD coverage. + - added a Build.PL build script to generate a better META.yml file. + - all of these are Kwalitee improvements. + ( http://cpants.perl.org/dist/File-Find-Object ) + - Added some links to the main POD documentation for similar modules + and for the Perl Advent article. + +0.0.6 2006-11-28 + - Added the following new interface methods: + - set_traverse_to + - get_traverse_to + - get_current_node_files_list + - prune + - Some changes to the internals to accomodate for them. + +0.0.5 2006-09-03 + - Eliminated the F-F-O-internal isa F-F-O relationship. + - Created accessors for everything - now based on Class::Accessor + - F-F-O-internal is now named File::Find::Object::PathComponent + - Some smaller refactorings. + +0.0.4 2006-08-23 + - Eliminated circular references. (Hopefully) + - Still have an isa relationship between File::Find::Object and + File::Find::Object::internal, which is what handles each recursed to + directory. + - Created some accessor functions instead of direct hash accesses. + +0.0.3 2006-07-14 + - Fixed some language problems in the POD. + - Added the Changes file. + - Changed the license to GPL/Artistic/Artistic-2.0 + - Placed the .pm files inside lib. + - Added the TreeCreate module under t/lib (with appropriate tests) to test + the main module. + - Made the default test order lexicographical, and predictable. In the + process, eliminated keeping the directory handles, and possibly the fact + that they are kept open. + - Fixed a bug where circular references prevented the module from being + destroyed. + diff --git a/Changes~ b/Changes~ new file mode 100644 index 0000000..49882ea --- /dev/null +++ b/Changes~ @@ -0,0 +1,308 @@ +0.3.2 2017-01-13 + - Made the version number consistent across the .pm files. + - https://bitbucket.org/shlomif/perl-file-find-object/issues/1/wrong-version-number + - Thanks to aer0 for the report. + +0.3.1 2017-01-09 + - Fixed an issue with tracking the depth of the inodes when detecting + a symlink loop. + - Detected by several cygwin reports. + +0.3.0 2016-09-11 + - Converted the build system to Dist-Zilla. + - Part of the impetus was removing the warning about + Test::TrailingSpace needed for the trailing whitespace tests + (which in turn requires this modules) which was reported to us as a + problem by someone (despite not being a real issue). + +0.2.13 2015-04-07 + - Clarified the documentation regarding the use/return of array + references. + +0.2.12 2014-11-28 + - Made sure no two t/*.t test scripts share temp paths. + - This caused failure with HARNESS_OPTIONS="j9". + - Thanks to ETHER for the report: + - http://www.cpantesters.org/cpan/report/2711a2ec-7401-11e4-8c78-d7697441a48b + +0.2.11 2014-03-26 + - Add $VERSION globally to all packages in lib/. + - This was done to silence some warnings from PAUSE. + - Add scripts/bump-version-number.pl to update it. + +0.2.10 2014-03-26 + - Correct a misspelling reported by dsteinbrunner. + - https://rt.cpan.org/Ticket/Display.html?id=94206 + - Fix Build.PL by excluding the 'license' URL from the resources. + - New versions of Module::Build add it automatically. + +0.2.9 2014-01-29 + - Convert from "use base" to the more modern "use parent". + - Minimal version on perl-5.008 (CPANTS Kwalitee). + - Add the LICENSE file - CPANTS Kwalitee. + +0.2.8 2013-08-17 + - Fix https://rt.cpan.org/Ticket/Display.html?id=87901 + - repository metadata duplication. + +0.2.7 2013-05-21 + - Convert this file to t/cpan-changes.t . + +0.2.6 2012-11-25 + - Correct a typo: + - see https://rt.cpan.org/Ticket/Display.html?id=81428 + - Thanks to Xavier Guimard for the report. + - Remove trailing space. + +0.2.5 2012-07-12 + - Add the scripts/tag-release.pl script to tag a release in the + Mercurial repository. + - The problem is that I'm using different conventions for the + names of the tags in different repositories and wish to introduce + some consistency. + +0.2.4 2012-07-12 + - Update the link to the new repository at bitbucket.org. + - Add cleanup for a temporary directory in the tests. + +0.2.3 2009-07-30 + - 0.2.2 seems to have been deleted. Re-uploading. + - thanks to lwpetre + +0.2.2 2009-06-25 + - added some META.yml resources. + - added META.yml keywords. + +0.2.1 2009-06-18 + - 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 2009-02-22 + - Optimization: now not checking for the existence of the callback() after + every iteration, in case it doesn't exist. Instead, the default_actions + is calculated according to its existence when the tree traverser + is initialized. + - Refactoring/Optimization: avoided having two _set_obj() methds by + calling _set_obj() from _run_cb(). + +0.1.9 2009-02-10 + - Added use integer to the modules, because they don't make use + of floating-point calculation. It may be a minor optimization, but then + again it may be not. + - Optimization: optimized the loop detection by having a hash lookup + of inodes in each path component, that are built incrementally and checked + for every subsequent node. + - Optimization: replaced the _top_it() of _me_die() with a normal method + with a conditional, as it was the only place where _top_it() was still + used. + - Optimization/Cleanup: _set_inodes() in ::DeepPath. + - Clarified the licensing blurbs of the .pm files. + +0.1.8 2009-01-19 + - Optimization/Refactoring: replaced the last call to ->_father with a + call to _current_father(). Removed ->_father and optimized + _current_father() . + - Optimization/Refactoring: refactored _become_default() to remove + the execessive use of $father and $father->idx(). Now ->idx() is + no longer needed and will be removed next. + - Optimization/Refactoring: removed the ->idx() method as it + was no longer used and needed. + - Optimization: instead of calling File::Find::Object::Result->new() + just bless to it. + - Optimization: now caching the filesystem device at + the top for nocrossfs(). + - Plus: rearranged the order of the checks in + _non_top__check_subdir_helper + - Optimization/Refactoring: made the _top_it method names saner, + and removed an unused one. + - Refactoring: refactored _check_subdir_helper_d() to make + the conditions clearer. + - Optimization: now compiling the _check_subdir_helper function + by eval ""'ing it because it contains many conditions that depend + on instance-wide and constant parameters. + - Cleanup: moved some POD'ed out functions to under rejects/ . + - Optimization: renamed _calc_next_obj() to next_obj(), as next_obj() + just called it directly. Cleaned up the rest of the logic in next_obj(). + - Bug fix: the nocrossfs option was fixed. Previously it used an undefined + method. + +0.1.7 2009-01-15 + - Fixed the check-for-link and for directory semantics on Windows + and other systems. Converted to "perldoc -f lstat" instead of + "perldoc -f stat", and using stat only for symbolic links to check + if they are directories. Now added a test for that. + - Fixed t/01ffo.t to check for the warning. + - Also see: http://www.nntp.perl.org/group/perl.perl5.porters/2009/01/msg143399.html + - Small optimization: converted a loop with: + while($ptr) { ... } continue { $ptr = $self->_father($ptr); } + to List::Util::first. + - Added more dependencies to Build.PL / Makefile.PL including + List::Util. + +0.1.6 2009-01-09 + - Converted the accessor generator to Class::XSAccessor instead + of Class::Accessor. After consulting Devel::NYTProf, it seemed that + the majority of the time of a simple File-Find-Object scan was spent + in Class::Accessor. Hopefully, this will make F-F-O run faster. + - A small optimization - added a flag to $self with whether the stack + is full or not. This is used inside _top_it() and _is_top(). + - A small optimization - implemented _current directly instead of + a _top / _non_top version - saved 2.5 seconds of runtime. + - A small optimization - got rid of _current_components_copy() (which + was useless because _current_components already returns a dynamic + reference) and replaced all calls with calls to _current_components(). + - A small optimization - ->dir() instead of ->_dir_copy() for + a function whose return value is dereferenced and flatted. + - A small optimization - now caching the results of _current_components + inside an accessor and updating it upon every change. + - A small optimization - now caching the results of _current_path() + upon every modification of _current_components, so File::Spec->catfile() + won't be called excessively. + - Optimization/Refactoring - changed the actions() handling so instead + of having the indices, we calculate an array of master actions at + start that correspond with the depth() parameter, and then assign it for + each PathComponent object in turn based on $top. This is instead of + the indexes and explicit calculations etc., which was both messier + and slower. + - Optimization/Refactoring - renamed _current_components() to + _curr_comps() and _current_path to _curr_path() to make them + shorter and faster. Added a comment explaining what they are. + - Optimization/Refactoring - optimized _calc_current_item_obj. + - Optimization - removed an _is_top() conditional in _recurse() that + was likely not to be evaluated, by re-arranging the order of _mystat + call. Now _mystat is not an action, but rather called explicitly. + _is_top() is now PODded-out because it's not used. + - Refactoring - made the top path component-handling object a separate + object (::PathTop) instead of $top/$tree . Hopefully, this will later + allow caching _current(), and having a unified directory stack. + - Refactoring - created a base class for Path-Components (i.e: ::PathTop + and ::PathComponent). Most of the methods out of ::Base belong there + so they were moved. This class inherits from ::Base, but there's not + a lot there anymore. + - Refactoring - renamed ::PathComponent as ::DeepPath and ::PathTop + as ::TopPath. Otherwise they could be confused with ::PathComp. + - Refactoring - made the first ::PathTop component the first element + in _dir_stack() so we won't need to keep in a distinct reference. All + the other elements moved 1 level down the stack. + - Optimization - now caching $top->_dir_stack()->[-1] into + $top->_current() as an accessor. + +0.1.5 2009-01-03 + - Unified the two calls to stat() (and several calls to other file + operators) in order to reduce the number of system calls/disk accesses + issued by File::Find::Object. + - Refactored the code from the last change and added + File::Find::Object::Result->stat_ret() for the return value of stat(). + +0.1.4 2008-12-25 + - Bug fix: made sure ->item_obj() is available on the first call + to the callback() and is properly synchronized with it. + +0.1.3 2008-11-12 + - Refactoring: converted _movenext() from pseudo-conditionals + to polymorphism by making it a method of ->_current(). + - Refactoring: extracted the _next_traverse_to() method. + - Bug fix (with possible correctness/SECURITY implications): + - now correctly handling files and directories whose filenames + are false in Perl - most notable "0". + +0.1.2 2008-10-26 + - Corrected the README. + - Now checking for inodes that are 0, when checking for cyclical trees, + as a fix for stat() calls on systems that do not support them. This should + fix Win32 test failures (and bad behaviour in general) like the following: - http://nntp.x.perl.org/group/perl.cpan.testers/2479582 + +0.1.1 2008-10-22 + - Potential Security Fix!!! No longer passing a filename directly to + the format in <> when warning on a loop. + - Bug fix - the check for a loop was broken. + - New Feature - Added the ->next_obj() and ->item_obj() methods + to return a File::Find::Object::Result object instead of a plain + path. + - Refactoring: + - No longer passing $current explicitly from one method to another + (hello EEK!). Instead, we reference $self->_current() + - Remmed out the DESTROY method as it was empty. + - Revamped the _action handling - an array instead of a hash. + - Created _top and _non_top methods delegated by _is_top using + _top_it() + - _current_idx() was eliminated - now it's just $#dir_stack. + - Created a _copy methods to create flat copies of array references. + - Extracted many methods. + - Switched Build.PL to inc/Test/Run/Builder.pm - that gives us: + - ./Build runtest + - ./Build distruntest + - ./Build tags + +0.1.0 2008-03-05 + - Now handling directories that cannot be opendir()'ed in a graceful + manner - just not traversing them further. + +0.0.9 2008-02-22 + - Now running canonpath() on the targets in the call to + File::Find::Object->new. That way, trailing slashes are omitted in + the results. + - Allow File::Find::Object to properly accept paths to regular + files as input paths. Fixes: + http://rt.cpan.org/Public/Bug/Display.html?id=33453 + Thanks to Sergey V Panteleev for reporting the bug. + - TODO : check behavior on traversing non-existant paths. + - Done. + - Now skipping non-existant files. + - Added a test for it in t/03traverse.t + +0.0.8 2007-07-31 + - added the empty PL_FILES key to the Makefile.PL to avoid running + Build.PL on older versions of EU::MM. + +0.0.7 2007-02-02 + - moved the tree script under the examples directory. + - added the LICENSE section to the POD. + - added t/pod.t and t/pod-coverage.t and made sure the module + has full POD coverage. + - added a Build.PL build script to generate a better META.yml file. + - all of these are Kwalitee improvements. + ( http://cpants.perl.org/dist/File-Find-Object ) + - Added some links to the main POD documentation for similar modules + and for the Perl Advent article. + +0.0.6 2006-11-28 + - Added the following new interface methods: + - set_traverse_to + - get_traverse_to + - get_current_node_files_list + - prune + - Some changes to the internals to accomodate for them. + +0.0.5 2006-09-03 + - Eliminated the F-F-O-internal isa F-F-O relationship. + - Created accessors for everything - now based on Class::Accessor + - F-F-O-internal is now named File::Find::Object::PathComponent + - Some smaller refactorings. + +0.0.4 2006-08-23 + - Eliminated circular references. (Hopefully) + - Still have an isa relationship between File::Find::Object and + File::Find::Object::internal, which is what handles each recursed to + directory. + - Created some accessor functions instead of direct hash accesses. + +0.0.3 2006-07-14 + - Fixed some language problems in the POD. + - Added the Changes file. + - Changed the license to GPL/Artistic/Artistic-2.0 + - Placed the .pm files inside lib. + - Added the TreeCreate module under t/lib (with appropriate tests) to test + the main module. + - Made the default test order lexicographical, and predictable. In the + process, eliminated keeping the directory handles, and possibly the fact + that they are kept open. + - Fixed a bug where circular references prevented the module from being + destroyed. + diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..e1fd2d0 --- /dev/null +++ b/LICENSE @@ -0,0 +1,207 @@ +This software is Copyright (c) 2005, 2006 by Olivier Thauvin. + +This is free software, licensed under: + + The Artistic License 2.0 (GPL Compatible) + + The Artistic License 2.0 + + Copyright (c) 2000-2006, The Perl Foundation. + + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + +Preamble + +This license establishes the terms under which a given free software +Package may be copied, modified, distributed, and/or redistributed. +The intent is that the Copyright Holder maintains some artistic +control over the development of that Package while still keeping the +Package available as open source and free software. + +You are always permitted to make arrangements wholly outside of this +license directly with the Copyright Holder of a given Package. If the +terms of this license do not permit the full use that you propose to +make of the Package, you should contact the Copyright Holder and seek +a different licensing arrangement. + +Definitions + + "Copyright Holder" means the individual(s) or organization(s) + named in the copyright notice for the entire Package. + + "Contributor" means any party that has contributed code or other + material to the Package, in accordance with the Copyright Holder's + procedures. + + "You" and "your" means any person who would like to copy, + distribute, or modify the Package. + + "Package" means the collection of files distributed by the + Copyright Holder, and derivatives of that collection and/or of + those files. A given Package may consist of either the Standard + Version, or a Modified Version. + + "Distribute" means providing a copy of the Package or making it + accessible to anyone else, or in the case of a company or + organization, to others outside of your company or organization. + + "Distributor Fee" means any fee that you charge for Distributing + this Package or providing support for this Package to another + party. It does not mean licensing fees. + + "Standard Version" refers to the Package if it has not been + modified, or has been modified only in ways explicitly requested + by the Copyright Holder. + + "Modified Version" means the Package, if it has been changed, and + such changes were not explicitly requested by the Copyright + Holder. + + "Original License" means this Artistic License as Distributed with + the Standard Version of the Package, in its current version or as + it may be modified by The Perl Foundation in the future. + + "Source" form means the source code, documentation source, and + configuration files for the Package. + + "Compiled" form means the compiled bytecode, object code, binary, + or any other form resulting from mechanical transformation or + translation of the Source form. + + +Permission for Use and Modification Without Distribution + +(1) You are permitted to use the Standard Version and create and use +Modified Versions for any purpose without restriction, provided that +you do not Distribute the Modified Version. + + +Permissions for Redistribution of the Standard Version + +(2) You may Distribute verbatim copies of the Source form of the +Standard Version of this Package in any medium without restriction, +either gratis or for a Distributor Fee, provided that you duplicate +all of the original copyright notices and associated disclaimers. At +your discretion, such verbatim copies may or may not include a +Compiled form of the Package. + +(3) You may apply any bug fixes, portability changes, and other +modifications made available from the Copyright Holder. The resulting +Package will still be considered the Standard Version, and as such +will be subject to the Original License. + + +Distribution of Modified Versions of the Package as Source + +(4) You may Distribute your Modified Version as Source (either gratis +or for a Distributor Fee, and with or without a Compiled form of the +Modified Version) provided that you clearly document how it differs +from the Standard Version, including, but not limited to, documenting +any non-standard features, executables, or modules, and provided that +you do at least ONE of the following: + + (a) make the Modified Version available to the Copyright Holder + of the Standard Version, under the Original License, so that the + Copyright Holder may include your modifications in the Standard + Version. + + (b) ensure that installation of your Modified Version does not + prevent the user installing or running the Standard Version. In + addition, the Modified Version must bear a name that is different + from the name of the Standard Version. + + (c) allow anyone who receives a copy of the Modified Version to + make the Source form of the Modified Version available to others + under + + (i) the Original License or + + (ii) a license that permits the licensee to freely copy, + modify and redistribute the Modified Version using the same + licensing terms that apply to the copy that the licensee + received, and requires that the Source form of the Modified + Version, and of any works derived from it, be made freely + available in that license fees are prohibited but Distributor + Fees are allowed. + + +Distribution of Compiled Forms of the Standard Version +or Modified Versions without the Source + +(5) You may Distribute Compiled forms of the Standard Version without +the Source, provided that you include complete instructions on how to +get the Source of the Standard Version. Such instructions must be +valid at the time of your distribution. If these instructions, at any +time while you are carrying out such distribution, become invalid, you +must provide new instructions on demand or cease further distribution. +If you provide valid instructions or cease distribution within thirty +days after you become aware that the instructions are invalid, then +you do not forfeit any of your rights under this license. + +(6) You may Distribute a Modified Version in Compiled form without +the Source, provided that you comply with Section 4 with respect to +the Source of the Modified Version. + + +Aggregating or Linking the Package + +(7) You may aggregate the Package (either the Standard Version or +Modified Version) with other packages and Distribute the resulting +aggregation provided that you do not charge a licensing fee for the +Package. Distributor Fees are permitted, and licensing fees for other +components in the aggregation are permitted. The terms of this license +apply to the use and Distribution of the Standard or Modified Versions +as included in the aggregation. + +(8) You are permitted to link Modified and Standard Versions with +other works, to embed the Package in a larger work of your own, or to +build stand-alone binary or bytecode versions of applications that +include the Package, and Distribute the result without restriction, +provided the result does not expose a direct interface to the Package. + + +Items That are Not Considered Part of a Modified Version + +(9) Works (including, but not limited to, modules and scripts) that +merely extend or make use of the Package, do not, by themselves, cause +the Package to be a Modified Version. In addition, such works are not +considered parts of the Package itself, and are not subject to the +terms of this license. + + +General Provisions + +(10) Any use, modification, and distribution of the Standard or +Modified Versions is governed by this Artistic License. By using, +modifying or distributing the Package, you accept this license. Do not +use, modify, or distribute the Package, if you do not accept this +license. + +(11) If your Modified Version has been derived from a Modified +Version made by someone other than you, you are nevertheless required +to ensure that your Modified Version complies with the requirements of +this license. + +(12) This license does not grant you the right to use any trademark, +service mark, tradename, or logo of the Copyright Holder. + +(13) This license includes the non-exclusive, worldwide, +free-of-charge patent license to make, have made, use, offer to sell, +sell, import and otherwise transfer the Package with respect to any +patent claims licensable by the Copyright Holder that are necessarily +infringed by the Package. If you institute patent litigation +(including a cross-claim or counterclaim) against any party alleging +that the Package constitutes direct or contributory patent +infringement, then this Artistic License to you shall terminate on the +date that such litigation is filed. + +(14) Disclaimer of Warranty: +THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS +IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED +WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR +NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL +LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL +BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL +DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF +ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..dd01980 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,36 @@ +# This file was automatically generated by Dist::Zilla::Plugin::Manifest v5.047. +Build.PL +Changes +Changes~ +LICENSE +MANIFEST +META.json +META.yml +Makefile.PL +README +dist.ini +examples/tree +inc/Test/Run/Builder.pm +lib/File/Find/Object.pm +lib/File/Find/Object.pm~ +lib/File/Find/Object/Base.pm +lib/File/Find/Object/PathComp.pm +lib/File/Find/Object/Result.pm +scripts/bump-version-number.pl +scripts/bump-version-number.pl~ +scripts/tag-release.pl +t/00-compile.t +t/01ffo.t +t/02tree-create.t +t/03traverse.t +t/04destroy.t +t/05prune.t +t/06trailing-slash.t +t/author-pod-coverage.t +t/author-pod-syntax.t +t/lib/File/Find/Object/TreeCreate.pm +t/release-cpan-changes.t +t/release-kwalitee.t +t/release-trailing-space.t +t/sample-data/h.txt +weaver.ini diff --git a/META.json b/META.json new file mode 100644 index 0000000..ba139b4 --- /dev/null +++ b/META.json @@ -0,0 +1,127 @@ +{ + "abstract" : "An object oriented File::Find replacement", + "author" : [ + "Shlomi Fish " + ], + "dynamic_config" : 0, + "generated_by" : "Dist::Zilla version 5.047, CPAN::Meta::Converter version 2.150005", + "keywords" : [ + "alternative-to-core", + "directories", + "directory", + "directory-traversal", + "directory-tree", + "directory-trees", + "file", + "file-find", + "find", + "instance", + "instantiated", + "instantiation", + "iterative", + "object", + "object-oriented", + "oop", + "prune", + "traversal", + "traverse", + "tree" + ], + "license" : [ + "artistic_2" + ], + "meta-spec" : { + "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", + "version" : 2 + }, + "name" : "File-Find-Object", + "prereqs" : { + "build" : { + "requires" : { + "Module::Build" : "0.28" + } + }, + "configure" : { + "requires" : { + "ExtUtils::MakeMaker" : "0", + "Module::Build" : "0.28" + } + }, + "develop" : { + "requires" : { + "Pod::Coverage::TrustPod" : "0", + "Test::CPAN::Changes" : "0.19", + "Test::Pod" : "1.41", + "Test::Pod::Coverage" : "1.08", + "Test::TrailingSpace" : "0.0203" + } + }, + "runtime" : { + "requires" : { + "Carp" : "0", + "Class::XSAccessor" : "0", + "Fcntl" : "0", + "File::Spec" : "0", + "List::Util" : "0", + "integer" : "0", + "parent" : "0", + "perl" : "5.008", + "strict" : "0", + "warnings" : "0" + } + }, + "test" : { + "requires" : { + "File::Path" : "0", + "File::Spec" : "0", + "File::Temp" : "0", + "IO::Handle" : "0", + "IPC::Open3" : "0", + "Test::More" : "0", + "blib" : "1.01", + "lib" : "0", + "vars" : "0" + } + } + }, + "provides" : { + "File::Find::Object" : { + "file" : "lib/File/Find/Object.pm", + "version" : "v0.3.2" + }, + "File::Find::Object::Base" : { + "file" : "lib/File/Find/Object/Base.pm", + "version" : "v0.3.2" + }, + "File::Find::Object::DeepPath" : { + "file" : "lib/File/Find/Object.pm", + "version" : "v0.3.2" + }, + "File::Find::Object::PathComp" : { + "file" : "lib/File/Find/Object/PathComp.pm", + "version" : "v0.3.2" + }, + "File::Find::Object::Result" : { + "file" : "lib/File/Find/Object/Result.pm", + "version" : "v0.3.2" + }, + "File::Find::Object::TopPath" : { + "file" : "lib/File/Find/Object.pm", + "version" : "v0.3.2" + } + }, + "release_status" : "stable", + "resources" : { + "bugtracker" : { + "mailto" : "bug-file-find-object@rt.cpan.org", + "web" : "http://rt.cpan.org/NoAuth/Bugs.html?Dist=File-Find-Object" + }, + "repository" : { + "type" : "hg", + "url" : "ssh://hg@bitbucket.org/shlomif/perl-file-find-object", + "web" : "http://bitbucket.org/shlomif/perl-file-find-object" + } + }, + "version" : "v0.3.2" +} + diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..6b9665c --- /dev/null +++ b/META.yml @@ -0,0 +1,80 @@ +--- +abstract: 'An object oriented File::Find replacement' +author: + - 'Shlomi Fish ' +build_requires: + File::Path: '0' + File::Spec: '0' + File::Temp: '0' + IO::Handle: '0' + IPC::Open3: '0' + Module::Build: '0.28' + Test::More: '0' + blib: '1.01' + lib: '0' + vars: '0' +configure_requires: + ExtUtils::MakeMaker: '0' + Module::Build: '0.28' +dynamic_config: 0 +generated_by: 'Dist::Zilla version 5.047, CPAN::Meta::Converter version 2.150005' +keywords: + - alternative-to-core + - directories + - directory + - directory-traversal + - directory-tree + - directory-trees + - file + - file-find + - find + - instance + - instantiated + - instantiation + - iterative + - object + - object-oriented + - oop + - prune + - traversal + - traverse + - tree +license: artistic_2 +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: '1.4' +name: File-Find-Object +provides: + File::Find::Object: + file: lib/File/Find/Object.pm + version: v0.3.2 + File::Find::Object::Base: + file: lib/File/Find/Object/Base.pm + version: v0.3.2 + File::Find::Object::DeepPath: + file: lib/File/Find/Object.pm + version: v0.3.2 + File::Find::Object::PathComp: + file: lib/File/Find/Object/PathComp.pm + version: v0.3.2 + File::Find::Object::Result: + file: lib/File/Find/Object/Result.pm + version: v0.3.2 + File::Find::Object::TopPath: + file: lib/File/Find/Object.pm + version: v0.3.2 +requires: + Carp: '0' + Class::XSAccessor: '0' + Fcntl: '0' + File::Spec: '0' + List::Util: '0' + integer: '0' + parent: '0' + perl: '5.008' + strict: '0' + warnings: '0' +resources: + bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=File-Find-Object + repository: ssh://hg@bitbucket.org/shlomif/perl-file-find-object +version: v0.3.2 diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..8e7025c --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,83 @@ +# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v5.047. +use strict; +use warnings; + +use 5.008; + +use ExtUtils::MakeMaker; + +my %WriteMakefileArgs = ( + "ABSTRACT" => "An object oriented File::Find replacement", + "AUTHOR" => "Shlomi Fish ", + "BUILD_REQUIRES" => { + "Module::Build" => "0.28" + }, + "CONFIGURE_REQUIRES" => { + "ExtUtils::MakeMaker" => 0, + "Module::Build" => "0.28" + }, + "DISTNAME" => "File-Find-Object", + "LICENSE" => "artistic_2", + "MIN_PERL_VERSION" => "5.008", + "NAME" => "File::Find::Object", + "PREREQ_PM" => { + "Carp" => 0, + "Class::XSAccessor" => 0, + "Fcntl" => 0, + "File::Spec" => 0, + "List::Util" => 0, + "integer" => 0, + "parent" => 0, + "strict" => 0, + "warnings" => 0 + }, + "TEST_REQUIRES" => { + "File::Path" => 0, + "File::Spec" => 0, + "File::Temp" => 0, + "IO::Handle" => 0, + "IPC::Open3" => 0, + "Test::More" => 0, + "blib" => "1.01", + "lib" => 0, + "vars" => 0 + }, + "VERSION" => "v0.3.2", + "test" => { + "TESTS" => "t/*.t" + } +); + + +my %FallbackPrereqs = ( + "Carp" => 0, + "Class::XSAccessor" => 0, + "Fcntl" => 0, + "File::Path" => 0, + "File::Spec" => 0, + "File::Temp" => 0, + "IO::Handle" => 0, + "IPC::Open3" => 0, + "List::Util" => 0, + "Module::Build" => "0.28", + "Test::More" => 0, + "blib" => "1.01", + "integer" => 0, + "lib" => 0, + "parent" => 0, + "strict" => 0, + "vars" => 0, + "warnings" => 0 +); + + +unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { + delete $WriteMakefileArgs{TEST_REQUIRES}; + delete $WriteMakefileArgs{BUILD_REQUIRES}; + $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; +} + +delete $WriteMakefileArgs{CONFIGURE_REQUIRES} + unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; + +WriteMakefile(%WriteMakefileArgs); diff --git a/README b/README new file mode 100644 index 0000000..795dd5c --- /dev/null +++ b/README @@ -0,0 +1,46 @@ +File::Find::Object is an object-oriented and iterative replacement for +File::Find. I.e: it is a module for traversing a directory tree, and finding +all the files contained within it programatically. + +INSTALLATION + +To install this module type the following: + + perl Makefile.PL + make + make test + make install + +after you install all of its dependencies. + +Alternatively use the CPAN.pm module: + + # perl -MCPAN -e 'install File::Find::Object' + +Or the newer CPANPLUS.pm module + + # perl -MCPANPLUS -e 'install File::Find::Object' + +DEPENDENCIES + +This module's dependencies are: + +1. A Perl version that supports the "use warnings" pragma. + +2. The Class::Accessor module from CPAN. + +COPYRIGHT AND LICENSE + +Copyright (C) 2005, 2006 by Olivier Thauvin + +This package is free software; you can redistribute it and/or modify it under +the following terms: + +1. The GNU General Public License Version 2.0 - +http://www.opensource.org/licenses/gpl-license.php + +2. The Artistic License Version 2.0 - +http://www.perlfoundation.org/legal/licenses/artistic-2_0.html + +3. At your option - any later version of either or both of these licenses. + diff --git a/dist.ini b/dist.ini new file mode 100644 index 0000000..11bf911 --- /dev/null +++ b/dist.ini @@ -0,0 +1,53 @@ +name = File-Find-Object +author = Shlomi Fish +license = Artistic_2_0 +copyright_holder = Olivier Thauvin and others +copyright_year = 2000 + +[@Filter] +-bundle = @Basic +-remove = License +-remove = Readme +[AutoPrereqs] +[Keywords] +keyword = alternative-to-core +keyword = directories +keyword = directory +keyword = directory-traversal +keyword = directory-tree +keyword = directory-trees +keyword = file +keyword = file-find +keyword = find +keyword = instance +keyword = instantiated +keyword = instantiation +keyword = iterative +keyword = object +keyword = object-oriented +keyword = oop +keyword = prune +keyword = traversal +keyword = traverse +keyword = tree +[MetaJSON] +[MetaProvides::Package] +[MetaResources] +bugtracker.web = http://rt.cpan.org/NoAuth/Bugs.html?Dist=File-Find-Object +bugtracker.mailto = bug-file-find-object@rt.cpan.org +repository.url = ssh://hg@bitbucket.org/shlomif/perl-file-find-object +repository.web = http://bitbucket.org/shlomif/perl-file-find-object +repository.type = hg +[ModuleBuild] +[PodCoverageTests] +[PodSyntaxTests] +[PodWeaver] +[PruneFiles] +match = ^rejects/ +[RewriteVersion] +[Test::Compile] +fake_home = 1 +skip = bump-ver|tag-release|run_agg_tests +[Test::CPAN::Changes] +[Test::Kwalitee::Extra] +[Test::TrailingSpace] diff --git a/examples/tree b/examples/tree new file mode 100755 index 0000000..e4ea756 --- /dev/null +++ b/examples/tree @@ -0,0 +1,23 @@ +#!/usr/bin/perl + +# $Id$ + +use strict; +use warnings; +use File::Find::Object; +use Getopt::Long; + +my %options; + +GetOptions( + 'd' => \$options{depth}, + 'n' => \$options{nonet}, + 'f' => \$options{nocrossfs}, + 'l' => \$options{followlink}, +); + +my $tree = File::Find::Object->new({ %options }, @ARGV); + +while (my $r = $tree->next()) { + print $r ."\n"; +} diff --git a/inc/Test/Run/Builder.pm b/inc/Test/Run/Builder.pm new file mode 100644 index 0000000..7ecf49a --- /dev/null +++ b/inc/Test/Run/Builder.pm @@ -0,0 +1,79 @@ +package Test::Run::Builder; + +use strict; +use warnings; + +use Module::Build; + +use vars qw(@ISA); + +@ISA = (qw(Module::Build)); + +sub ACTION_runtest +{ + my ($self) = @_; + my $p = $self->{properties}; + + $self->depends_on('code'); + + local @INC = @INC; + + # Make sure we test the module in blib/ + unshift @INC, (File::Spec->catdir($p->{base_dir}, $self->blib, 'lib'), + File::Spec->catdir($p->{base_dir}, $self->blib, 'arch')); + + $self->do_test_run_tests; +} + +sub ACTION_distruntest { + my ($self) = @_; + + $self->depends_on('distdir'); + + my $start_dir = $self->cwd; + my $dist_dir = $self->dist_dir; + chdir $dist_dir or die "Cannot chdir to $dist_dir: $!"; + # XXX could be different names for scripts + + $self->run_perl_script('Build.PL') # XXX Should this be run w/ --nouse-rcfile + or die "Error executing 'Build.PL' in dist directory: $!"; + $self->run_perl_script('Build') + or die "Error executing 'Build' in dist directory: $!"; + $self->run_perl_script('Build', [], ['runtest']) + or die "Error executing 'Build test' in dist directory"; + chdir $start_dir; +} + +sub do_test_run_tests +{ + my $self = shift; + + require Test::Run::CmdLine::Iface; + + my $test_run = + Test::Run::CmdLine::Iface->new( + { + 'test_files' => [glob("t/*.t")], + } + # 'backend_params' => $self->_get_backend_params(), + ); + + return $test_run->run(); +} + +sub ACTION_tags +{ + my $self = shift; + return + $self->do_system( + "ctags", + qw(-f tags --recurse --totals + --exclude=blib/** --exclude=t/lib/** + --exclude=**/.svn/** --exclude='*~'), + "--exclude=".$self->dist_name()."-*/**", + qw(--languages=Perl --langmap=Perl:+.t) + ); +} + +1; + diff --git a/lib/File/Find/Object.pm b/lib/File/Find/Object.pm new file mode 100644 index 0000000..cc58b4b --- /dev/null +++ b/lib/File/Find/Object.pm @@ -0,0 +1,917 @@ +package File::Find::Object::DeepPath; + +use strict; +use warnings; + +our $VERSION = 'v0.3.2'; + +use 5.008; + +use integer; + +use parent 'File::Find::Object::PathComp'; + +use File::Spec; + +sub new { + my ($class, $top, $from) = @_; + + my $self = {}; + bless $self, $class; + + $self->_stat_ret($top->_top_stat_copy()); + + my $find = { %{$from->_inodes()} }; + if (my $inode = $self->_inode) { + $find->{join(",", $self->_dev(), $inode)} = + $#{$top->_dir_stack()}; + } + $self->_set_inodes($find); + + $self->_last_dir_scanned(undef); + + $top->_fill_actions($self); + + push @{$top->_curr_comps()}, ""; + + return $top->_open_dir() ? $self : undef; +} + +sub _move_next +{ + my ($self, $top) = @_; + + if (defined($self->_curr_file( + $top->_current_father()->_next_traverse_to() + ))) + { + $top->_curr_comps()->[-1] = $self->_curr_file(); + $top->_calc_curr_path(); + + $top->_fill_actions($self); + $top->_mystat(); + + return 1; + } + else { + return 0; + } +} + +package File::Find::Object::TopPath; + +our $VERSION = 'v0.3.2'; + +use parent 'File::Find::Object::PathComp'; + +sub new { + my $class = shift; + my $top = shift; + + my $self = {}; + bless $self, $class; + + $top->_fill_actions($self); + + return $self; +} + + +sub _move_to_next_target +{ + my $self = shift; + my $top = shift; + + my $target = $self->_curr_file($top->_calc_next_target()); + @{$top->_curr_comps()} = ($target); + $top->_calc_curr_path(); + + return $target; +} + +sub _move_next +{ + my $self = shift; + my $top = shift; + + while ($top->_increment_target_index()) + { + if (-e $self->_move_to_next_target($top)) + { + $top->_fill_actions($self); + $top->_mystat(); + $self->_stat_ret($top->_top_stat_copy()); + $top->_dev($self->_dev); + + my $inode = $self->_inode(); + $self->_set_inodes( + ($inode == 0) + ? {} + : + { + join(",", $self->_dev(), $inode) => 0, + }, + ); + + return 1; + } + } + + return 0; +} + +package File::Find::Object; + +use strict; +use warnings; + +use parent 'File::Find::Object::Base'; + +use File::Find::Object::Result; + +use Fcntl ':mode'; +use List::Util (); + +sub _get_options_ids +{ + my $class = shift; + return [qw( + callback + depth + filter + followlink + nocrossfs + )]; +} + +# _curr_comps are the components (comps) of the master object's current path. +# _curr_path is the concatenated path itself. + +use Class::XSAccessor + accessors => { + (map { $_ => $_ } + (qw( + _check_subdir_h + _curr_comps + _current + _curr_path + _def_actions + _dev + _dir_stack + item_obj + _target_index + _targets + _top_is_dir + _top_is_link + _top_stat + ), + @{__PACKAGE__->_get_options_ids()} + ) + ) + } + ; + +__PACKAGE__->_make_copy_methods([qw( + _top_stat + )] +); + +use Carp; + +our $VERSION = 'v0.3.2'; + +sub new { + my ($class, $options, @targets) = @_; + + # The *existence* of an _st key inside the struct + # indicates that the stack is full. + # So now it's empty. + my $tree = { + _dir_stack => [], + _curr_comps => [], + }; + + bless($tree, $class); + + foreach my $opt (@{$tree->_get_options_ids()}) + { + $tree->$opt($options->{$opt}); + } + + $tree->_gen_check_subdir_helper(); + + $tree->_targets(\@targets); + $tree->_target_index(-1); + + $tree->_calc_default_actions(); + + push @{$tree->_dir_stack()}, + $tree->_current(File::Find::Object::TopPath->new($tree)) + ; + + $tree->_last_dir_scanned(undef); + + return $tree; +} + +sub _curr_not_a_dir { + return !shift->_top_is_dir(); +} + +# Calculates _curr_path from $self->_curr_comps(). +# Must be called whenever _curr_comps is modified. +sub _calc_curr_path +{ + my $self = shift; + + $self->_curr_path(File::Spec->catfile(@{$self->_curr_comps()})); + + return; +} + +sub _calc_current_item_obj { + my $self = shift; + + my @comps = @{$self->_curr_comps()}; + + my $ret = + { + path => scalar($self->_curr_path()), + 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()) + { + $ret->{basename} = pop(@comps); + } + + return bless $ret, "File::Find::Object::Result"; +} + +sub next_obj { + my $self = shift; + + until ( $self->_process_current + || ((!$self->_master_move_to_next()) + && $self->_me_die()) + ) + { + # Do nothing + } + + return $self->item_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 _current_father { + return shift->_dir_stack->[-2]; +} + +sub _increment_target_index +{ + my $self = shift; + $self->_target_index( $self->_target_index() + 1 ); + + return ($self->_target_index() < scalar(@{$self->_targets()})); +} + +sub _calc_next_target +{ + my $self = shift; + + my $target = $self->_targets()->[$self->_target_index()]; + + return defined($target) ? File::Spec->canonpath($target) : undef; +} + +sub _master_move_to_next { + my $self = shift; + + return $self->_current()->_move_next($self); +} + +sub _me_die { + my $self = shift; + + if (exists($self->{_st})) { + return $self->_become_default(); + } + + $self->item_obj(undef()); + return 1; +} + +sub _become_default +{ + my $self = shift; + + my $st = $self->_dir_stack(); + + pop(@$st); + $self->_current($st->[-1]); + pop(@{$self->_curr_comps()}); + + if (@$st == 1) + { + delete($self->{_st}); + } + else + { + # If depth is false, then we no longer need the _curr_path + # of the directories above the previously-set value, because we + # already traversed them. + if ($self->depth()) + { + $self->_calc_curr_path(); + } + } + + return 0; +} + +sub _calc_default_actions { + my $self = shift; + + my @calc_obj = + $self->callback() + ? (qw(_run_cb)) + : (qw(_set_obj)) + ; + + my @rec = qw(_recurse); + + $self->_def_actions( + [$self->depth() + ? (@rec, @calc_obj) + : (@calc_obj, @rec) + ] + ); + + return; +} + +sub _fill_actions { + my $self = shift; + my $other = shift; + + $other->_actions([ @{$self->_def_actions()} ]); + + return; +} + +sub _mystat { + my $self = shift; + + $self->_top_stat([lstat($self->_curr_path())]); + + $self->_top_is_dir(scalar(-d _)); + + if ($self->_top_is_link(scalar(-l _))) { + stat($self->_curr_path()); + $self->_top_is_dir(scalar(-d _)); + } + + return "SKIP"; +} + +sub _next_action { + my $self = shift; + + return shift(@{$self->_current->_actions()}); +} + +sub _check_process_current { + my $self = shift; + + return (defined($self->_current->_curr_file()) && $self->_filter_wrapper()); +} + +# Return true if there is something next +sub _process_current { + my $self = shift; + + if (!$self->_check_process_current()) + { + return 0; + } + else + { + return $self->_process_current_actions(); + } +} + +sub _set_obj { + my $self = shift; + + $self->item_obj($self->_calc_current_item_obj()); + + return 1; +} + +sub _run_cb { + my $self = shift; + + $self->_set_obj(); + + $self->callback()->($self->_curr_path()); + + return 1; +} + +sub _process_current_actions +{ + my $self = shift; + + while (my $action = $self->_next_action()) + { + my $status = $self->$action(); + + if ($status ne "SKIP") + { + return $status; + } + } + + return 0; +} + +sub _recurse +{ + my $self = shift; + + $self->_check_subdir() or + return "SKIP"; + + push @{$self->_dir_stack()}, + $self->_current( + File::Find::Object::DeepPath->new( + $self, + $self->_current() + ) + ); + + $self->{_st} = 1; + + return 0; +} + +sub _filter_wrapper { + my $self = shift; + + return defined($self->filter()) ? + $self->filter()->($self->_curr_path()) : + 1; +} + +sub _check_subdir +{ + my $self = shift; + + # If current is not a directory always return 0, because we may + # be asked to traverse single-files. + + if ($self->_curr_not_a_dir()) + { + return 0; + } + else + { + return $self->_check_subdir_h()->($self); + } +} + + + +sub _warn_about_loop +{ + my $self = shift; + my $component_idx = shift; + + # Don't pass strings directly to the format. + # Instead - use %s + # This was a security problem. + warn( + sprintf( + "Avoid loop %s => %s\n", + File::Spec->catdir( + @{$self->_curr_comps()}[0 .. $component_idx] + ), + $self->_curr_path(), + ) + ); + + return; +} + +sub _is_loop { + my $self = shift; + + my $key = join(",", @{$self->_top_stat()}[0,1]); + my $lookup = $self->_current->_inodes; + + if (exists($lookup->{$key})) { + $self->_warn_about_loop($lookup->{$key}); + return 1; + } + else { + return; + } +} + +# We eval "" the helper of check_subdir because the conditions that +# affect the checks are instance-wide and constant and so we can +# determine how the code should look like. + +sub _gen_check_subdir_helper { + my $self = shift; + + my @clauses; + + if (!$self->followlink()) { + push @clauses, '$s->_top_is_link()'; + } + + if ($self->nocrossfs()) { + push @clauses, '($s->_top_stat->[0] != $s->_dev())'; + } + + push @clauses, '$s->_is_loop()'; + + $self->_check_subdir_h( + _context_less_eval( + 'sub { my $s = shift; ' + . 'return ((!exists($s->{_st})) || !(' + . join("||", @clauses) . '));' + . '}' + ) + ); +} + +sub _context_less_eval { + my $code = shift; + return eval $code; +} + +sub _open_dir { + my $self = shift; + + return $self->_current()->_component_open_dir( + $self->_curr_path() + ); +} + +sub set_traverse_to +{ + my ($self, $children) = @_; + + # Make sure we scan the current directory for sub-items first. + $self->get_current_node_files_list(); + + $self->_current->_traverse_to([@$children]); +} + +sub get_traverse_to +{ + my $self = shift; + + return $self->_current->_traverse_to_copy(); +} + +sub get_current_node_files_list +{ + my $self = shift; + + # _open_dir can return undef if $self->_current is not a directory. + if ($self->_open_dir()) + { + return $self->_current->_files_copy(); + } + else + { + return []; + } +} + +sub prune +{ + my $self = shift; + + return $self->set_traverse_to([]); +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +File::Find::Object - An object oriented File::Find replacement + +=head1 VERSION + +version v0.3.2 + +=head1 SYNOPSIS + + use File::Find::Object; + my $tree = File::Find::Object->new({}, @targets); + + while (my $r = $tree->next()) { + print $r ."\n"; + } + +=head1 DESCRIPTION + +File::Find::Object does the same job as File::Find but works like an object +and with an iterator. As File::Find is not object oriented, one cannot perform +multiple searches in the same application. The second problem of File::Find +is its file processing: after starting its main loop, one cannot easily wait +for another event and so get the next result. + +With File::Find::Object you can get the next file by calling the next() +function, but setting a callback is still possible. + +=head1 FUNCTIONS + +=head2 new + + my $ffo = File::Find::Object->new( { options }, @targets); + +Create a new File::Find::Object object. C<@targets> is the list of +directories or files which the object should explore. + +=head3 options + +=over 4 + +=item depth + +Boolean - returns the directory content before the directory itself. + +=item nocrossfs + +Boolean - doesn't continue on filesystems different than the parent. + +=item followlink + +Boolean - follow symlinks when they point to a directory. + +You can safely set this option to true as File::Find::Object does not follow +the link if it detects a loop. + +=item filter + +Function reference - should point to a function returning TRUE or FALSE. This +function is called with the filename to filter, if the function return FALSE, +the file is skipped. + +=item callback + +Function reference - should point to a function, which would be called each +time a new file is returned. The function is called with the current filename +as an argument. + +=back + +=head2 next + +Returns the next file found by the File::Find::Object. It returns undef once +the scan is completed. + +=head2 item + +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 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 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 +items to traverse. + +Accepts a single array reference. + +Example: + + $ff->set_traverse_to([ grep { ! /\A\./ } @{ $ff->get_traverse_to }]); + +=head2 $ff->prune() + +Prunes the current directory. Equivalent to $ff->set_traverse_to([]). + +=head2 [@children] = $ff->get_traverse_to() + +Retrieves the children that will be traversed to. Returns a single array +reference. + +(Example under C). + +=head2 [@files] = $ff->get_current_node_files_list() + +Gets all the files that appear in the current directory. This value remains +constant for every node, even after traversal or calls to C +and is useful to use as the basis of the argument for C. + +Returns a single array reference. + +=head1 BUGS + +No bugs are known, but it doesn't mean there aren't any. + +=head1 SEE ALSO + +There's an article about this module in the Perl Advent Calendar of 2006: +L. + +L is the core module for traversing files in perl, which has +several limitations. + +L, L, L and the unmaintained +L are alternatives to this module. + +=head1 LICENSE + +Copyright (C) 2005, 2006 by Olivier Thauvin + +This package is free software; you can redistribute it and/or modify it under +the following terms: + +1. The GNU General Public License Version 2.0 - +http://www.opensource.org/licenses/gpl-license.php + +2. The Artistic License Version 2.0 - +http://www.perlfoundation.org/legal/licenses/artistic-2_0.html + +3. At your option - any later version of either or both of these licenses. + +=head1 AUTHOR + +Shlomi Fish + +=head1 COPYRIGHT AND LICENSE + +This software is Copyright (c) 2000 by Olivier Thauvin and others. + +This is free software, licensed under: + + The Artistic License 2.0 (GPL Compatible) + +=head1 BUGS + +Please report any bugs or feature requests on the bugtracker website +http://rt.cpan.org/NoAuth/Bugs.html?Dist=File-Find-Object or by email to +bug-file-find-object@rt.cpan.org. + +When submitting a bug or request, please include a test-file or a +patch to an existing test-file that illustrates the bug or desired +feature. + +=for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan + +=head1 SUPPORT + +=head2 Perldoc + +You can find documentation for this module with the perldoc command. + + perldoc File::Find::Object + +=head2 Websites + +The following websites have more information about this module, and may be of help to you. As always, +in addition to those websites please use your favorite search engine to discover more resources. + +=over 4 + +=item * + +MetaCPAN + +A modern, open-source CPAN search engine, useful to view POD in HTML format. + +L + +=item * + +Search CPAN + +The default CPAN search engine, useful to view POD in HTML format. + +L + +=item * + +RT: CPAN's Bug Tracker + +The RT ( Request Tracker ) website is the default bug/issue tracking system for CPAN. + +L + +=item * + +AnnoCPAN + +The AnnoCPAN is a website that allows community annotations of Perl module documentation. + +L + +=item * + +CPAN Ratings + +The CPAN Ratings is a website that allows community ratings and reviews of Perl modules. + +L + +=item * + +CPAN Forum + +The CPAN Forum is a web forum for discussing Perl modules. + +L + +=item * + +CPANTS + +The CPANTS is a website that analyzes the Kwalitee ( code metrics ) of a distribution. + +L + +=item * + +CPAN Testers + +The CPAN Testers is a network of smokers who run automated tests on uploaded CPAN distributions. + +L + +=item * + +CPAN Testers Matrix + +The CPAN Testers Matrix is a website that provides a visual overview of the test results for a distribution on various Perls/platforms. + +L + +=item * + +CPAN Testers Dependencies + +The CPAN Testers Dependencies is a website that shows a chart of the test results of all dependencies for a distribution. + +L + +=back + +=head2 Bugs / Feature Requests + +Please report any bugs or feature requests by email to C, or through +the web interface at L. You will be automatically notified of any +progress on the request by the system. + +=head2 Source Code + +The code is open to the world, and available for you to hack on. Please feel free to browse it and play +with it, or whatever. If you want to contribute patches, please send me a diff or prod me to pull +from your repository :) + +L + + hg clone ssh://hg@bitbucket.org/shlomif/perl-file-find-object + +=cut diff --git a/lib/File/Find/Object.pm~ b/lib/File/Find/Object.pm~ new file mode 100644 index 0000000..c62a9f7 --- /dev/null +++ b/lib/File/Find/Object.pm~ @@ -0,0 +1,773 @@ +package File::Find::Object::DeepPath; + +use strict; +use warnings; + +our $VERSION = 'v0.3.1'; + +use 5.008; + +use integer; + +use parent 'File::Find::Object::PathComp'; + +use File::Spec; + +sub new { + my ($class, $top, $from) = @_; + + my $self = {}; + bless $self, $class; + + $self->_stat_ret($top->_top_stat_copy()); + + my $find = { %{$from->_inodes()} }; + if (my $inode = $self->_inode) { + $find->{join(",", $self->_dev(), $inode)} = + $#{$top->_dir_stack()}; + } + $self->_set_inodes($find); + + $self->_last_dir_scanned(undef); + + $top->_fill_actions($self); + + push @{$top->_curr_comps()}, ""; + + return $top->_open_dir() ? $self : undef; +} + +sub _move_next +{ + my ($self, $top) = @_; + + if (defined($self->_curr_file( + $top->_current_father()->_next_traverse_to() + ))) + { + $top->_curr_comps()->[-1] = $self->_curr_file(); + $top->_calc_curr_path(); + + $top->_fill_actions($self); + $top->_mystat(); + + return 1; + } + else { + return 0; + } +} + +package File::Find::Object::TopPath; + +our $VERSION = '0.3.2'; + +use parent 'File::Find::Object::PathComp'; + +sub new { + my $class = shift; + my $top = shift; + + my $self = {}; + bless $self, $class; + + $top->_fill_actions($self); + + return $self; +} + + +sub _move_to_next_target +{ + my $self = shift; + my $top = shift; + + my $target = $self->_curr_file($top->_calc_next_target()); + @{$top->_curr_comps()} = ($target); + $top->_calc_curr_path(); + + return $target; +} + +sub _move_next +{ + my $self = shift; + my $top = shift; + + while ($top->_increment_target_index()) + { + if (-e $self->_move_to_next_target($top)) + { + $top->_fill_actions($self); + $top->_mystat(); + $self->_stat_ret($top->_top_stat_copy()); + $top->_dev($self->_dev); + + my $inode = $self->_inode(); + $self->_set_inodes( + ($inode == 0) + ? {} + : + { + join(",", $self->_dev(), $inode) => 0, + }, + ); + + return 1; + } + } + + return 0; +} + +package File::Find::Object; + +use strict; +use warnings; + +use parent 'File::Find::Object::Base'; + +use File::Find::Object::Result; + +use Fcntl ':mode'; +use List::Util (); + +sub _get_options_ids +{ + my $class = shift; + return [qw( + callback + depth + filter + followlink + nocrossfs + )]; +} + +# _curr_comps are the components (comps) of the master object's current path. +# _curr_path is the concatenated path itself. + +use Class::XSAccessor + accessors => { + (map { $_ => $_ } + (qw( + _check_subdir_h + _curr_comps + _current + _curr_path + _def_actions + _dev + _dir_stack + item_obj + _target_index + _targets + _top_is_dir + _top_is_link + _top_stat + ), + @{__PACKAGE__->_get_options_ids()} + ) + ) + } + ; + +__PACKAGE__->_make_copy_methods([qw( + _top_stat + )] +); + +use Carp; + +our $VERSION = '0.3.2'; + +sub new { + my ($class, $options, @targets) = @_; + + # The *existence* of an _st key inside the struct + # indicates that the stack is full. + # So now it's empty. + my $tree = { + _dir_stack => [], + _curr_comps => [], + }; + + bless($tree, $class); + + foreach my $opt (@{$tree->_get_options_ids()}) + { + $tree->$opt($options->{$opt}); + } + + $tree->_gen_check_subdir_helper(); + + $tree->_targets(\@targets); + $tree->_target_index(-1); + + $tree->_calc_default_actions(); + + push @{$tree->_dir_stack()}, + $tree->_current(File::Find::Object::TopPath->new($tree)) + ; + + $tree->_last_dir_scanned(undef); + + return $tree; +} + +sub _curr_not_a_dir { + return !shift->_top_is_dir(); +} + +# Calculates _curr_path from $self->_curr_comps(). +# Must be called whenever _curr_comps is modified. +sub _calc_curr_path +{ + my $self = shift; + + $self->_curr_path(File::Spec->catfile(@{$self->_curr_comps()})); + + return; +} + +sub _calc_current_item_obj { + my $self = shift; + + my @comps = @{$self->_curr_comps()}; + + my $ret = + { + path => scalar($self->_curr_path()), + 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()) + { + $ret->{basename} = pop(@comps); + } + + return bless $ret, "File::Find::Object::Result"; +} + +sub next_obj { + my $self = shift; + + until ( $self->_process_current + || ((!$self->_master_move_to_next()) + && $self->_me_die()) + ) + { + # Do nothing + } + + return $self->item_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 _current_father { + return shift->_dir_stack->[-2]; +} + +sub _increment_target_index +{ + my $self = shift; + $self->_target_index( $self->_target_index() + 1 ); + + return ($self->_target_index() < scalar(@{$self->_targets()})); +} + +sub _calc_next_target +{ + my $self = shift; + + my $target = $self->_targets()->[$self->_target_index()]; + + return defined($target) ? File::Spec->canonpath($target) : undef; +} + +sub _master_move_to_next { + my $self = shift; + + return $self->_current()->_move_next($self); +} + +sub _me_die { + my $self = shift; + + if (exists($self->{_st})) { + return $self->_become_default(); + } + + $self->item_obj(undef()); + return 1; +} + +sub _become_default +{ + my $self = shift; + + my $st = $self->_dir_stack(); + + pop(@$st); + $self->_current($st->[-1]); + pop(@{$self->_curr_comps()}); + + if (@$st == 1) + { + delete($self->{_st}); + } + else + { + # If depth is false, then we no longer need the _curr_path + # of the directories above the previously-set value, because we + # already traversed them. + if ($self->depth()) + { + $self->_calc_curr_path(); + } + } + + return 0; +} + +sub _calc_default_actions { + my $self = shift; + + my @calc_obj = + $self->callback() + ? (qw(_run_cb)) + : (qw(_set_obj)) + ; + + my @rec = qw(_recurse); + + $self->_def_actions( + [$self->depth() + ? (@rec, @calc_obj) + : (@calc_obj, @rec) + ] + ); + + return; +} + +sub _fill_actions { + my $self = shift; + my $other = shift; + + $other->_actions([ @{$self->_def_actions()} ]); + + return; +} + +sub _mystat { + my $self = shift; + + $self->_top_stat([lstat($self->_curr_path())]); + + $self->_top_is_dir(scalar(-d _)); + + if ($self->_top_is_link(scalar(-l _))) { + stat($self->_curr_path()); + $self->_top_is_dir(scalar(-d _)); + } + + return "SKIP"; +} + +sub _next_action { + my $self = shift; + + return shift(@{$self->_current->_actions()}); +} + +sub _check_process_current { + my $self = shift; + + return (defined($self->_current->_curr_file()) && $self->_filter_wrapper()); +} + +# Return true if there is something next +sub _process_current { + my $self = shift; + + if (!$self->_check_process_current()) + { + return 0; + } + else + { + return $self->_process_current_actions(); + } +} + +sub _set_obj { + my $self = shift; + + $self->item_obj($self->_calc_current_item_obj()); + + return 1; +} + +sub _run_cb { + my $self = shift; + + $self->_set_obj(); + + $self->callback()->($self->_curr_path()); + + return 1; +} + +sub _process_current_actions +{ + my $self = shift; + + while (my $action = $self->_next_action()) + { + my $status = $self->$action(); + + if ($status ne "SKIP") + { + return $status; + } + } + + return 0; +} + +sub _recurse +{ + my $self = shift; + + $self->_check_subdir() or + return "SKIP"; + + push @{$self->_dir_stack()}, + $self->_current( + File::Find::Object::DeepPath->new( + $self, + $self->_current() + ) + ); + + $self->{_st} = 1; + + return 0; +} + +sub _filter_wrapper { + my $self = shift; + + return defined($self->filter()) ? + $self->filter()->($self->_curr_path()) : + 1; +} + +sub _check_subdir +{ + my $self = shift; + + # If current is not a directory always return 0, because we may + # be asked to traverse single-files. + + if ($self->_curr_not_a_dir()) + { + return 0; + } + else + { + return $self->_check_subdir_h()->($self); + } +} + + + +sub _warn_about_loop +{ + my $self = shift; + my $component_idx = shift; + + # Don't pass strings directly to the format. + # Instead - use %s + # This was a security problem. + warn( + sprintf( + "Avoid loop %s => %s\n", + File::Spec->catdir( + @{$self->_curr_comps()}[0 .. $component_idx] + ), + $self->_curr_path(), + ) + ); + + return; +} + +sub _is_loop { + my $self = shift; + + my $key = join(",", @{$self->_top_stat()}[0,1]); + my $lookup = $self->_current->_inodes; + + if (exists($lookup->{$key})) { + $self->_warn_about_loop($lookup->{$key}); + return 1; + } + else { + return; + } +} + +# We eval "" the helper of check_subdir because the conditions that +# affect the checks are instance-wide and constant and so we can +# determine how the code should look like. + +sub _gen_check_subdir_helper { + my $self = shift; + + my @clauses; + + if (!$self->followlink()) { + push @clauses, '$s->_top_is_link()'; + } + + if ($self->nocrossfs()) { + push @clauses, '($s->_top_stat->[0] != $s->_dev())'; + } + + push @clauses, '$s->_is_loop()'; + + $self->_check_subdir_h( + _context_less_eval( + 'sub { my $s = shift; ' + . 'return ((!exists($s->{_st})) || !(' + . join("||", @clauses) . '));' + . '}' + ) + ); +} + +sub _context_less_eval { + my $code = shift; + return eval $code; +} + +sub _open_dir { + my $self = shift; + + return $self->_current()->_component_open_dir( + $self->_curr_path() + ); +} + +sub set_traverse_to +{ + my ($self, $children) = @_; + + # Make sure we scan the current directory for sub-items first. + $self->get_current_node_files_list(); + + $self->_current->_traverse_to([@$children]); +} + +sub get_traverse_to +{ + my $self = shift; + + return $self->_current->_traverse_to_copy(); +} + +sub get_current_node_files_list +{ + my $self = shift; + + # _open_dir can return undef if $self->_current is not a directory. + if ($self->_open_dir()) + { + return $self->_current->_files_copy(); + } + else + { + return []; + } +} + +sub prune +{ + my $self = shift; + + return $self->set_traverse_to([]); +} + +1; + +__END__ + +=head1 NAME + +File::Find::Object - An object oriented File::Find replacement + +=head1 SYNOPSIS + + use File::Find::Object; + my $tree = File::Find::Object->new({}, @targets); + + while (my $r = $tree->next()) { + print $r ."\n"; + } + +=head1 DESCRIPTION + +File::Find::Object does the same job as File::Find but works like an object +and with an iterator. As File::Find is not object oriented, one cannot perform +multiple searches in the same application. The second problem of File::Find +is its file processing: after starting its main loop, one cannot easily wait +for another event and so get the next result. + +With File::Find::Object you can get the next file by calling the next() +function, but setting a callback is still possible. + +=head1 FUNCTIONS + +=head2 new + + my $ffo = File::Find::Object->new( { options }, @targets); + +Create a new File::Find::Object object. C<@targets> is the list of +directories or files which the object should explore. + +=head3 options + +=over 4 + +=item depth + +Boolean - returns the directory content before the directory itself. + +=item nocrossfs + +Boolean - doesn't continue on filesystems different than the parent. + +=item followlink + +Boolean - follow symlinks when they point to a directory. + +You can safely set this option to true as File::Find::Object does not follow +the link if it detects a loop. + +=item filter + +Function reference - should point to a function returning TRUE or FALSE. This +function is called with the filename to filter, if the function return FALSE, +the file is skipped. + +=item callback + +Function reference - should point to a function, which would be called each +time a new file is returned. The function is called with the current filename +as an argument. + +=back + +=head2 next + +Returns the next file found by the File::Find::Object. It returns undef once +the scan is completed. + +=head2 item + +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 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 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 +items to traverse. + +Accepts a single array reference. + +Example: + + $ff->set_traverse_to([ grep { ! /\A\./ } @{ $ff->get_traverse_to }]); + +=head2 $ff->prune() + +Prunes the current directory. Equivalent to $ff->set_traverse_to([]). + +=head2 [@children] = $ff->get_traverse_to() + +Retrieves the children that will be traversed to. Returns a single array +reference. + +(Example under C). + +=head2 [@files] = $ff->get_current_node_files_list() + +Gets all the files that appear in the current directory. This value remains +constant for every node, even after traversal or calls to C +and is useful to use as the basis of the argument for C. + +Returns a single array reference. + +=head1 BUGS + +No bugs are known, but it doesn't mean there aren't any. + +=head1 SEE ALSO + +There's an article about this module in the Perl Advent Calendar of 2006: +L. + +L is the core module for traversing files in perl, which has +several limitations. + +L, L, L and the unmaintained +L are alternatives to this module. + +=head1 LICENSE + +Copyright (C) 2005, 2006 by Olivier Thauvin + +This package is free software; you can redistribute it and/or modify it under +the following terms: + +1. The GNU General Public License Version 2.0 - +http://www.opensource.org/licenses/gpl-license.php + +2. The Artistic License Version 2.0 - +http://www.perlfoundation.org/legal/licenses/artistic-2_0.html + +3. At your option - any later version of either or both of these licenses. + +=cut + diff --git a/lib/File/Find/Object/Base.pm b/lib/File/Find/Object/Base.pm new file mode 100644 index 0000000..834a2f6 --- /dev/null +++ b/lib/File/Find/Object/Base.pm @@ -0,0 +1,229 @@ +package File::Find::Object::Base; + +use strict; +use warnings; + +our $VERSION = 'v0.3.2'; + +use integer; + +# TODO : +# _last_dir_scanned should be defined only for ::PathComp , but we should +# add a regression test to test it. +# + +use Class::XSAccessor + accessors => { + (map + { $_ => $_ } + (qw( + _last_dir_scanned + )) + ) + } + ; + +use File::Spec; + +# Create a _copy method that does a flat copy of an array returned by +# a method as a reference. + +sub _make_copy_methods +{ + my ($pkg, $methods) = @_; + + no strict 'refs'; + foreach my $method (@$methods) + { + *{$pkg."::".$method."_copy"} = + do { + my $m = $method; + sub { + my $self = shift; + return [ @{$self->$m(@_)} ]; + }; + }; + } + return; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +File::Find::Object::Base - base class for File::Find::Object + +=head1 VERSION + +version v0.3.2 + +=head1 DESCRIPTION + +This is the base class for F::F::O classes. It only defines some accessors, +and is for File::Find::Object's internal use. + +=head1 METHODS + +=head1 SEE ALSO + +L + +=head1 LICENSE + +Copyright (C) 2005, 2006 by Olivier Thauvin + +This package is free software; you can redistribute it and/or modify it under +the following terms: + +1. The GNU General Public License Version 2.0 - +http://www.opensource.org/licenses/gpl-license.php + +2. The Artistic License Version 2.0 - +http://www.perlfoundation.org/legal/licenses/artistic-2_0.html + +3. At your option - any later version of either or both of these licenses. + +=head1 AUTHOR + +Shlomi Fish + +=head1 COPYRIGHT AND LICENSE + +This software is Copyright (c) 2000 by Olivier Thauvin and others. + +This is free software, licensed under: + + The Artistic License 2.0 (GPL Compatible) + +=head1 BUGS + +Please report any bugs or feature requests on the bugtracker website +http://rt.cpan.org/NoAuth/Bugs.html?Dist=File-Find-Object or by email to +bug-file-find-object@rt.cpan.org. + +When submitting a bug or request, please include a test-file or a +patch to an existing test-file that illustrates the bug or desired +feature. + +=for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan + +=head1 SUPPORT + +=head2 Perldoc + +You can find documentation for this module with the perldoc command. + + perldoc File::Find::Object + +=head2 Websites + +The following websites have more information about this module, and may be of help to you. As always, +in addition to those websites please use your favorite search engine to discover more resources. + +=over 4 + +=item * + +MetaCPAN + +A modern, open-source CPAN search engine, useful to view POD in HTML format. + +L + +=item * + +Search CPAN + +The default CPAN search engine, useful to view POD in HTML format. + +L + +=item * + +RT: CPAN's Bug Tracker + +The RT ( Request Tracker ) website is the default bug/issue tracking system for CPAN. + +L + +=item * + +AnnoCPAN + +The AnnoCPAN is a website that allows community annotations of Perl module documentation. + +L + +=item * + +CPAN Ratings + +The CPAN Ratings is a website that allows community ratings and reviews of Perl modules. + +L + +=item * + +CPAN Forum + +The CPAN Forum is a web forum for discussing Perl modules. + +L + +=item * + +CPANTS + +The CPANTS is a website that analyzes the Kwalitee ( code metrics ) of a distribution. + +L + +=item * + +CPAN Testers + +The CPAN Testers is a network of smokers who run automated tests on uploaded CPAN distributions. + +L + +=item * + +CPAN Testers Matrix + +The CPAN Testers Matrix is a website that provides a visual overview of the test results for a distribution on various Perls/platforms. + +L + +=item * + +CPAN Testers Dependencies + +The CPAN Testers Dependencies is a website that shows a chart of the test results of all dependencies for a distribution. + +L + +=back + +=head2 Bugs / Feature Requests + +Please report any bugs or feature requests by email to C, or through +the web interface at L. You will be automatically notified of any +progress on the request by the system. + +=head2 Source Code + +The code is open to the world, and available for you to hack on. Please feel free to browse it and play +with it, or whatever. If you want to contribute patches, please send me a diff or prod me to pull +from your repository :) + +L + + hg clone ssh://hg@bitbucket.org/shlomif/perl-file-find-object + +=cut diff --git a/lib/File/Find/Object/PathComp.pm b/lib/File/Find/Object/PathComp.pm new file mode 100644 index 0000000..55a9da0 --- /dev/null +++ b/lib/File/Find/Object/PathComp.pm @@ -0,0 +1,316 @@ +package File::Find::Object::PathComp; + +use strict; +use warnings; + +our $VERSION = 'v0.3.2'; + +use integer; + +use parent 'File::Find::Object::Base'; + +use Class::XSAccessor + accessors => { + (map + { $_ => $_ } + (qw( + _actions + _curr_file + _files + _last_dir_scanned + _open_dir_ret + _stat_ret + _traverse_to + )) + ) + }, + getters => { _inodes => '_inodes' }, + setters => { _set_inodes => '_inodes' }, + ; + +use File::Spec; + +__PACKAGE__->_make_copy_methods([qw( + _files + _traverse_to + )] +); + +sub _dev +{ + return shift->_stat_ret->[0]; +} + +sub _inode +{ + return shift->_stat_ret->[1]; +} + +sub _is_same_inode +{ + my $self = shift; + # $st is an array ref with the return of perldoc -f stat . + my $st = shift; + + # On MS-Windows, all inodes in stat are returned as 0, so we need to + # check that both inodes are not zero. This is why there's the + # $self->_inode() != 0 check at the end. + return + ( + $self->_dev() == $st->[0] + && $self->_inode() == $st->[1] + && $self->_inode() != 0 + ); +} + +sub _should_scan_dir +{ + my $self = shift; + my $dir_str = shift; + + if (defined($self->_last_dir_scanned()) && + ($self->_last_dir_scanned() eq $dir_str + ) + ) + { + return; + } + else + { + $self->_last_dir_scanned($dir_str); + return 1; + } +} + +sub _set_up_dir +{ + my $self = shift; + my $dir_str = shift; + + $self->_files($self->_calc_dir_files($dir_str)); + + $self->_traverse_to($self->_files_copy()); + + return $self->_open_dir_ret(1); +} + +sub _calc_dir_files +{ + my $self = shift; + my $dir_str = shift; + + my $handle; + my @files; + if (!opendir($handle, $dir_str)) + { + # Handle this error gracefully. + } + else + { + @files = (sort { $a cmp $b } File::Spec->no_upwards(readdir($handle))); + closedir($handle); + } + + return \@files; +} + +sub _component_open_dir +{ + my $self = shift; + my $dir_str = shift; + + if (!$self->_should_scan_dir($dir_str)) + { + return $self->_open_dir_ret(); + } + + return $self->_set_up_dir($dir_str); +} + +sub _next_traverse_to +{ + my $self = shift; + + return shift(@{$self->_traverse_to()}); +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +File::Find::Object::PathComp - base class for File::Find::Object's Path Components + +=head1 VERSION + +version v0.3.2 + +=head1 DESCRIPTION + +This is the base class for F::F::O's path components. It only defines some +accessors, and is for File::Find::Object's internal use. + +=head1 METHODS + +=head1 SEE ALSO + +L + +=head1 LICENSE + +Copyright (C) 2005, 2006 by Olivier Thauvin + +This package is free software; you can redistribute it and/or modify it under +the following terms: + +1. The GNU General Public License Version 2.0 - +http://www.opensource.org/licenses/gpl-license.php + +2. The Artistic License Version 2.0 - +http://www.perlfoundation.org/legal/licenses/artistic-2_0.html + +3. At your option - any later version of either or both of these licenses. + +=head1 AUTHOR + +Shlomi Fish + +=head1 COPYRIGHT AND LICENSE + +This software is Copyright (c) 2000 by Olivier Thauvin and others. + +This is free software, licensed under: + + The Artistic License 2.0 (GPL Compatible) + +=head1 BUGS + +Please report any bugs or feature requests on the bugtracker website +http://rt.cpan.org/NoAuth/Bugs.html?Dist=File-Find-Object or by email to +bug-file-find-object@rt.cpan.org. + +When submitting a bug or request, please include a test-file or a +patch to an existing test-file that illustrates the bug or desired +feature. + +=for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan + +=head1 SUPPORT + +=head2 Perldoc + +You can find documentation for this module with the perldoc command. + + perldoc File::Find::Object + +=head2 Websites + +The following websites have more information about this module, and may be of help to you. As always, +in addition to those websites please use your favorite search engine to discover more resources. + +=over 4 + +=item * + +MetaCPAN + +A modern, open-source CPAN search engine, useful to view POD in HTML format. + +L + +=item * + +Search CPAN + +The default CPAN search engine, useful to view POD in HTML format. + +L + +=item * + +RT: CPAN's Bug Tracker + +The RT ( Request Tracker ) website is the default bug/issue tracking system for CPAN. + +L + +=item * + +AnnoCPAN + +The AnnoCPAN is a website that allows community annotations of Perl module documentation. + +L + +=item * + +CPAN Ratings + +The CPAN Ratings is a website that allows community ratings and reviews of Perl modules. + +L + +=item * + +CPAN Forum + +The CPAN Forum is a web forum for discussing Perl modules. + +L + +=item * + +CPANTS + +The CPANTS is a website that analyzes the Kwalitee ( code metrics ) of a distribution. + +L + +=item * + +CPAN Testers + +The CPAN Testers is a network of smokers who run automated tests on uploaded CPAN distributions. + +L + +=item * + +CPAN Testers Matrix + +The CPAN Testers Matrix is a website that provides a visual overview of the test results for a distribution on various Perls/platforms. + +L + +=item * + +CPAN Testers Dependencies + +The CPAN Testers Dependencies is a website that shows a chart of the test results of all dependencies for a distribution. + +L + +=back + +=head2 Bugs / Feature Requests + +Please report any bugs or feature requests by email to C, or through +the web interface at L. You will be automatically notified of any +progress on the request by the system. + +=head2 Source Code + +The code is open to the world, and available for you to hack on. Please feel free to browse it and play +with it, or whatever. If you want to contribute patches, please send me a diff or prod me to pull +from your repository :) + +L + + hg clone ssh://hg@bitbucket.org/shlomif/perl-file-find-object + +=cut diff --git a/lib/File/Find/Object/Result.pm b/lib/File/Find/Object/Result.pm new file mode 100644 index 0000000..01da062 --- /dev/null +++ b/lib/File/Find/Object/Result.pm @@ -0,0 +1,276 @@ +package File::Find::Object::Result; + +use strict; +use warnings; + +our $VERSION = 'v0.3.2'; + +use integer; + +use Class::XSAccessor + accessors => { + (map { $_ => $_ } (qw( + base + basename + is_dir + is_file + is_link + path + dir_components + stat_ret + ))) + } + ; + +use Fcntl qw(:mode); + +sub new +{ + my $class = shift; + my $self = shift; + + bless $self, $class; + + return $self; +} + +sub full_components +{ + my $self = shift; + + return + [ + @{$self->dir_components()}, + ($self->is_dir() ? () : $self->basename()), + ]; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +File::Find::Object::Result - a result class for File::Find::Object + +=head1 VERSION + +version v0.3.2 + +=head1 DESCRIPTION + +This is a class returning a single L result as returned +by its next_obj() method. + +=head1 METHODS + +=head2 File::Find::Object::Result->new({%args}); + +Initializes a new object from %args. For internal use. + +=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->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() +(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. + +Returns a single array reference. + +=head2 $result->stat_ret() + +The return value of L for the result, placed +inside an array reference. This is calculated by L and +kept here for convenience and for internal use. + +=head1 SEE ALSO + +L + +=head1 LICENSE + +Copyright (C) 2005, 2006 by Olivier Thauvin + +This package is free software; you can redistribute it and/or modify it under +the following terms: + +1. The GNU General Public License Version 2.0 - +http://www.opensource.org/licenses/gpl-license.php + +2. The Artistic License Version 2.0 - +http://www.perlfoundation.org/legal/licenses/artistic-2_0.html + +3. At your option - any later version of either or both of these licenses. + +=head1 AUTHOR + +Shlomi Fish + +=head1 COPYRIGHT AND LICENSE + +This software is Copyright (c) 2000 by Olivier Thauvin and others. + +This is free software, licensed under: + + The Artistic License 2.0 (GPL Compatible) + +=head1 BUGS + +Please report any bugs or feature requests on the bugtracker website +http://rt.cpan.org/NoAuth/Bugs.html?Dist=File-Find-Object or by email to +bug-file-find-object@rt.cpan.org. + +When submitting a bug or request, please include a test-file or a +patch to an existing test-file that illustrates the bug or desired +feature. + +=for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan + +=head1 SUPPORT + +=head2 Perldoc + +You can find documentation for this module with the perldoc command. + + perldoc File::Find::Object + +=head2 Websites + +The following websites have more information about this module, and may be of help to you. As always, +in addition to those websites please use your favorite search engine to discover more resources. + +=over 4 + +=item * + +MetaCPAN + +A modern, open-source CPAN search engine, useful to view POD in HTML format. + +L + +=item * + +Search CPAN + +The default CPAN search engine, useful to view POD in HTML format. + +L + +=item * + +RT: CPAN's Bug Tracker + +The RT ( Request Tracker ) website is the default bug/issue tracking system for CPAN. + +L + +=item * + +AnnoCPAN + +The AnnoCPAN is a website that allows community annotations of Perl module documentation. + +L + +=item * + +CPAN Ratings + +The CPAN Ratings is a website that allows community ratings and reviews of Perl modules. + +L + +=item * + +CPAN Forum + +The CPAN Forum is a web forum for discussing Perl modules. + +L + +=item * + +CPANTS + +The CPANTS is a website that analyzes the Kwalitee ( code metrics ) of a distribution. + +L + +=item * + +CPAN Testers + +The CPAN Testers is a network of smokers who run automated tests on uploaded CPAN distributions. + +L + +=item * + +CPAN Testers Matrix + +The CPAN Testers Matrix is a website that provides a visual overview of the test results for a distribution on various Perls/platforms. + +L + +=item * + +CPAN Testers Dependencies + +The CPAN Testers Dependencies is a website that shows a chart of the test results of all dependencies for a distribution. + +L + +=back + +=head2 Bugs / Feature Requests + +Please report any bugs or feature requests by email to C, or through +the web interface at L. You will be automatically notified of any +progress on the request by the system. + +=head2 Source Code + +The code is open to the world, and available for you to hack on. Please feel free to browse it and play +with it, or whatever. If you want to contribute patches, please send me a diff or prod me to pull +from your repository :) + +L + + hg clone ssh://hg@bitbucket.org/shlomif/perl-file-find-object + +=cut diff --git a/scripts/bump-version-number.pl b/scripts/bump-version-number.pl new file mode 100644 index 0000000..16f5b7f --- /dev/null +++ b/scripts/bump-version-number.pl @@ -0,0 +1,35 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use File::Find::Object; +use IO::All; + +my $tree = File::Find::Object->new({}, 'lib/'); + +my $version_n = shift(@ARGV); + +if (!defined($version_n)) +{ + die "Specify version number as an argument! bump-version-number.pl '0.0.1'"; +} + +while (my $r = $tree->next()) { + if ($r =~ m{/\.svn\z}) + { + $tree->prune(); + } + elsif ($r =~ m{\.pm\z}) + { + my @lines = io->file($r)->getlines(); + foreach (@lines) + { + s#(\$VERSION = '|^Version )v?\d+\.\d+(?:\.\d+)?('|)#$1 . $version_n . $2#e; + } + io->file($r)->print( + @lines + ); + } +} + diff --git a/scripts/bump-version-number.pl~ b/scripts/bump-version-number.pl~ new file mode 100644 index 0000000..027153d --- /dev/null +++ b/scripts/bump-version-number.pl~ @@ -0,0 +1,35 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use File::Find::Object; +use IO::All; + +my $tree = File::Find::Object->new({}, 'lib/'); + +my $version_n = shift(@ARGV); + +if (!defined($version_n)) +{ + die "Specify version number as an argument! bump-version-number.pl '0.0.1'"; +} + +while (my $r = $tree->next()) { + if ($r =~ m{/\.svn\z}) + { + $tree->prune(); + } + elsif ($r =~ m{\.pm\z}) + { + my @lines = io->file($r)->getlines(); + foreach (@lines) + { + s#(\$VERSION = '|^Version )\d+\.\d+(?:\.\d+)?('|)#$1 . $version_n . $2#e; + } + io->file($r)->print( + @lines + ); + } +} + diff --git a/scripts/tag-release.pl b/scripts/tag-release.pl new file mode 100644 index 0000000..379737d --- /dev/null +++ b/scripts/tag-release.pl @@ -0,0 +1,29 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use IO::All; + +my ($version) = + (map { m{\$VERSION *= *'([^']+)'} ? ($1) : () } + io->file('lib/File/Find/Object.pm')->getlines() + ) + ; + +if (!defined ($version)) +{ + die "Version is undefined!"; +} + +my $mini_repos_base = 'https://svn.berlios.de/svnroot/repos/web-cpan/XML-Grammar-Fortune'; + +my @cmd = ( + "hg", "tag", "-m", + "Tagging the File-Find-Object release as $version", + "releases/$version", +); + +print join(" ", map { /\s/ ? qq{"$_"} : $_ } @cmd), "\n"; +exec(@cmd); + diff --git a/t/00-compile.t b/t/00-compile.t new file mode 100644 index 0000000..c664541 --- /dev/null +++ b/t/00-compile.t @@ -0,0 +1,60 @@ +use 5.006; +use strict; +use warnings; + +# this test was generated with Dist::Zilla::Plugin::Test::Compile 2.054 + +use Test::More; + +plan tests => 4 + ($ENV{AUTHOR_TESTING} ? 1 : 0); + +my @module_files = ( + 'File/Find/Object.pm', + 'File/Find/Object/Base.pm', + 'File/Find/Object/PathComp.pm', + 'File/Find/Object/Result.pm' +); + + + +# fake home for cpan-testers +use File::Temp; +local $ENV{HOME} = File::Temp::tempdir( CLEANUP => 1 ); + + +my $inc_switch = -d 'blib' ? '-Mblib' : '-Ilib'; + +use File::Spec; +use IPC::Open3; +use IO::Handle; + +open my $stdin, '<', File::Spec->devnull or die "can't open devnull: $!"; + +my @warnings; +for my $lib (@module_files) +{ + # see L + my $stderr = IO::Handle->new; + + my $pid = open3($stdin, '>&STDERR', $stderr, $^X, $inc_switch, '-e', "require q[$lib]"); + binmode $stderr, ':crlf' if $^O eq 'MSWin32'; + my @_warnings = <$stderr>; + waitpid($pid, 0); + is($?, 0, "$lib loaded ok"); + + shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/ + and not eval { require blib; blib->VERSION('1.01') }; + + if (@_warnings) + { + warn @_warnings; + push @warnings, @_warnings; + } +} + + + +is(scalar(@warnings), 0, 'no warnings found') + or diag 'got warnings: ', ( Test::More->can('explain') ? Test::More::explain(\@warnings) : join("\n", '', @warnings) ) if $ENV{AUTHOR_TESTING}; + + diff --git a/t/01ffo.t b/t/01ffo.t new file mode 100644 index 0000000..5ce0213 --- /dev/null +++ b/t/01ffo.t @@ -0,0 +1,66 @@ +#!/usr/bin/perl + +# $Id$ + +use strict; +use warnings; + +use Test::More tests => 4; + +use File::Path qw(rmtree); + +# TEST +use_ok('File::Find::Object', "Can use main File::Find::Object"); + +mkdir('t/dir'); +mkdir('t/dir/a'); +mkdir('t/dir/b'); + +open(my $h, ">", 't/dir/file'); +close($h); + +# symlink does not exists everywhere (windows) +# if it failed, this does not matter +eval { + symlink('.', 't/dir/link'); +}; +my $symlink_created = ($@ eq ""); + +my (@res1, @res2); +my $tree = File::Find::Object->new( + { + callback => sub { + push(@res1, $_[0]); + }, + followlink => 1, + }, + 't/dir' +); + +my @warnings; + +local $SIG{__WARN__} = sub { my $w = shift; push @warnings, $w; }; + +# TEST +ok($tree, "Can get tree object"); + +while (my $r = $tree->next()) { + push(@res2, $r); +} + +# TEST +ok(scalar(@res1) == scalar(@res2), "Get same result from callback and next"); + +# TEST +if ($symlink_created) +{ + like($warnings[0], qr{\AAvoid loop (\S+) => \1\S+?link\r?\n?\z}, + "Avoid loop warning"); +} +else +{ + pass("No symlink."); +} + +# Cleanup +rmtree('t/dir', 0, 1); diff --git a/t/02tree-create.t b/t/02tree-create.t new file mode 100644 index 0000000..cf4364b --- /dev/null +++ b/t/02tree-create.t @@ -0,0 +1,168 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 22; + +BEGIN +{ + use File::Spec; + use lib File::Spec->catdir(File::Spec->curdir(), "t", "lib"); +} + +use File::Path; + +use File::Find::Object::TreeCreate; + +{ + my $t = File::Find::Object::TreeCreate->new(); + + # TEST + ok ($t, "TreeCreate object was initialized"); + + # TEST + is ($t->get_path("./t/file.txt"), File::Spec->catfile(File::Spec->curdir(), "t", "file.txt")); + + # TEST + is ($t->get_path("./t/mydir/"), File::Spec->catdir(File::Spec->curdir(), "t", "mydir")); + + # TEST + is ($t->get_path("./t/hello/there/world.jpg"), File::Spec->catfile(File::Spec->curdir(), "t", "hello", "there", "world.jpg")); + + # TEST + is ($t->get_path("./one/two/three/four/"), File::Spec->catdir(File::Spec->curdir(), "one", "two", "three", "four")); +} + +{ + my $t = File::Find::Object::TreeCreate->new(); + + # TEST + ok ($t->exist("./MANIFEST"), "Checking the exist() method"); + + # TEST + ok (!$t->exist("./BKLASDJASFDJODIJASDOJASODJ.wok"), + "Checking the exist() method"); + + # TEST + ok ($t->is_file("./MANIFEST"), "Checking the is_file method"); + + # TEST + ok (! $t->is_file ("./t"), "Checking the is_file method - 2"); + + # TEST + ok (! $t->is_dir("./MANIFEST"), "Checking the is_dir method - false"); + + # TEST + ok ($t->is_dir ("./t"), "Checking the is_dir method - true"); + + # TEST + is ($t->cat("./t/sample-data/h.txt"), "Hello.", + "Checking the cat method"); + + { + mkdir ($t->get_path("./t/sample-data/tree-create-ls-test")); + mkdir ($t->get_path("./t/sample-data/tree-create-ls-test/a")); + { + open my $out_fh, ">", $t->get_path("./t/sample-data/tree-create-ls-test/b.txt"); + print {$out_fh} "Yowza"; + close ($out_fh); + } + mkdir ($t->get_path("./t/sample-data/tree-create-ls-test/c")); + { + open my $out_fh, ">", $t->get_path("./t/sample-data/tree-create-ls-test/h.xls"); + print {$out_fh} "FooBardom!\n"; + close ($out_fh); + } + # TEST + is_deeply ($t->ls("./t/sample-data/tree-create-ls-test"), + ["a","b.txt","c","h.xls"], + "Testing the ls method", + ); + # Cleanup + rmtree ($t->get_path("./t/sample-data/tree-create-ls-test")); + } + + { + my $tree = + { + 'name' => "tree-create--tree-test-1/", + 'subs' => + [ + { + 'name' => "b.doc", + 'contents' => "This file was spotted in the wild.", + }, + { + 'name' => "a/", + }, + { + 'name' => "foo/", + 'subs' => + [ + { + 'name' => "yet/", + }, + ], + }, + ], + }; + + $t->create_tree("./t/sample-data/", $tree); + + # TEST + is_deeply ($t->ls("./t/sample-data/tree-create--tree-test-1"), + ["a", "b.doc", "foo"], + "Testing the contents of the root tree" + ); + + # TEST + ok ($t->is_dir("./t/sample-data/tree-create--tree-test-1/a"), + "a is a dir" + ); + + # TEST + is_deeply ($t->ls("./t/sample-data/tree-create--tree-test-1/a"), + [], + "Testing the contents of a" + ); + + # TEST + is_deeply ($t->ls("./t/sample-data/tree-create--tree-test-1/foo"), + ["yet"], + "Testing the contents of foo" + ); + + # TEST + ok ($t->is_dir("./t/sample-data/tree-create--tree-test-1/foo/yet"), + "Testing that foo/yet is a dir" + ); + + # TEST + is_deeply ($t->ls("./t/sample-data/tree-create--tree-test-1/foo/yet"), + [], + "Testing that foo/yet is a dir" + ); + + # TEST + ok ($t->is_file("./t/sample-data/tree-create--tree-test-1/b.doc"), + "Checking that b.doc is a file" + ); + + # TEST + is ($t->cat("./t/sample-data/tree-create--tree-test-1/b.doc"), + "This file was spotted in the wild.", + "Checking for contents of b.doc" + ); + + # Cleanup + rmtree ($t->get_path("./t/sample-data/tree-create--tree-test-1")); + } + { + # TEST + is ($t->get_path("s/hello"), File::Spec->catfile("s", "hello"), + "Bug that eliminated ^[AnyChar]/ instead of ^\\./" + ); + } +} + diff --git a/t/03traverse.t b/t/03traverse.t new file mode 100644 index 0000000..b96daa2 --- /dev/null +++ b/t/03traverse.t @@ -0,0 +1,749 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 46; + +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--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--traverse-1") + ); + my @results; + for my $i (1 .. 6) + { + push @results, $ff->next(); + } + # TEST + is_deeply( + \@results, + [(map { $t->get_path("t/sample-data/traverse--traverse-1/$_") } + ("", qw( + a + b.doc + foo + foo/yet + ))), + undef + ], + "Checking for regular, lexicographically sorted order", + ); + + rmtree($t->get_path("./t/sample-data/traverse--traverse-1")); +} + +{ + my $test_id = "traverse--traverse-dirs-and-files"; + my $test_dir = "t/sample-data/$test_id"; + my $tree = + { + 'name' => "$test_id/", + 'subs' => + [ + { + 'name' => "a/", + subs => + [ + { + 'name' => "b.doc", + 'contents' => "This file was spotted in the wild.", + }, + ], + }, + { + 'name' => "foo/", + 'subs' => + [ + { + 'name' => "t.door.txt", + 'contents' => "A T Door", + }, + { + '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("./$test_dir/a/b.doc"), + $t->get_path("./$test_dir/foo"), + ); + my @results; + for my $i (1 .. 5) + { + push @results, $ff->next(); + } + # TEST + is_deeply( + \@results, + [(map { $t->get_path("$test_dir/$_") } + (qw( + a/b.doc + foo + foo/t.door.txt + foo/yet + ))), + undef + ], + "Checking that one can traverse regular files.", + ); + + rmtree($t->get_path("./$test_dir")) +} + +{ + my $test_id = "traverse--dont-traverse-non-existing-files"; + my $test_dir = "t/sample-data/$test_id"; + my $tree = + { + 'name' => "$test_id/", + 'subs' => + [ + { + 'name' => "a/", + subs => + [ + { + 'name' => "b.doc", + 'contents' => "This file was spotted in the wild.", + }, + ], + }, + { + 'name' => "c/", + subs => + [ + { + 'name' => "d.doc", + 'contents' => "This file was spotted in the wild.", + }, + ], + }, + + { + 'name' => "foo/", + 'subs' => + [ + { + 'name' => "yet/", + }, + ], + }, + { + 'name' => "bar/", + 'subs' => + [ + { + name => "myfile.txt", + content => "Hello World", + }, + { + 'name' => "zamda/", + }, + ], + }, + { + 'name' => "daps/", + }, + ], + }; + + my $t = File::Find::Object::TreeCreate->new(); + $t->create_tree("./t/sample-data/", $tree); + my $ff = + File::Find::Object->new( + {}, + $t->get_path("./$test_dir/foo"), + $t->get_path("./$test_dir/a/non-exist"), + $t->get_path("./$test_dir/bar"), + $t->get_path("./$test_dir/b/non-exist"), + $t->get_path("./$test_dir/daps"), + ); + my @results; + for my $i (1 .. 7) + { + push @results, $ff->next(); + } + # TEST + is_deeply( + \@results, + [(map { $t->get_path("$test_dir/$_") } + (qw( + foo + foo/yet + bar + bar/myfile.txt + bar/zamda + daps + ))), + undef + ], + "Checking that we skip non-existent paths", + ); + + rmtree($t->get_path("./$test_dir")) +} + +{ + my $test_id = "traverse--handle-non-accessible-dirs-gracefully"; + my $test_dir = "t/sample-data/$test_id"; + my $tree = + { + 'name' => "$test_id/", + 'subs' => + [ + { + 'name' => "a/", + subs => + [ + { + 'name' => "b.doc", + 'contents' => "This file was spotted in the wild.", + }, + ], + }, + { + 'name' => "c/", + subs => + [ + { + 'name' => "d.doc", + 'contents' => "This file was spotted in the wild.", + }, + ], + }, + + { + 'name' => "foo/", + 'subs' => + [ + { + 'name' => "yet/", + }, + ], + }, + { + 'name' => "bar/", + 'subs' => + [ + { + name => "myfile.txt", + content => "Hello World", + }, + { + 'name' => "zamda/", + }, + ], + }, + { + 'name' => "daps/", + }, + ], + }; + + my $t = File::Find::Object::TreeCreate->new(); + $t->create_tree("./t/sample-data/", $tree); + chmod (0000, $t->get_path("$test_dir/bar")); + eval + { + my $ff = File::Find::Object->new({}, $t->get_path("$test_dir")); + + my @results; + while (defined(my $result = $ff->next())) + { + push @results, $result; + } + # TEST + ok (scalar(grep { $_ eq $t->get_path("$test_dir/a")} @results), + "Found /a", + ); + }; + # TEST + is ($@, "", "Handle non-accessible directories gracefully"); + + chmod (0755, $t->get_path("$test_dir/bar")); + rmtree($t->get_path("./$test_dir")) +} + +{ + my $tree = + { + 'name' => "traverse--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--traverse-1") + ); + + { + my $r = $ff->next_obj(); + + # TEST + is ($r->path(), $t->get_path("t/sample-data/traverse--traverse-1/"), "Path"); + + # TEST + is ($r->base(), $t->get_path("./t/sample-data/traverse--traverse-1"), "Base"); + + # TEST + is_deeply ($r->dir_components(), [], "Dir_Components are empty"); + + # TEST + 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"); + } + + { + my $r = $ff->next_obj(); + + # TEST + is ($r->path(), $t->get_path("t/sample-data/traverse--traverse-1/a"), "Path"); + + # TEST + is ($r->base(), $t->get_path("./t/sample-data/traverse--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--traverse-1/b.doc"), "Path"); + + # TEST + is ($r->base(), $t->get_path("./t/sample-data/traverse--traverse-1"), "Base"); + + # TEST + is_deeply ($r->dir_components(), [], "Dir_Components are empty"); + + # 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)], + "Full components are 'b.doc'" + ); + + # TEST + is ($r->basename(), "b.doc", "Basename is 'b.doc'"); + } + + { + my $r = $ff->next_obj(); + + # TEST + is ($r->path(), $t->get_path("t/sample-data/traverse--traverse-1/foo"), "Path"); + + # TEST + is ($r->base(), $t->get_path("./t/sample-data/traverse--traverse-1"), "Base"); + + # TEST + is_deeply ($r->dir_components(), [qw(foo)], + "Dir_Components are 'foo'" + ); + + # TEST + ok ($r->is_dir(), "Is a directory"); + + # TEST + is_deeply ($r->full_components(), [qw(foo)], + "Full components are 'foo'" + ); + } + + { + my $r = $ff->next_obj(); + + # TEST + is ($r->path(), $t->get_path("t/sample-data/traverse--traverse-1/foo/file.txt"), + "Path", + ); + + # TEST + is ($r->base(), $t->get_path("./t/sample-data/traverse--traverse-1"), + "Base" + ); + + # TEST + is_deeply ($r->dir_components(), [qw(foo)], + "Dir_Components are 'foo'" + ); + + # TEST + ok (!$r->is_dir(), "Not a directory"); + + # TEST + is_deeply ($r->full_components(), [qw(foo file.txt)], + "Full components are 'foo/file.txt'" + ); + + # TEST + is ($r->basename(), "file.txt", "Basename is 'file.txt'"); + } + + { + my $r = $ff->next_obj(); + + # TEST + is ($r->path(), $t->get_path("t/sample-data/traverse--traverse-1/foo/yet"), + "Path", + ); + + # TEST + is ($r->base(), $t->get_path("./t/sample-data/traverse--traverse-1"), "Base"); + + # TEST + is_deeply ($r->dir_components(), [qw(foo yet)], + "Dir_Components are 'foo/yet'" + ); + + # TEST + ok ($r->is_dir(), "Is a directory"); + + # TEST + is_deeply ($r->full_components(), [qw(foo yet)], + "Full components are 'foo/yet'" + ); + } + + { + my $r = $ff->next_obj(); + + # TEST + ok (!defined($r), "Last result is undef"); + } + + undef ($ff); + + rmtree($t->get_path("./t/sample-data/traverse--traverse-1")) +} + +{ + my $tree = + { + 'name' => "traverse--traverse-1/", + 'subs' => + [ + { + 'name' => "0/", + }, + { + 'name' => "foo/", + 'subs' => + [ + { + 'name' => "0", + 'contents' => "Zero file", + }, + { + 'name' => "1", + 'contents' => "One file", + }, + { + 'name' => "2", + 'contents' => "Two file", + }, + + + ], + }, + ], + }; + + 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--traverse-1") + ); + + my @results; + for my $i (1 .. 7) + { + push @results, $ff->next(); + } + + # TEST + is_deeply( + \@results, + [(map { $t->get_path("t/sample-data/traverse--traverse-1/$_") } + sort {$a cmp $b } + ("", qw( + 0 + foo + foo/0 + foo/1 + foo/2 + ))), + undef + ], + "Checking that files named '0' are correctly scanned", + ); + + rmtree($t->get_path("./t/sample-data/traverse--traverse-1")); +} + +{ + my $tree = + { + 'name' => "traverse--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; + my $callback = sub { + my $path = shift; + + my $path_obj = $ff->item_obj(); + + # TEST + ok ($path_obj, "Path object is defined."); + + # TEST + is_deeply($path_obj->full_components(), + [], + "Path empty." + ); + + # TEST + ok ($path_obj->is_dir(), "Path object is a directory"); + }; + + $ff = + File::Find::Object->new( + {callback => $callback}, + $t->get_path("./t/sample-data/traverse--traverse-1") + ); + + my @results; + + # Call $ff->next() and do the tests in $callback . + push @results, $ff->next(); + + rmtree($t->get_path("./t/sample-data/traverse--traverse-1")); +} + +{ + my $tree = + { + 'name' => "traverse--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( + {nocrossfs => 1,}, + $t->get_path("./t/sample-data/traverse--traverse-1") + ); + my @results; + for my $i (1 .. 6) + { + push @results, $ff->next(); + } + # TEST + is_deeply( + \@results, + [(map { $t->get_path("t/sample-data/traverse--traverse-1/$_") } + ("", qw( + a + b.doc + foo + foo/yet + ))), + undef + ], + "Testing nocrossfs", + ); + + rmtree($t->get_path("./t/sample-data/traverse--traverse-1")); +} + +{ + my $tree = + { + 'name' => "traverse--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--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--traverse-1/$_") } + (qw(b.doc foo/file.txt)) + ], + "Checking for regular, lexicographically sorted order", + ); + + rmtree($t->get_path("./t/sample-data/traverse--traverse-1")) +} diff --git a/t/04destroy.t b/t/04destroy.t new file mode 100644 index 0000000..481bdf7 --- /dev/null +++ b/t/04destroy.t @@ -0,0 +1,98 @@ +#!/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' => "destroy--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/destroy--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/destroy--traverse-1/$_") } + ("", qw( + a + b.doc + foo + foo/yet + ))), + undef + ], + "Checking for regular, lexicographically sorted order", + ); + + rmtree($t->get_path("./t/sample-data/destroy--traverse-1")) +} +# TEST +is ($destroy_counter, 1, + "Check that the object was destroyed when it goes out of scope." +); + diff --git a/t/05prune.t b/t/05prune.t new file mode 100644 index 0000000..72d14cb --- /dev/null +++ b/t/05prune.t @@ -0,0 +1,242 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 4; + +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' => "prune--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/prune--traverse-2") + ); + my @results; + for my $i (1 .. 7) + { + my $file = $ff->next(); + # We're doing that because get_current_node_files_list() used to + # call ->_recurse() which caused some subtle bugs. + my $files_in_node = $ff->get_current_node_files_list(); + + if ($file eq + $t->get_path("t/sample-data/prune--traverse-2/foo/please-prune-me") + ) + { + $ff->set_traverse_to( + [ + grep { $_ !~ /non-reachable/ } + @{$ff->get_current_node_files_list()} + ] + ); + + # TEST + is_deeply ($ff->get_traverse_to(), ["h.rnd", "lambda.calculus"], + "Testing ->get_traverse_to()" + ); + } + push @results, $file; + } + # TEST + is_deeply( + \@results, + [(map { $t->get_path("t/sample-data/prune--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/prune--traverse-2")) +} + +{ + my $tree = + { + 'name' => "prune--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))' + }, + ], + }, + { + 'name' => "zardoz/", + 'subs' => + [ + { + 'name' => "p.txt", + 'contents' => "Intentionally Left Boring.", + }, + ], + }, + ], + }, + { + 'name' => "zardoz/", + 'subs' => + [ + { + 'name' => "p.txt", + 'contents' => "Intentionally Left Boring.", + }, + ], + }, + + ], + }; + + 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/prune--traverse-2") + ); + my @results; + for my $i (1 .. 9) + { + my $file = $ff->next(); + if ($file eq + $t->get_path("t/sample-data/prune--traverse-2/foo/please-prune-me") + ) + { + $ff->prune(); + } + push @results, $file; + } + + # TEST + ok (!defined($ff->next()), "Testing that the scan has completed."); + + # TEST + is_deeply( + \@results, + [(map { $t->get_path("t/sample-data/prune--traverse-2/$_") } + ("", + qw( + a + b.doc + foo + foo/please-prune-me + foo/zardoz + foo/zardoz/p.txt + zardoz + zardoz/p.txt + ))) + ], + "Checking for regular, lexicographically sorted order", + ); + + rmtree($t->get_path("./t/sample-data/prune--traverse-2")) +} diff --git a/t/06trailing-slash.t b/t/06trailing-slash.t new file mode 100644 index 0000000..e909449 --- /dev/null +++ b/t/06trailing-slash.t @@ -0,0 +1,32 @@ +#!/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; + +use File::Path; + +{ + my $ff = + File::Find::Object->new( + {}, + "t/", + ); + + my @results; + push @results, $ff->next(); + + # TEST + is_deeply(\@results, ["t"], + "t has no trailing slash" + ); +} diff --git a/t/author-pod-coverage.t b/t/author-pod-coverage.t new file mode 100644 index 0000000..094d8f5 --- /dev/null +++ b/t/author-pod-coverage.t @@ -0,0 +1,15 @@ +#!perl + +BEGIN { + unless ($ENV{AUTHOR_TESTING}) { + require Test::More; + Test::More::plan(skip_all => 'these tests are for testing by the author'); + } +} + +# This file was automatically generated by Dist::Zilla::Plugin::PodCoverageTests. + +use Test::Pod::Coverage 1.08; +use Pod::Coverage::TrustPod; + +all_pod_coverage_ok({ coverage_class => 'Pod::Coverage::TrustPod' }); diff --git a/t/author-pod-syntax.t b/t/author-pod-syntax.t new file mode 100644 index 0000000..35fb1b9 --- /dev/null +++ b/t/author-pod-syntax.t @@ -0,0 +1,15 @@ +#!perl + +BEGIN { + unless ($ENV{AUTHOR_TESTING}) { + require Test::More; + Test::More::plan(skip_all => 'these tests are for testing by the author'); + } +} + +# This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. +use strict; use warnings; +use Test::More; +use Test::Pod 1.41; + +all_pod_files_ok(); diff --git a/t/lib/File/Find/Object/TreeCreate.pm b/t/lib/File/Find/Object/TreeCreate.pm new file mode 100644 index 0000000..81b8589 --- /dev/null +++ b/t/lib/File/Find/Object/TreeCreate.pm @@ -0,0 +1,122 @@ +package File::Find::Object::TreeCreate; + +use strict; +use warnings; + +use File::Spec; + +sub new +{ + my $class = shift; + my $self = {}; + bless $self, $class; + $self->_initialize(@_); + return $self; +} + +sub _initialize +{ +} + +sub get_path +{ + my $self = shift; + my $path = shift; + + my @components; + + if ($path =~ s{^\./}{}) + { + push @components, File::Spec->curdir(); + } + + my $is_dir = ($path =~ s{/$}{}); + push @components, split(/\//, $path); + if ($is_dir) + { + return File::Spec->catdir(@components); + } + else + { + return File::Spec->catfile(@components); + } +} + +sub exist +{ + my $self = shift; + return (-e $self->get_path(@_)); +} + +sub is_file +{ + my $self = shift; + return (-f $self->get_path(@_)); +} + +sub is_dir +{ + my $self = shift; + return (-d $self->get_path(@_)); +} + +sub cat +{ + my $self = shift; + open my $in, "<", $self->get_path(@_) or + return 0; + my $data; + { + local $/; + $data = <$in>; + } + close($in); + return $data; +} + +sub ls +{ + my $self = shift; + opendir my $dir, $self->get_path(@_) or + return undef; + my @files = + sort { $a cmp $b } + grep { !(($_ eq ".") || ($_ eq "..")) } + readdir($dir); + closedir($dir); + return \@files; +} + +sub create_tree +{ + my ($self, $unix_init_path, $tree) = @_; + my $real_init_path = $self->get_path($unix_init_path); + return $self->_real_create_tree($real_init_path, $tree); +} + +sub _real_create_tree +{ + my ($self, $init_path, $tree) = @_; + my $name = $tree->{'name'}; + if ($name =~ s{/$}{}) + { + my $dir_name = File::Spec->catfile($init_path, $name); + mkdir($dir_name); + if (exists($tree->{'subs'})) + { + foreach my $sub (@{$tree->{'subs'}}) + { + $self->_real_create_tree($dir_name, $sub); + } + } + } + else + { + open my $out, ">", File::Spec->catfile($init_path, $name); + print {$out} +(exists($tree->{'contents'}) ? $tree->{'contents'} : ""); + close($out); + } + return 0; +} +1; + diff --git a/t/release-cpan-changes.t b/t/release-cpan-changes.t new file mode 100644 index 0000000..214650f --- /dev/null +++ b/t/release-cpan-changes.t @@ -0,0 +1,19 @@ +#!perl + +BEGIN { + unless ($ENV{RELEASE_TESTING}) { + require Test::More; + Test::More::plan(skip_all => 'these tests are for release candidate testing'); + } +} + + +use strict; +use warnings; + +use Test::More 0.96 tests => 2; +use_ok('Test::CPAN::Changes'); +subtest 'changes_ok' => sub { + changes_file_ok('Changes'); +}; +done_testing(); diff --git a/t/release-kwalitee.t b/t/release-kwalitee.t new file mode 100644 index 0000000..e641ee8 --- /dev/null +++ b/t/release-kwalitee.t @@ -0,0 +1,19 @@ +#!perl + +BEGIN { + unless ($ENV{RELEASE_TESTING}) { + require Test::More; + Test::More::plan(skip_all => 'these tests are for release candidate testing'); + } +} + + +# This test is generated by Dist::Zilla::Plugin::Test::Kwalitee::Extra +use strict; +use warnings; +use Test::More; # needed to provide plan. + +eval { require Test::Kwalitee::Extra }; +plan skip_all => "Test::Kwalitee::Extra required for testing kwalitee: $@" if $@; + +eval "use Test::Kwalitee::Extra"; diff --git a/t/release-trailing-space.t b/t/release-trailing-space.t new file mode 100644 index 0000000..55df58a --- /dev/null +++ b/t/release-trailing-space.t @@ -0,0 +1,38 @@ +#!perl + +BEGIN { + unless ($ENV{RELEASE_TESTING}) { + require Test::More; + Test::More::plan(skip_all => 'these tests are for release candidate testing'); + } +} + + +use strict; +use warnings; + +use Test::More; + +eval "use Test::TrailingSpace"; +if ($@) +{ + plan skip_all => "Test::TrailingSpace required for trailing space test."; +} +else +{ + plan tests => 1; +} + +# TODO: add .pod, .PL, the README/Changes/TODO/etc. documents and possibly +# some other stuff. +my $finder = Test::TrailingSpace->new( + { + root => '.', + filename_regex => qr#(?:\.(?:t|pm|pl|xs|c|h|txt|pod|PL)|README|Changes|TODO|LICENSE)\z#, + }, +); + +# TEST +$finder->no_trailing_space( + "No trailing space was found." +); diff --git a/t/sample-data/h.txt b/t/sample-data/h.txt new file mode 100644 index 0000000..63af512 --- /dev/null +++ b/t/sample-data/h.txt @@ -0,0 +1 @@ +Hello. \ No newline at end of file diff --git a/weaver.ini b/weaver.ini new file mode 100644 index 0000000..228ad8e --- /dev/null +++ b/weaver.ini @@ -0,0 +1,39 @@ +[@CorePrep] + +[-SingleEncoding] + +[Generic / NAME] + +[Version] + +[Region / prelude] + + +[Generic / SYNOPSIS] +[Generic / DESCRIPTION] +[Generic / OVERVIEW] + +[Collect / ATTRIBUTES] +command = attr + +[Collect / METHODS] +command = method + +[Leftovers] + +[Region / postlude] + +[Authors] +[Legal] + +; [Generic / DESCRIPTION] +; required = 1 + +; [Generic / BUGS] + +; [Generic / Section::Bugs] +; [Generic / Section::License] +; +[Bugs] +[Support] +all_modules = 1