Hello community, here is the log from the commit of package perl-Path-Class for openSUSE:Factory checked in at 2013-06-11 07:30:42 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/perl-Path-Class (Old) and /work/SRC/openSUSE:Factory/.perl-Path-Class.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Path-Class" Changes: -------- --- /work/SRC/openSUSE:Factory/perl-Path-Class/perl-Path-Class.changes 2012-05-31 17:08:53.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.perl-Path-Class.new/perl-Path-Class.changes 2013-06-11 09:35:57.000000000 +0200 @@ -1,0 +2,55 @@ +Sun Jun 9 14:52:47 UTC 2013 - [email protected] + +- updated to 0.32 + - Updated dependency on File::Spec to 3.26, fixing RT #83143. + + - Fixed bug with leading empty string in dir() - became unintentional + UNC path on Cygwin. [David Golden and [email protected]] + + - Fixed "Unterminated C<...> sequence" in Pod. [Olaf Alders] + + 0.31 Tue Feb 5 11:51:59 CST 2013 + + - Optimization: stringify variables passed to canonpath [David Golden] + + - Optimization: Use internal guts when constructing Dirs from + Dirs, instead of concatenating and splitting them again with + File::Spec. [David Golden] + + - Fix grammar error in docs. [Karen Etheridge] + + - Implement a 'split' parameter for the slurp() method [suggested by Yanick Champoux] + + - In docs, replace unicode MINUS SIGN with ascii HYPHEN-MINUS [Randy Stauner] + + 0.29 Mon Dec 17 23:55:07 CST 2012 + + - Add components() method, which returns directory names (and + filename, if this is a File object) as a list. + + - Fix a test failure on non-Unix platforms, the 07-recurseprune.t + test was written in a Unix-specific way. + + 0.28 Sat Dec 15 21:40:17 CST 2012 + + - Fix test failures when run as root - they were relying on + permissions failures, but permissions never fail as root. [Spotted + by AAR and Chris Williams] + + - Add links in docs to the other modules we rely on & talk about in + the docs. Makes for easier viewing through search.cpan.org / + MetaCPAN. [David Precious] + + - Fixed some misleading variable names in docs. [RT#81795] [Pau Amma] + + 0.27 Sat Dec 8 19:24:15 CST 2012 + + - Added pruning support in dir->recurse(). If recurse callback + returns $item->PRUNE, no children of this item will be + analyzed. [Marcin Kasperski] + + - Documented 'basename' method for directories. [Fabrice Gabolde] + + - Added traverse_if() function, which allows one to filter children + +------------------------------------------------------------------- Old: ---- Path-Class-0.25.tar.gz New: ---- Path-Class-0.32.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ perl-Path-Class.spec ++++++ --- /var/tmp/diff_new_pack.t9IVjz/_old 2013-06-11 09:35:57.000000000 +0200 +++ /var/tmp/diff_new_pack.t9IVjz/_new 2013-06-11 09:35:57.000000000 +0200 @@ -1,7 +1,7 @@ # # spec file for package perl-Path-Class # -# Copyright (c) 2012 SUSE LINUX Products GmbH, Nuernberg, Germany. +# Copyright (c) 2013 SUSE LINUX Products GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -17,7 +17,7 @@ Name: perl-Path-Class -Version: 0.25 +Version: 0.32 Release: 0 %define cpan_name Path-Class Summary: Cross-platform path specification manipulation @@ -29,11 +29,13 @@ BuildRoot: %{_tmppath}/%{name}-%{version}-build BuildRequires: perl BuildRequires: perl-macros -BuildRequires: perl(Module::Build) +BuildRequires: perl(File::Spec) >= 3.26 +BuildRequires: perl(Module::Build) >= 0.3601 #BuildRequires: perl(Path::Class) #BuildRequires: perl(Path::Class::Dir) #BuildRequires: perl(Path::Class::Entity) #BuildRequires: perl(Path::Class::File) +Requires: perl(File::Spec) >= 3.26 %{perl_requires} %description @@ -43,10 +45,10 @@ manner. It supports pretty much every platform Perl runs on, including Unix, Windows, Mac, VMS, Epoc, Cygwin, OS/2, and NetWare. -The well-known module 'File::Spec' also provides this service, but it's -sort of awkward to use well, so people sometimes avoid it, or use it in a -way that won't actually work properly on platforms significantly different -than the ones they've tested their code on. +The well-known module the File::Spec manpage also provides this service, +but it's sort of awkward to use well, so people sometimes avoid it, or use +it in a way that won't actually work properly on platforms significantly +different than the ones they've tested their code on. In fact, 'Path::Class' uses 'File::Spec' internally, wrapping all the unsightly details so you can concentrate on your application code. Whereas @@ -80,9 +82,9 @@ you use 'Path::Class', your file and directory objects will know what volumes they refer to and do the right thing. -The guts of the 'Path::Class' code live in the 'Path::Class::File' and -'Path::Class::Dir' modules, so please see those modules' documentation for -more details about how to use them. +The guts of the 'Path::Class' code live in the the Path::Class::File +manpage and the Path::Class::Dir manpage modules, so please see those +modules' documentation for more details about how to use them. %prep %setup -q -n %{cpan_name}-%{version} ++++++ Path-Class-0.25.tar.gz -> Path-Class-0.32.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Path-Class-0.25/Build.PL new/Path-Class-0.32/Build.PL --- old/Path-Class-0.25/Build.PL 2012-02-16 03:56:28.000000000 +0100 +++ new/Path-Class-0.32/Build.PL 2013-03-19 02:55:05.000000000 +0100 @@ -21,7 +21,7 @@ "Ken Williams <kwilliams\@cpan.org>" ], "dist_name" => "Path-Class", - "dist_version" => "0.25", + "dist_version" => "0.32", "license" => "perl", "module_name" => "Path::Class", "recommends" => {}, @@ -31,11 +31,12 @@ "Cwd" => 0, "Exporter" => 0, "File::Path" => 0, - "File::Spec" => "0.87", + "File::Spec" => "3.26", "File::Temp" => 0, "File::stat" => 0, "IO::Dir" => 0, "IO::File" => 0, + "Scalar::Util" => 0, "base" => 0, "overload" => 0, "strict" => 0 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Path-Class-0.25/Changes new/Path-Class-0.32/Changes --- old/Path-Class-0.25/Changes 2012-02-16 03:56:28.000000000 +0100 +++ new/Path-Class-0.32/Changes 2013-03-19 02:55:05.000000000 +0100 @@ -1,5 +1,72 @@ Revision history for Perl extension Path::Class. +0.32 Mon Mar 18 20:53:00 CDT 2013 + + - Updated dependency on File::Spec to 3.26, fixing RT #83143. + + - Fixed bug with leading empty string in dir() - became unintentional + UNC path on Cygwin. [David Golden and [email protected]] + + - Fixed "Unterminated C<...> sequence" in Pod. [Olaf Alders] + +0.31 Tue Feb 5 11:51:59 CST 2013 + + - Optimization: stringify variables passed to canonpath [David Golden] + + - Optimization: Use internal guts when constructing Dirs from + Dirs, instead of concatenating and splitting them again with + File::Spec. [David Golden] + + - Fix grammar error in docs. [Karen Etheridge] + + - Implement a 'split' parameter for the slurp() method [suggested by Yanick Champoux] + + - In docs, replace unicode MINUS SIGN with ascii HYPHEN-MINUS [Randy Stauner] + +0.29 Mon Dec 17 23:55:07 CST 2012 + + - Add components() method, which returns directory names (and + filename, if this is a File object) as a list. + + - Fix a test failure on non-Unix platforms, the 07-recurseprune.t + test was written in a Unix-specific way. + +0.28 Sat Dec 15 21:40:17 CST 2012 + + - Fix test failures when run as root - they were relying on + permissions failures, but permissions never fail as root. [Spotted + by AAR and Chris Williams] + + - Add links in docs to the other modules we rely on & talk about in + the docs. Makes for easier viewing through search.cpan.org / + MetaCPAN. [David Precious] + + - Fixed some misleading variable names in docs. [RT#81795] [Pau Amma] + +0.27 Sat Dec 8 19:24:15 CST 2012 + + - Added pruning support in dir->recurse(). If recurse callback + returns $item->PRUNE, no children of this item will be + analyzed. [Marcin Kasperski] + + - Documented 'basename' method for directories. [Fabrice Gabolde] + + - Added traverse_if() function, which allows one to filter children + before processing them. [Marcin Kasperski] + + - Added tempdir() function. [cho45] + +0.26 Thu Jun 14 21:52:38 CDT 2012 + + - resolve() now includes the name of the non-existent file in the error + message. [Karen Etheridge] + + - new shortcut opena(), to open a file for appending. [Karen Etheridge] + + - new spew() method that does the inverse of the slurp() method. [Aran Deltac] + + - Fixed a typo in a class name in the docs for Path::Class::Entity. [Toby Inkster] + 0.25 Wed Feb 15 20:55:30 CST 2012 - resolve() now croak()s instead of die()s on non-existent file. [Danijel Tašov] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Path-Class-0.25/LICENSE new/Path-Class-0.32/LICENSE --- old/Path-Class-0.25/LICENSE 2012-02-16 03:56:28.000000000 +0100 +++ new/Path-Class-0.32/LICENSE 2013-03-19 02:55:05.000000000 +0100 @@ -1,4 +1,4 @@ -This software is copyright (c) 2012 by Ken Williams. +This software is copyright (c) 2013 by Ken Williams. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. @@ -12,7 +12,7 @@ --- The GNU General Public License, Version 1, February 1989 --- -This software is Copyright (c) 2012 by Ken Williams. +This software is Copyright (c) 2013 by Ken Williams. This is free software, licensed under: @@ -272,7 +272,7 @@ --- The Artistic License 1.0 --- -This software is Copyright (c) 2012 by Ken Williams. +This software is Copyright (c) 2013 by Ken Williams. This is free software, licensed under: diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Path-Class-0.25/MANIFEST new/Path-Class-0.32/MANIFEST --- old/Path-Class-0.25/MANIFEST 2012-02-16 03:56:28.000000000 +0100 +++ new/Path-Class-0.32/MANIFEST 2013-03-19 02:55:05.000000000 +0100 @@ -6,6 +6,7 @@ META.yml Makefile.PL README +README.pod SIGNATURE dist.ini lib/Path/Class.pm @@ -17,4 +18,6 @@ t/03-filesystem.t t/04-subclass.t t/05-traverse.t +t/06-traverse_filt.t +t/07-recurseprune.t t/author-critic.t diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Path-Class-0.25/META.yml new/Path-Class-0.32/META.yml --- old/Path-Class-0.25/META.yml 2012-02-16 03:56:28.000000000 +0100 +++ new/Path-Class-0.32/META.yml 2013-03-19 02:55:05.000000000 +0100 @@ -11,7 +11,7 @@ ExtUtils::MakeMaker: 6.30 Module::Build: 0.3601 dynamic_config: 0 -generated_by: 'Dist::Zilla version 4.300002, CPAN::Meta::Converter version 2.112150' +generated_by: 'Dist::Zilla version 4.300028, CPAN::Meta::Converter version 2.120921' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html @@ -22,15 +22,16 @@ Cwd: 0 Exporter: 0 File::Path: 0 - File::Spec: 0.87 + File::Spec: 3.26 File::Temp: 0 File::stat: 0 IO::Dir: 0 IO::File: 0 + Scalar::Util: 0 base: 0 overload: 0 strict: 0 resources: bugtracker: http://rt.cpan.org/Public/Dist/Display.html?Name=Path-Class repository: git://github.com/kenahoo/Path-Class.git -version: 0.25 +version: 0.32 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Path-Class-0.25/Makefile.PL new/Path-Class-0.32/Makefile.PL --- old/Path-Class-0.25/Makefile.PL 2012-02-16 03:56:28.000000000 +0100 +++ new/Path-Class-0.32/Makefile.PL 2013-03-19 02:55:05.000000000 +0100 @@ -30,16 +30,17 @@ "Cwd" => 0, "Exporter" => 0, "File::Path" => 0, - "File::Spec" => "0.87", + "File::Spec" => "3.26", "File::Temp" => 0, "File::stat" => 0, "IO::Dir" => 0, "IO::File" => 0, + "Scalar::Util" => 0, "base" => 0, "overload" => 0, "strict" => 0 }, - "VERSION" => "0.25", + "VERSION" => "0.32", "test" => { "TESTS" => "t/*.t" } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Path-Class-0.25/README new/Path-Class-0.32/README --- old/Path-Class-0.25/README 2012-02-16 03:56:28.000000000 +0100 +++ new/Path-Class-0.32/README 2013-03-19 02:55:05.000000000 +0100 @@ -1,11 +1,11 @@ This archive contains the distribution Path-Class, -version 0.25: +version 0.32: Cross-platform path specification manipulation -This software is copyright (c) 2012 by Ken Williams. +This software is copyright (c) 2013 by Ken Williams. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Path-Class-0.25/README.pod new/Path-Class-0.32/README.pod --- old/Path-Class-0.25/README.pod 1970-01-01 01:00:00.000000000 +0100 +++ new/Path-Class-0.32/README.pod 2013-03-19 02:55:05.000000000 +0100 @@ -0,0 +1,165 @@ + +=head1 NAME + +Path::Class - Cross-platform path specification manipulation for Perl + +=head1 SYNOPSIS + + use Path::Class; + + my $dir = dir('foo', 'bar'); # Path::Class::Dir object + my $file = file('bob', 'file.txt'); # Path::Class::File object + + # Stringifies to 'foo/bar' on Unix, 'foo\bar' on Windows, etc. + print "dir: $dir\n"; + + # Stringifies to 'bob/file.txt' on Unix, 'bob\file.txt' on Windows + print "file: $file\n"; + + my $subdir = $dir->subdir('baz'); # foo/bar/baz + my $parent = $subdir->parent; # foo/bar + my $parent2 = $parent->parent; # foo + + my $dir2 = $file->dir; # bob + + # Work with foreign paths + use Path::Class qw(foreign_file foreign_dir); + my $file = foreign_file('Mac', ':foo:file.txt'); + print $file->dir; # :foo: + print $file->as_foreign('Win32'); # foo\file.txt + + # Interact with the underlying filesystem: + + # $dir_handle is an IO::Dir object + my $dir_handle = $dir->open or die "Can't read $dir: $!"; + + # $file_handle is an IO::File object + my $file_handle = $file->open($mode) or die "Can't read $file: $!"; + +=head1 DESCRIPTION + +C<Path::Class> is a module for manipulation of file and directory +specifications (strings describing their locations, like +C<'/home/ken/foo.txt'> or C<'C:\Windows\Foo.txt'>) in a cross-platform +manner. It supports pretty much every platform Perl runs on, +including Unix, Windows, Mac, VMS, Epoc, Cygwin, OS/2, and NetWare. + +The well-known module L<File::Spec> also provides this service, but +it's sort of awkward to use well, so people sometimes avoid it, or use +it in a way that won't actually work properly on platforms +significantly different than the ones they've tested their code on. + +In fact, C<Path::Class> uses C<File::Spec> internally, wrapping all +the unsightly details so you can concentrate on your application code. +Whereas C<File::Spec> provides functions for some common path +manipulations, C<Path::Class> provides an object-oriented model of the +world of path specifications and their underlying semantics. +C<File::Spec> doesn't create any objects, and its classes represent +the different ways in which paths must be manipulated on various +platforms (not a very intuitive concept). C<Path::Class> creates +objects representing files and directories, and provides methods that +relate them to each other. For instance, the following C<File::Spec> +code: + + my $absolute = File::Spec->file_name_is_absolute( + File::Spec->catfile( @dirs, $file ) + ); + +can be written using C<Path::Class> as + + my $absolute = Path::Class::File->new( @dirs, $file )->is_absolute; + +or even as + + my $absolute = file( @dirs, $file )->is_absolute; + +Similar readability improvements should happen all over the place when +using C<Path::Class>. + +Using C<Path::Class> can help solve real problems in your code too - +for instance, how many people actually take the "volume" (like C<C:> +on Windows) into account when writing C<File::Spec>-using code? I +thought not. But if you use C<Path::Class>, your file and directory objects +will know what volumes they refer to and do the right thing. + +The guts of the C<Path::Class> code live in the L<Path::Class::File> +and L<Path::Class::Dir> modules, so please see those +modules' documentation for more details about how to use them. + +=head2 EXPORT + +The following functions are exported by default. + +=over 4 + +=item file + +A synonym for C<< Path::Class::File->new >>. + +=item dir + +A synonym for C<< Path::Class::Dir->new >>. + +=back + +If you would like to prevent their export, you may explicitly pass an +empty list to perl's C<use>, i.e. C<use Path::Class ()>. + +The following are exported only on demand. + +=over 4 + +=item foreign_file + +A synonym for C<< Path::Class::File->new_foreign >>. + +=item foreign_dir + +A synonym for C<< Path::Class::Dir->new_foreign >>. + +=item tempdir + +Create a new Path::Class::Dir instance pointed to temporary directory. + + my $temp = Path::Class::tempdir(CLEANUP => 1); + +A synonym for C<< Path::Class::Dir->new(File::Temp::tempdir(@_)) >>. + +=back + +=head1 Notes on Cross-Platform Compatibility + +Although it is much easier to write cross-platform-friendly code with +this module than with C<File::Spec>, there are still some issues to be +aware of. + +=over 4 + +=item * + +On some platforms, notably VMS and some older versions of DOS (I think), +all filenames must have an extension. Thus if you create a file +called F<foo/bar> and then ask for a list of files in the directory +F<foo>, you may find a file called F<bar.> instead of the F<bar> you +were expecting. Thus it might be a good idea to use an extension in +the first place. + +=back + +=head1 AUTHOR + +Ken Williams, [email protected] + +=head1 COPYRIGHT + +Copyright (c) Ken Williams. All rights reserved. + +This library is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + + +=head1 SEE ALSO + +L<Path::Class::Dir>, L<Path::Class::File>, L<File::Spec> + +=cut diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Path-Class-0.25/SIGNATURE new/Path-Class-0.32/SIGNATURE --- old/Path-Class-0.25/SIGNATURE 2012-02-16 03:56:28.000000000 +0100 +++ new/Path-Class-0.32/SIGNATURE 2013-03-19 02:55:05.000000000 +0100 @@ -14,30 +14,33 @@ -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 -SHA1 b0e7caad5afe531b3c9dbb6946d4d62d40fb64ea Build.PL -SHA1 c019faeb9674c167d60997e6e4321f7de7ac7096 Changes +SHA1 8a47d82a249ef740f9ddc1edc0a8a1967ab5af95 Build.PL +SHA1 d483503ab40a499be572ac7b638f789289a13e5b Changes SHA1 3baefa5156f90435f40c793b7f071e2f89a74006 INSTALL -SHA1 b33df3650303ca968f350ac6a976f34f41762851 LICENSE -SHA1 e0b6ae90f3672e071e3e8d77f1d100dda38e9c24 MANIFEST -SHA1 5aefe0dfeafcb343beb080a3f6c7297131fef7ae META.yml -SHA1 9186a51736835d4795e0ff71dd7e1d1c95fea61d Makefile.PL -SHA1 fb3fff92bcd540665c40fea342f8377c72d5d597 README -SHA1 b56785d5c081896083dc4398194e1286e68371a0 dist.ini -SHA1 58a9698bacf9f6d62356a31a7b10b46b7b411910 lib/Path/Class.pm -SHA1 6240803f25d3c7a5b2589e8a82c3684096e6294c lib/Path/Class/Dir.pm -SHA1 7fd839b0aa96c90489b62504ddf993883dd5575d lib/Path/Class/Entity.pm -SHA1 323141c5eefea8cc3f55f0106f54fd4db508131c lib/Path/Class/File.pm +SHA1 8cb63de1ae4c54a120beb97cacc1fe2efe4d266b LICENSE +SHA1 dd5bf80ec1724df9d52ce5ffcc29753b83bd8f24 MANIFEST +SHA1 22f34e51b142ffc10b6d29ec52f485a6bc2e952a META.yml +SHA1 4949343af9acf51e1eccadd2b83b906397e74fa2 Makefile.PL +SHA1 3746678adadf43a39aece706e4e3f9a46e447faf README +SHA1 767e92b9cc035fc40c62a7deda816efddd4c14f2 README.pod +SHA1 9f5b9baa5682f8926bbbcac581431adf6ee35f7d dist.ini +SHA1 d5f5e3124978e888f81f2ba2a4da1743c14fb9ef lib/Path/Class.pm +SHA1 e3d410769736158296d337c155f8719719bce00d lib/Path/Class/Dir.pm +SHA1 c264511acf15c1a8f0d34ee97d0b1b88836ba76a lib/Path/Class/Entity.pm +SHA1 0042e7b87e5f61b0d999e5be18e61c2a1c9ea6bc lib/Path/Class/File.pm SHA1 212c128d87fa012c36016210e6e9213112fc3c23 t/01-basic.t -SHA1 a42f4b07e4c42e7a59b960b13c5466d7cd82e17a t/02-foreign.t -SHA1 ff702cdbf0bb4c25959cbc5a5c7db17772b7aa5b t/03-filesystem.t +SHA1 2dc6abce3b4c4601fe22bce9b0d58cb9484bcd0f t/02-foreign.t +SHA1 b2acb047bd89e0388273bc5703e12e2b8a6e296e t/03-filesystem.t SHA1 a163d4cf70142b45974ed39c78571e7ce2ba5a7f t/04-subclass.t SHA1 a154070d2cb1369f6cebf4228742edea39c43c63 t/05-traverse.t +SHA1 c71c41e78012d9577c47aa71b6d962e2c70d0e0e t/06-traverse_filt.t +SHA1 108772f2ba8c196345adf814a39a03401031651c t/07-recurseprune.t SHA1 fa45d6e6ab1cd421349dea4ef527bfd5cdc8a09e t/author-critic.t -----BEGIN PGP SIGNATURE----- Version: GnuPG/MacGPG2 v2.0.17 (Darwin) Comment: GPGTools - http://gpgtools.org -iEYEARECAAYFAk88cFsACgkQgrvMBLfvlHboawCgw86uYQhnD3A06Nec9W1ZKD2a -04kAmwbu2yyS2/XXyhHa+ql9R79+V1lS -=UPVQ +iEYEARECAAYFAlFHxXkACgkQgrvMBLfvlHZ/9wCfS6c7fWvewcCY9qRzQANeobwN +2b8An1gyXrGrbCou9+PsEJyFd0UihoEX +=IM95 -----END PGP SIGNATURE----- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Path-Class-0.25/dist.ini new/Path-Class-0.32/dist.ini --- old/Path-Class-0.25/dist.ini 2012-02-16 03:56:28.000000000 +0100 +++ new/Path-Class-0.32/dist.ini 2013-03-19 02:55:05.000000000 +0100 @@ -1,5 +1,5 @@ name = Path-Class -version = 0.25 +version = 0.32 author = Ken Williams <[email protected]> license = Perl_5 copyright_holder = Ken Williams diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Path-Class-0.25/lib/Path/Class/Dir.pm new/Path-Class-0.32/lib/Path/Class/Dir.pm --- old/Path-Class-0.25/lib/Path/Class/Dir.pm 2012-02-16 03:56:28.000000000 +0100 +++ new/Path-Class-0.32/lib/Path/Class/Dir.pm 2013-03-19 02:55:05.000000000 +0100 @@ -2,7 +2,7 @@ package Path::Class::Dir; { - $Path::Class::Dir::VERSION = '0.25'; + $Path::Class::Dir::VERSION = '0.32'; } use Path::Class::File; @@ -12,6 +12,7 @@ use IO::Dir (); use File::Path (); use File::Temp (); +use Scalar::Util (); # updir & curdir on the local machine, for screening them out in # children(). Note that they don't respect 'foreign' semantics. @@ -34,8 +35,22 @@ shift() ); - ($self->{volume}, my $dirs) = $s->splitpath( $s->canonpath($first) , 1); - $self->{dirs} = [$s->splitdir($s->catdir($dirs, @_))]; + $self->{dirs} = []; + if ( Scalar::Util::blessed($first) && $first->isa("Path::Class::Dir") ) { + $self->{volume} = $first->{volume}; + push @{$self->{dirs}}, @{$first->{dirs}}; + } + else { + ($self->{volume}, my $dirs) = $s->splitpath( $s->canonpath("$first") , 1); + push @{$self->{dirs}}, $dirs eq $s->rootdir ? "" : $s->splitdir($dirs); + } + + push @{$self->{dirs}}, map { + Scalar::Util::blessed($_) && $_->isa("Path::Class::Dir") + ? @{$_->{dirs}} + : $s->splitdir($_) + } @_; + return $self; } @@ -91,6 +106,11 @@ return @$d[$offset .. $length + $offset - 1]; } +sub components { + my $self = shift; + return $self->dir_list(@_); +} + sub subdir { my $self = shift; return $self->new($self, @_); @@ -103,7 +123,7 @@ if ($self->is_absolute) { my $parent = $self->new($self); - pop @{$parent->{dirs}}; + pop @{$parent->{dirs}} if @$dirs > 1; return $parent; } elsif ($self eq $curdir) { @@ -151,6 +171,19 @@ ); } +sub traverse_if { + my $self = shift; + my ($callback, $condition, @args) = @_; + my @children = grep { $condition->($_) } $self->children; + return $self->$callback( + sub { + my @inner_args = @_; + return map { $_->traverse_if($callback, $condition, @inner_args) } @children; + }, + @args + ); +} + sub recurse { my $self = shift; my %opts = (preorder => 1, depthfirst => 0, @_); @@ -165,14 +198,18 @@ $opts{depthfirst} && $opts{preorder} ? sub { my $dir = shift; - $callback->($dir); - unshift @queue, $dir->children; + my $ret = $callback->($dir); + unless( ($ret||'') eq $self->PRUNE ) { + unshift @queue, $dir->children; + } } : $opts{preorder} ? sub { my $dir = shift; - $callback->($dir); - push @queue, $dir->children; + my $ret = $callback->($dir); + unless( ($ret||'') eq $self->PRUNE ) { + push @queue, $dir->children; + } } : sub { my $dir = shift; @@ -284,7 +321,7 @@ =head1 VERSION -version 0.25 +version 0.32 =head1 SYNOPSIS @@ -401,10 +438,14 @@ etc.) of the directory object, if any. Otherwise, returns the empty string. +=item $dir->basename + +Returns the last directory name of the path as a string. + =item $dir->is_dir Returns a boolean value indicating whether this object represents a -directory. Not surprisingly, C<Path::Class::File> objects always +directory. Not surprisingly, L<Path::Class::File> objects always return false, and C<Path::Class::Dir> objects always return true. =item $dir->is_absolute @@ -436,7 +477,7 @@ =item $file = $dir->file( <dir1>, <dir2>, ..., <file> ) -Returns a C<Path::Class::File> object representing an entry in C<$dir> +Returns a L<Path::Class::File> object representing an entry in C<$dir> or one of its subdirectories. Internally, this just calls C<< Path::Class::File->new( @_ ) >>. @@ -484,7 +525,7 @@ =item @list = $dir->children -Returns a list of C<Path::Class::File> and/or C<Path::Class::Dir> +Returns a list of L<Path::Class::File> and/or C<Path::Class::Dir> objects listed in this directory, or in scalar context the number of such objects. Obviously, it is necessary for C<$dir> to exist and be readable in order to find its children. @@ -531,7 +572,7 @@ filesystem. The C<$other> argument may be a C<Path::Class::Dir> object, a -C<Path::Class::File> object, or a string. In the latter case, we +L<Path::Class::File> object, or a string. In the latter case, we assume it's a directory. # Examples: @@ -588,10 +629,18 @@ the single element at that offset; C<dir_list(OFFSET, LENGTH)> returns the final element that would have been returned in a list context. +=item $dir->components + +Identical to c<dir_list()>. It exists because there's an analogous +method C<dir_list()> in the C<Path::Class::File> class that also +returns the basename string, so this method lets someone call +C<components()> without caring whether the object is a file or a +directory. + =item $fh = $dir->open() Passes C<$dir> to C<< IO::Dir->open >> and returns the result as an -C<IO::Dir> object. If the opening fails, C<undef> is returned and +L<IO::Dir> object. If the opening fails, C<undef> is returned and C<$!> is set. =item $dir->mkpath($verbose, $mode) @@ -613,7 +662,7 @@ =item $dir->tempfile(...) -An interface to C<File::Temp>'s C<tempfile()> function. Just like +An interface to L<File::Temp>'s C<tempfile()> function. Just like that function, if you call this in a scalar context, the return value is the filehandle and the file is C<unlink>ed as soon as possible (which is immediately on Unix-like platforms). If called in a list @@ -647,7 +696,7 @@ A convenient way to iterate through directory contents. The first time C<next()> is called, it will C<open()> the directory and read the first item from it, returning the result as a C<Path::Class::Dir> or -C<Path::Class::File> object (depending, of course, on its actual +L<Path::Class::File> object (depending, of course, on its actual type). Each subsequent call to C<next()> will simply iterate over the directory's contents, until there are no more items in the directory, and then the undefined value is returned. For example, to iterate @@ -698,12 +747,39 @@ return $cont->(); }); +=item $dir->traverse_if( sub { ... }, sub { ... }, @args ) + +traverse with additional "should I visit this child" callback. +Particularly useful in case examined tree contains inaccessible +directories. + +Canonical example: + + $dir->traverse_if( + sub { + my ($child, $cont) = @_; + # do something with $child + return $cont->(); + }, + sub { + my ($child) = @_; + # Process only readable items + return -r $child; + }); + +Second callback gets single parameter: child. Only children for +which it returns true will be processed by the first callback. + +Remaining parameters are interpreted as in traverse, in particular +C<traverse_if(callback, sub { 1 }, @args> is equivalent to +C<traverse(callback, @args)>. + =item $dir->recurse( callback => sub {...} ) Iterates through this directory and all of its children, and all of its children's children, etc., calling the C<callback> subroutine for -each entry. This is a lot like what the C<File::Find> module does, -and of course C<File::Find> will work fine on C<Path::Class> objects, +each entry. This is a lot like what the L<File::Find> module does, +and of course C<File::Find> will work fine on L<Path::Class> objects, but the advantage of the C<recurse()> method is that it will also feed your callback routine C<Path::Class> objects rather than just pathname strings. @@ -718,6 +794,13 @@ At the time of this writing, all combinations of these two parameters are supported I<except> C<< depthfirst => 0, preorder => 0 >>. +C<callback> is normally not required to return any value. If it +returns special constant C<Path::Class::Entity::PRUNE()> (more easily +available as C<$item->PRUNE>), no children of analyzed +item will be analyzed (mostly as if you set C<$File::Find::prune=1>). Of course +pruning is available only in C<preorder>, in postorder return value +has no effect. + =item $st = $file->stat() Invokes C<< File::stat::stat() >> on this directory and returns a @@ -742,6 +825,6 @@ =head1 SEE ALSO -Path::Class, Path::Class::File, File::Spec +L<Path::Class>, L<Path::Class::File>, L<File::Spec> =cut diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Path-Class-0.25/lib/Path/Class/Entity.pm new/Path-Class-0.32/lib/Path/Class/Entity.pm --- old/Path-Class-0.25/lib/Path/Class/Entity.pm 2012-02-16 03:56:28.000000000 +0100 +++ new/Path-Class-0.32/lib/Path/Class/Entity.pm 2013-03-19 02:55:05.000000000 +0100 @@ -2,10 +2,10 @@ package Path::Class::Entity; { - $Path::Class::Entity::VERSION = '0.25'; + $Path::Class::Entity::VERSION = '0.32'; } -use File::Spec 0.87; +use File::Spec 3.26; use File::stat (); use Cwd; use Carp(); @@ -57,14 +57,14 @@ sub cleanup { my $self = shift; - my $cleaned = $self->new( $self->_spec->canonpath($self) ); + my $cleaned = $self->new( $self->_spec->canonpath("$self") ); %$self = %$cleaned; return $self; } sub resolve { my $self = shift; - Carp::croak($!) unless -e $self; # No such file or directory + Carp::croak($! . " $self") unless -e $self; # No such file or directory my $cleaned = $self->new( scalar Cwd::realpath($self->stringify) ); # realpath() always returns absolute path, kind of annoying @@ -88,16 +88,18 @@ sub stat { File::stat::stat("$_[0]") } sub lstat { File::stat::lstat("$_[0]") } +sub PRUNE { return \&PRUNE; } + 1; __END__ =head1 NAME -Path::Class:Entity - Base class for files and directories +Path::Class::Entity - Base class for files and directories =head1 VERSION -version 0.25 +version 0.32 =head1 DESCRIPTION diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Path-Class-0.25/lib/Path/Class/File.pm new/Path-Class-0.32/lib/Path/Class/File.pm --- old/Path-Class-0.25/lib/Path/Class/File.pm 2012-02-16 03:56:28.000000000 +0100 +++ new/Path-Class-0.32/lib/Path/Class/File.pm 2013-03-19 02:55:05.000000000 +0100 @@ -2,7 +2,7 @@ package Path::Class::File; { - $Path::Class::File::VERSION = '0.25'; + $Path::Class::File::VERSION = '0.32'; } use Path::Class::Dir; @@ -58,11 +58,18 @@ return $self->{dir}->volume; } +sub components { + my $self = shift; + die "Arguments are not currently supported by File->components()" if @_; + return ($self->dir->components, $self->basename); +} + sub basename { shift->{file} } sub open { IO::File->new(@_) } sub openr { $_[0]->open('r') or croak "Can't read $_[0]: $!" } -sub openw { $_[0]->open('w') or croak "Can't write $_[0]: $!" } +sub openw { $_[0]->open('w') or croak "Can't write to $_[0]: $!" } +sub opena { $_[0]->open('a') or croak "Can't append to $_[0]: $!" } sub touch { my $self = shift; @@ -79,15 +86,52 @@ my $iomode = $args{iomode} || 'r'; my $fh = $self->open($iomode) or croak "Can't read $self: $!"; + if (wantarray) { + my @data = <$fh>; + chomp @data if $args{chomped} or $args{chomp}; + + if ( my $splitter = $args{split} ) { + @data = map { [ split $splitter, $_ ] } @data; + } + + return @data; + } + + + croak "'split' argument can only be used in list context" + if $args{split}; + + if ($args{chomped} or $args{chomp}) { chomp( my @data = <$fh> ); - return wantarray ? @data : join '', @data; + return join '', @data; } - local $/ unless wantarray; + + local $/; return <$fh>; } +sub spew { + my $self = shift; + my %args = splice( @_, 0, @_-1 ); + + my $iomode = $args{iomode} || 'w'; + my $fh = $self->open( $iomode ) or croak "Can't write to $self: $!"; + + if (ref($_[0]) eq 'ARRAY') { + # Use old-school for loop to avoid copying. + for (my $i = 0; $i < @{ $_[0] }; $i++) { + print $fh $_[0]->[$i]; + } + } + else { + print $fh $_[0]; + } + + return; +} + sub remove { my $file = shift->stringify; return unlink $file unless -e $file; # Sets $! correctly @@ -101,6 +145,12 @@ return $self->$callback(sub { () }, @args); } +sub traverse_if { + my $self = shift; + my ($callback, $condition, @args) = @_; + return $self->$callback(sub { () }, @args); +} + 1; __END__ @@ -110,7 +160,7 @@ =head1 VERSION -version 0.25 +version 0.32 =head1 SYNOPSIS @@ -154,24 +204,24 @@ specified as the first argument, or as part of the first argument. You can use platform-neutral syntax: - my $dir = file( 'foo', 'bar', 'baz.txt' ); + my $file = file( 'foo', 'bar', 'baz.txt' ); or platform-native syntax: - my $dir = dir( 'foo/bar/baz.txt' ); + my $file = file( 'foo/bar/baz.txt' ); or a mixture of the two: - my $dir = dir( 'foo/bar', 'baz.txt' ); + my $file = file( 'foo/bar', 'baz.txt' ); All three of the above examples create relative paths. To create an absolute path, either use the platform native syntax for doing so: - my $dir = dir( '/var/tmp/foo.txt' ); + my $file = file( '/var/tmp/foo.txt' ); or use an empty string as the first argument: - my $dir = dir( '', 'var', 'tmp', 'foo.txt' ); + my $file = file( '', 'var', 'tmp', 'foo.txt' ); If the second form seems awkward, that's somewhat intentional - paths like C</var/tmp> or C<\Windows> aren't cross-platform concepts in the @@ -198,11 +248,22 @@ Returns the name of the file as a string, without the directory portion (if any). +=item $file->components + +Returns a list of the directory components of this file, followed by +the basename. + +Note: unlike C<< $dir->components >>, this method currently does not +accept any arguments to select which elements of the list will be +returned. It may do so in the future. Currently it throws an +exception if such arguments are present. + + =item $file->is_dir Returns a boolean value indicating whether this object represents a directory. Not surprisingly, C<Path::Class::File> objects always -return false, and C<Path::Class::Dir> objects always return true. +return false, and L<Path::Class::Dir> objects always return true. =item $file->is_absolute @@ -225,8 +286,8 @@ Performs a physical cleanup of the file path. For instance: - my $dir = dir('/foo/baz/../foo.txt')->resolve; - # $dir now represents '/foo/foo.txt', assuming no symlinks + my $file = file('/foo/baz/../foo.txt')->resolve; + # $file now represents '/foo/foo.txt', assuming no symlinks This actually consults the filesystem to verify the validity of the path. @@ -244,7 +305,7 @@ Returns a C<Path::Class::File> object representing C<$file> as an absolute path. An optional argument, given as either a string or a -C<Path::Class::Dir> object, specifies the directory to use as the base +L<Path::Class::Dir> object, specifies the directory to use as the base of relativity - otherwise the current working directory will be used. =item $rel = $file->relative @@ -278,7 +339,7 @@ Passes the given arguments, including C<$file>, to C<< IO::File->new >> (which in turn calls C<< IO::File->open >> and returns the result -as an C<IO::File> object. If the opening +as an L<IO::File> object. If the opening fails, C<undef> is returned and C<$!> is set. =item $fh = $file->openr() @@ -291,7 +352,13 @@ A shortcut for - $fh = $file->open('w') or croak "Can't write $file: $!"; + $fh = $file->open('w') or croak "Can't write to $file: $!"; + +=item $fh = $file->opena() + +A shortcut for + + $fh = $file->open('a') or croak "Can't append to $file: $!"; =item $file->touch @@ -317,10 +384,35 @@ a I<reading> mode. my @lines = $file->slurp(iomode => ':crlf'); - my $lines = $file->slurp(iomode => '<:encoding(UTF−8)'); + my $lines = $file->slurp(iomode => '<:encoding(UTF-8)'); The default C<iomode> is C<r>. +Lines can also be automatically splitted, mimicking the perl command-line +option C<-a> by using the C<split> parameter. If this parameter is used, +each line will be returned as an array ref. + + my @lines = $file->slurp( chomp => 1, split => qr/\s*,\s*/ ); + +The C<split> parameter can only be used in a list context. + +=item $file->spew( $content ); + +The opposite of L</slurp>, this takes a list of strings and prints them +to the file in write mode. If the file can't be written to, this method +will throw an exception. + +The content to be written can be either an array ref or a plain scalar. +If the content is an array ref then each entry in the array will be +written to the file. + +You may use the C<iomode> parameter to pass in an IO mode to use when +opening the file, just like L</slurp> supports. + + $file->spew(iomode => '>:raw', $content); + +The default C<iomode> is C<w>. + =item $file->traverse(sub { ... }, @args) Calls the given callback on $file. This doesn't do much on its own, @@ -340,7 +432,7 @@ =item $st = $file->stat() Invokes C<< File::stat::stat() >> on this file and returns a -C<File::stat> object representing the result. +L<File::stat> object representing the result. =item $st = $file->lstat() @@ -361,6 +453,6 @@ =head1 SEE ALSO -Path::Class, Path::Class::Dir, File::Spec +L<Path::Class>, L<Path::Class::Dir>, L<File::Spec> =cut diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Path-Class-0.25/lib/Path/Class.pm new/Path-Class-0.32/lib/Path/Class.pm --- old/Path-Class-0.25/lib/Path/Class.pm 2012-02-16 03:56:28.000000000 +0100 +++ new/Path-Class-0.32/lib/Path/Class.pm 2013-03-19 02:55:05.000000000 +0100 @@ -2,7 +2,7 @@ package Path::Class; { - $Path::Class::VERSION = '0.25'; + $Path::Class::VERSION = '0.32'; } { @@ -10,17 +10,19 @@ no strict 'vars'; @ISA = qw(Exporter); @EXPORT = qw(file dir); - @EXPORT_OK = qw(file dir foreign_file foreign_dir); + @EXPORT_OK = qw(file dir foreign_file foreign_dir tempdir); } use Exporter; use Path::Class::File; use Path::Class::Dir; +use File::Temp (); sub file { Path::Class::File->new(@_) } sub dir { Path::Class::Dir ->new(@_) } sub foreign_file { Path::Class::File->new_foreign(@_) } sub foreign_dir { Path::Class::Dir ->new_foreign(@_) } +sub tempdir { Path::Class::Dir->new(File::Temp::tempdir(@_)) } 1; @@ -32,7 +34,7 @@ =head1 VERSION -version 0.25 +version 0.32 =head1 SYNOPSIS @@ -75,7 +77,7 @@ manner. It supports pretty much every platform Perl runs on, including Unix, Windows, Mac, VMS, Epoc, Cygwin, OS/2, and NetWare. -The well-known module C<File::Spec> also provides this service, but +The well-known module L<File::Spec> also provides this service, but it's sort of awkward to use well, so people sometimes avoid it, or use it in a way that won't actually work properly on platforms significantly different than the ones they've tested their code on. @@ -113,8 +115,8 @@ thought not. But if you use C<Path::Class>, your file and directory objects will know what volumes they refer to and do the right thing. -The guts of the C<Path::Class> code live in the C<Path::Class::File> -and C<Path::Class::Dir> modules, so please see those +The guts of the C<Path::Class> code live in the L<Path::Class::File> +and L<Path::Class::Dir> modules, so please see those modules' documentation for more details about how to use them. =head2 EXPORT @@ -148,6 +150,14 @@ A synonym for C<< Path::Class::Dir->new_foreign >>. +=item tempdir + +Create a new Path::Class::Dir instance pointed to temporary directory. + + my $temp = Path::Class::tempdir(CLEANUP => 1); + +A synonym for C<< Path::Class::Dir->new(File::Temp::tempdir(@_)) >>. + =back =head1 Notes on Cross-Platform Compatibility @@ -183,6 +193,6 @@ =head1 SEE ALSO -Path::Class::Dir, Path::Class::File, File::Spec +L<Path::Class::Dir>, L<Path::Class::File>, L<File::Spec> =cut diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Path-Class-0.25/t/02-foreign.t new/Path-Class-0.32/t/02-foreign.t --- old/Path-Class-0.25/t/02-foreign.t 2012-02-16 03:56:28.000000000 +0100 +++ new/Path-Class-0.32/t/02-foreign.t 2013-03-19 02:55:05.000000000 +0100 @@ -1,6 +1,6 @@ use Test; use strict; -BEGIN { plan tests => 28 }; #30, todo => [29,30] }; +BEGIN { plan tests => 29 }; use Path::Class qw(file dir foreign_file foreign_dir); ok(1); @@ -68,3 +68,6 @@ ok $dir->is_absolute; # TODO ok $dir->as_foreign('Unix'), '/dir/subdir'; # TODO ok $dir->as_foreign('Unix')->is_absolute, 1; + +$dir = foreign_dir('Cygwin', '', 'tmp', 'foo'); +ok $dir, '/tmp/foo'; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Path-Class-0.25/t/03-filesystem.t new/Path-Class-0.32/t/03-filesystem.t --- old/Path-Class-0.25/t/03-filesystem.t 2012-02-16 03:56:28.000000000 +0100 +++ new/Path-Class-0.32/t/03-filesystem.t 2013-03-19 02:55:05.000000000 +0100 @@ -4,7 +4,7 @@ use File::Temp qw(tmpnam tempdir); use File::Spec; -plan tests => 78; +plan tests => 83; use_ok 'Path::Class'; @@ -143,6 +143,14 @@ @content = $file->slurp(chomp => 1); is_deeply \@content, ["Line1", "Line2"]; + is_deeply [ $file->slurp( chomp => 1, split => qr/n/ ) ] + => [ [ 'Li', 'e1' ], [ 'Li', 'e2' ] ], + "regex split with chomp"; + + is_deeply [ $file->slurp( chomp => 1, split => 'n' ) ] + => [ [ 'Li', 'e1' ], [ 'Li', 'e2' ] ], + "string split with chomp"; + $file->remove; ok not -e $file; } @@ -176,6 +184,17 @@ } { + my $file = file('t', 'spew'); + $file->remove() if -e $file; + $file->spew( iomode => '>:raw', "Line1\r\n" ); + $file->spew( iomode => '>>', "Line2" ); + + my $content = $file->slurp( iomode => '<:raw'); + + is( $content, "Line1\r\nLine2" ); +} + +{ # Make sure we can make an absolute/relative roundtrip my $cwd = dir(); is $cwd, $cwd->absolute->relative, "from $cwd to ".$cwd->absolute." to ".$cwd->absolute->relative; @@ -281,3 +300,11 @@ return \%files; } } + +{ + $dir = Path::Class::tempdir(); + isa_ok $dir, 'Path::Class::Dir'; + + $dir = Path::Class::tempdir(CLEANUP => 1); + isa_ok $dir, 'Path::Class::Dir'; +}; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Path-Class-0.25/t/06-traverse_filt.t new/Path-Class-0.32/t/06-traverse_filt.t --- old/Path-Class-0.25/t/06-traverse_filt.t 1970-01-01 01:00:00.000000000 +0100 +++ new/Path-Class-0.32/t/06-traverse_filt.t 2013-03-19 02:55:05.000000000 +0100 @@ -0,0 +1,77 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Cwd; +use Test::More; +use File::Temp qw(tempdir); + +plan tests => 4; + +use_ok 'Path::Class'; + +my $cwd = getcwd; +my $tmp = dir(tempdir(CLEANUP => 1)); + +# Test ability to filter children before navigating down to them +# a +# / \ +# b* c * → inaccessible +# / \ \ +# d e f +# / \ \ +# g h i* +(my $abe = $tmp->subdir(qw(a b e)))->mkpath; +(my $acf = $tmp->subdir(qw(a c f)))->mkpath; +$acf->file('i')->touch; +$abe->file('h')->touch; +$abe->file('g')->touch; +$tmp->file(qw(a b d))->touch; + +# Simulate permissions failures by just keeping a 'bad' list. We +# can't use actual permissions failures, because some people run tests +# as root, and then permissions always succeed. +my %bad = ( b => 1, i => 1); + + +my $a = $tmp->subdir('a'); + +my $nnodes = $a->traverse_if( + sub { + my ($child, $cont) = @_; + #diag("I am in $child"); + return sum($cont->(), 1); + }, + sub { + my $child = shift; + #diag("Checking whether to use $child: " . -r $child); + return !$bad{$child->basename}; + } +); +is($nnodes, 3); + +my $ndirs = $a->traverse_if( + sub { + my ($child, $cont) = @_; + return sum($cont->(), ($child->is_dir ? 1 : 0)); + }, + sub { + my $child = shift; + return !$bad{$child->basename}; + } + ); +is($ndirs, 3); + +my $max_depth = $a->traverse_if( + sub { + my ($child, $cont, $depth) = @_; + return max($cont->($depth + 1), $depth); + }, + sub { + my $child = shift; + return !$bad{$child->basename}; + }, + 0); +is($max_depth, 2); + +sub sum { my $total = 0; $total += $_ for @_; $total } +sub max { my $max = 0; for (@_) { $max = $_ if $_ > $max } $max } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Path-Class-0.25/t/07-recurseprune.t new/Path-Class-0.32/t/07-recurseprune.t --- old/Path-Class-0.25/t/07-recurseprune.t 1970-01-01 01:00:00.000000000 +0100 +++ new/Path-Class-0.32/t/07-recurseprune.t 2013-03-19 02:55:05.000000000 +0100 @@ -0,0 +1,92 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Cwd; +use Test::More; +use File::Temp qw(tempdir); + +plan tests => 8; + +use_ok 'Path::Class'; + +my $cwd = getcwd; +my $tmp = dir(tempdir(CLEANUP => 1)); + +# Test recursive iteration through the following structure: +# a +# / \ +# b c +# / \ \ +# d e f +# / \ \ +# g h i +(my $abe = $tmp->subdir(qw(a b e)))->mkpath; +(my $acf = $tmp->subdir(qw(a c f)))->mkpath; +$acf->file('i')->touch; +$abe->file('h')->touch; +$abe->file('g')->touch; +$tmp->file(qw(a b d))->touch; + +my $a = $tmp->subdir('a'); + +# Warmup without pruning +{ + my %visited; + $a->recurse( + callback => sub{ + my $item = shift; + my $rel_item = $item->relative($tmp); + my $tag = join '|', $rel_item->components; + $visited{$tag} = 1; + }); + + is_deeply(\%visited, { + "a" => 1, "a|b" => 1, "a|c" => 1, + "a|b|d" => 1, "a|b|e" => 1, "a|b|e|g" => 1, "a|b|e|h" => 1, + "a|c|f" => 1, "a|c|f|i" => 1, }); +} + +# Prune constant +ok( $a->PRUNE ); + +# Prune no 1 +{ + my %visited; + $a->recurse( + callback => sub{ + my $item = shift; + my $rel_item = $item->relative($tmp); + my $tag = join '|', $rel_item->components; + $visited{$tag} = 1; + return $item->PRUNE if $tag eq 'a|b'; + }); + + is_deeply(\%visited, { + "a" => 1, "a|b" => 1, "a|c" => 1, + "a|c|f" => 1, "a|c|f|i" => 1, }); +} + +# Prune constant alternative way +use_ok("Path::Class::Entity"); +ok( Path::Class::Entity::PRUNE() ); +is( $a->PRUNE, Path::Class::Entity::PRUNE() ); + +# Prune no 2 +{ + my %visited; + $a->recurse( + callback => sub{ + my $item = shift; + my $rel_item = $item->relative($tmp); + my $tag = join '|', $rel_item->components; + $visited{$tag} = 1; + return Path::Class::Entity::PRUNE() if $tag eq 'a|c'; + }); + + is_deeply(\%visited, { + "a" => 1, "a|b" => 1, "a|c" => 1, + "a|b|d" => 1, "a|b|e" => 1, "a|b|e|g" => 1, "a|b|e|h" => 1, + }); +} + +#diag("PRUNE constant value: " . $a->PRUNE); -- To unsubscribe, e-mail: [email protected] For additional commands, e-mail: [email protected]
