r38120 - in /branches/upstream/libpath-class-perl/current: Build.PL Changes META.yml Makefile.PL SIGNATURE lib/Path/Class.pm lib/Path/Class/Dir.pm lib/Path/Class/Entity.pm lib/Path/Class/File.pm t/01-basic.t t/02-foreign.t t/03-filesystem.t
carnil-guest at users.alioth.debian.org
carnil-guest at users.alioth.debian.org
Mon Jun 15 17:28:58 UTC 2009
Author: carnil-guest
Date: Mon Jun 15 17:28:50 2009
New Revision: 38120
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=38120
Log:
[svn-upgrade] Integrating new upstream version, libpath-class-perl (0.17)
Modified:
branches/upstream/libpath-class-perl/current/Build.PL
branches/upstream/libpath-class-perl/current/Changes
branches/upstream/libpath-class-perl/current/META.yml
branches/upstream/libpath-class-perl/current/Makefile.PL
branches/upstream/libpath-class-perl/current/SIGNATURE
branches/upstream/libpath-class-perl/current/lib/Path/Class.pm
branches/upstream/libpath-class-perl/current/lib/Path/Class/Dir.pm
branches/upstream/libpath-class-perl/current/lib/Path/Class/Entity.pm
branches/upstream/libpath-class-perl/current/lib/Path/Class/File.pm
branches/upstream/libpath-class-perl/current/t/01-basic.t
branches/upstream/libpath-class-perl/current/t/02-foreign.t
branches/upstream/libpath-class-perl/current/t/03-filesystem.t
Modified: branches/upstream/libpath-class-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpath-class-perl/current/Build.PL?rev=38120&op=diff
==============================================================================
--- branches/upstream/libpath-class-perl/current/Build.PL (original)
+++ branches/upstream/libpath-class-perl/current/Build.PL Mon Jun 15 17:28:50 2009
@@ -13,12 +13,21 @@
'File::stat' => 0,
'File::Path' => 0,
'overload' => 0,
+ 'Cwd' => 0,
},
build_requires => {
'Test::More' => 0,
+ 'File::Temp' => 0,
},
create_makefile_pl => 'traditional',
create_readme => 1,
+ meta_merge => {
+ resources => {
+ repository => 'http://perl-path-class.googlecode.com/svn/trunk',
+ homepage => 'http://code.google.com/p/perl-path-class',
+ bugtracker => 'http://rt.cpan.org/Public/Dist/Display.html?Name=Path-Class',
+ },
+ },
sign => 1,
);
Modified: branches/upstream/libpath-class-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpath-class-perl/current/Changes?rev=38120&op=diff
==============================================================================
--- branches/upstream/libpath-class-perl/current/Changes (original)
+++ branches/upstream/libpath-class-perl/current/Changes Mon Jun 15 17:28:50 2009
@@ -1,4 +1,31 @@
Revision history for Perl extension Path::Class.
+
+ - dir(undef) now returns undef rather than the rootdir, because undef
+ was probably a mistake by the caller, and the rootdir is too scary
+ a default. [Suggested by John Goulah]
+
+ - Temporary files during testing are now created in the system temp
+ directory, rather than somewhere in t/ . See RT #31382. [Suggested
+ by Alex Page]
+
+ - Added is_relative() as the obvious complement to the existing
+ is_absolute() method.
+
+ - Added a resolve() method to clean up paths much more thoroughly
+ than cleanup(), e.g. resolving symlinks, collapsing foo/../bar
+ sections, etc. [Suggested by David Garamond]
+
+ - Fixed a problem in which a file/directory called "0" or "0.0" would
+ end a loop prematurely when using the idiom 'while($x =
+ $dir->next) {...}'. See http://rt.cpan.org/Ticket/Display.html?id=29374
+ [Spotted by Daniel Lo]
+
+ - Fixed an exists($array[$i]) that prevented compatibility with perl
+ 5.005.
+
+ - Moved the repository from my personal CVS repo to Google Code.
+
+0.16 - Sun Dec 24 20:29:40 2006
- Added a $dir->contains($thing) method that indicates whether $dir
actually contains $thing on the filesystem.
Modified: branches/upstream/libpath-class-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpath-class-perl/current/META.yml?rev=38120&op=diff
==============================================================================
--- branches/upstream/libpath-class-perl/current/META.yml (original)
+++ branches/upstream/libpath-class-perl/current/META.yml Mon Jun 15 17:28:50 2009
@@ -1,13 +1,17 @@
---
name: Path-Class
-version: 0.16
+version: 0.17
author:
- 'Ken Williams, KWILLIAMS at cpan.org'
abstract: Cross-platform path specification manipulation
license: perl
resources:
+ bugtracker: http://rt.cpan.org/Public/Dist/Display.html?Name=Path-Class
+ homepage: http://code.google.com/p/perl-path-class
license: http://dev.perl.org/licenses/
+ repository: http://perl-path-class.googlecode.com/svn/trunk
requires:
+ Cwd: 0
File::Path: 0
File::Spec: 0.87
File::Spec::Mac: 1.3
@@ -16,18 +20,22 @@
IO::File: 0
overload: 0
build_requires:
+ File::Temp: 0
Test::More: 0
provides:
Path::Class:
file: lib/Path/Class.pm
- version: 0.16
+ version: 0.17
Path::Class::Dir:
file: lib/Path/Class/Dir.pm
+ version: 0.17
Path::Class::Entity:
file: lib/Path/Class/Entity.pm
+ version: 0.17
Path::Class::File:
file: lib/Path/Class/File.pm
-generated_by: Module::Build version 0.2805
+ version: 0.17
+generated_by: Module::Build version 0.2808
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.2.html
version: 1.2
Modified: branches/upstream/libpath-class-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpath-class-perl/current/Makefile.PL?rev=38120&op=diff
==============================================================================
--- branches/upstream/libpath-class-perl/current/Makefile.PL (original)
+++ branches/upstream/libpath-class-perl/current/Makefile.PL Mon Jun 15 17:28:50 2009
@@ -5,9 +5,11 @@
'NAME' => 'Path::Class',
'VERSION_FROM' => 'lib/Path/Class.pm',
'PREREQ_PM' => {
+ 'Cwd' => '0',
'File::Path' => '0',
'File::Spec' => '0.87',
'File::Spec::Mac' => '1.3',
+ 'File::Temp' => '0',
'File::stat' => '0',
'IO::Dir' => '0',
'IO::File' => '0',
Modified: branches/upstream/libpath-class-perl/current/SIGNATURE
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpath-class-perl/current/SIGNATURE?rev=38120&op=diff
==============================================================================
--- branches/upstream/libpath-class-perl/current/SIGNATURE (original)
+++ branches/upstream/libpath-class-perl/current/SIGNATURE Mon Jun 15 17:28:50 2009
@@ -14,24 +14,24 @@
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1
-SHA1 ff25bd1bd186f15524216ea90a73b61bf0c7576d Build.PL
-SHA1 0a3baa5c251bbbe345010ed0b0c50dd94628b140 Changes
+SHA1 3e94b50826015fe7ac1e769cadd656b53317d4ab Build.PL
+SHA1 9567a4ffd4c426d4526691ca52c9f2b8f561e477 Changes
SHA1 066a2dba8084a0c2a7e4b6996ad21872bc16beb5 INSTALL
SHA1 f38532f135ebd170454a00805504b38e89e0ae45 MANIFEST
-SHA1 b04749f4f67233a07a4e44074244404e4c1b5270 META.yml
-SHA1 74dc0d49793be5f7fc8f13400c4ced4660c53135 Makefile.PL
+SHA1 a39a2d1257e3c38b1165bfcfce6b30506c7c19b1 META.yml
+SHA1 0c532f7354680da206a858e78a7d85c8dc097ae6 Makefile.PL
SHA1 a7b1cdcddb8679dff993b475939abcfb73076afb README
-SHA1 0a6df8be8ef7f497a160ee49f26aa1e2a30a6eb3 lib/Path/Class.pm
-SHA1 e1803c5bcffbf1c53ecdd468676963bbce80121b lib/Path/Class/Dir.pm
-SHA1 0f444026e55bcf6214b3530fac4293e532426c1f lib/Path/Class/Entity.pm
-SHA1 22ee4a2d755d1258f725ecc615f99692afc17c0e lib/Path/Class/File.pm
-SHA1 add5b0ec80570448224a39e7f44f82f154018d0b t/01-basic.t
-SHA1 d63e3614a5863588addbd1f2b095f5ecbd7d1ab6 t/02-foreign.t
-SHA1 2589396d46647a9b959f2ccc2b2bd0ce7723074c t/03-filesystem.t
+SHA1 3d64ed54b908ee860960d78db05756c542d64d56 lib/Path/Class.pm
+SHA1 1d938eb5f99d4befb3ca136c73bd4d89cd8cd8bd lib/Path/Class/Dir.pm
+SHA1 1bf64dc3a7c3cf2ec1879ded35b7b04d06c6a7c6 lib/Path/Class/Entity.pm
+SHA1 d5732a053f4cd7ff3d1010f17d7aa73954182004 lib/Path/Class/File.pm
+SHA1 220f7d1d24731b7ae889e1b74c4306dbe552ffca t/01-basic.t
+SHA1 a42f4b07e4c42e7a59b960b13c5466d7cd82e17a t/02-foreign.t
+SHA1 6d11d3c96fd1db41c336d3014e3224076e283676 t/03-filesystem.t
-----BEGIN PGP SIGNATURE-----
-Version: GnuPG v1.4.5 (Darwin)
+Version: GnuPG v1.4.6 (Darwin)
-iD8DBQFFjzeKgrvMBLfvlHYRAtCoAJ4ujmUD5sdYRRAPP+ZtlbLabrtdOwCfdr2l
-D54xkhv9tdWiXlHbz1nkEnM=
-=0Zny
+iD8DBQFKNbT7grvMBLfvlHYRAlGTAKCC3CeJ2dDp1cukg0rT2ysDO/FmTgCgzLgE
+5+MgPMBZwcsFeC1NQAScv4o=
+=KH30
-----END PGP SIGNATURE-----
Modified: branches/upstream/libpath-class-perl/current/lib/Path/Class.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpath-class-perl/current/lib/Path/Class.pm?rev=38120&op=diff
==============================================================================
--- branches/upstream/libpath-class-perl/current/lib/Path/Class.pm (original)
+++ branches/upstream/libpath-class-perl/current/lib/Path/Class.pm Mon Jun 15 17:28:50 2009
@@ -1,6 +1,6 @@
package Path::Class;
-$VERSION = '0.16';
+$VERSION = '0.17';
@ISA = qw(Exporter);
@EXPORT = qw(file dir);
@EXPORT_OK = qw(file dir foreign_file foreign_dir);
Modified: branches/upstream/libpath-class-perl/current/lib/Path/Class/Dir.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpath-class-perl/current/lib/Path/Class/Dir.pm?rev=38120&op=diff
==============================================================================
--- branches/upstream/libpath-class-perl/current/lib/Path/Class/Dir.pm (original)
+++ branches/upstream/libpath-class-perl/current/lib/Path/Class/Dir.pm Mon Jun 15 17:28:50 2009
@@ -1,4 +1,6 @@
package Path::Class::Dir;
+
+$VERSION = '0.17';
use strict;
use Path::Class::File;
@@ -11,6 +13,13 @@
sub new {
my $self = shift->SUPER::new();
+
+ # If the only arg is undef, it's probably a mistake. Without this
+ # special case here, we'd return the root directory, which is a
+ # lousy thing to do to someone when they made a mistake. Return
+ # undef instead.
+ return if @_==1 && !defined($_[0]);
+
my $s = $self->_spec;
my $first = (@_ == 0 ? $s->curdir :
@@ -217,7 +226,7 @@
my $i = 0;
while ($i <= $#{ $self->{dirs} }) {
- return 0 unless exists $other->{dirs}[$i];
+ return 0 if $i > $#{ $other->{dirs} };
return 0 if $self->{dirs}[$i] ne $other->{dirs}[$i];
$i++;
}
@@ -247,11 +256,13 @@
print "dir: $dir\n";
if ($dir->is_absolute) { ... }
+ if ($dir->is_relative) { ... }
my $v = $dir->volume; # Could be 'C:' on Windows, empty string
# on Unix, 'Macintosh HD:' on Mac OS
$dir->cleanup; # Perform logical cleanup of pathname
+ $dir->resolve; # Perform physical cleanup of pathname
my $file = $dir->file('file.txt'); # A file in this directory
my $subdir = $dir->subdir('george'); # A subdirectory
@@ -330,6 +341,11 @@
To get the current directory as an absolute path, do C<<
dir()->absolute >>.
+Finally, as another special case C<dir(undef)> will return undef,
+since that's usually an accident on the part of the caller, and
+returning the root directory would be a nasty surprise just asking for
+trouble a few lines later.
+
=item $dir->stringify
This method is called internally when a C<Path::Class::Dir> object is
@@ -355,12 +371,27 @@
Returns true or false depending on whether the directory refers to an
absolute path specifier (like C</usr/local> or C<\Windows>).
+=item $dir->is_relative
+
+Returns true or false depending on whether the directory refers to a
+relative path specifier (like C<lib/foo> or C<./dir>).
+
=item $dir->cleanup
Performs a logical cleanup of the file path. For instance:
my $dir = dir('/foo//baz/./foo')->cleanup;
# $dir now represents '/foo/baz/foo';
+
+=item $dir->resolve
+
+Performs a physical cleanup of the file path. For instance:
+
+ my $dir = dir('/foo//baz/../foo')->resolve;
+ # $dir now represents '/foo/foo', assuming no symlinks
+
+This actually consults the filesystem to verify the validity of the
+path.
=item $file = $dir->file( <dir1>, <dir2>, ..., <file> )
Modified: branches/upstream/libpath-class-perl/current/lib/Path/Class/Entity.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpath-class-perl/current/lib/Path/Class/Entity.pm?rev=38120&op=diff
==============================================================================
--- branches/upstream/libpath-class-perl/current/lib/Path/Class/Entity.pm (original)
+++ branches/upstream/libpath-class-perl/current/lib/Path/Class/Entity.pm Mon Jun 15 17:28:50 2009
@@ -1,12 +1,16 @@
package Path::Class::Entity;
+
+$VERSION = '0.17';
use strict;
use File::Spec;
use File::stat ();
+use Cwd;
use overload
(
q[""] => 'stringify',
+ 'bool' => 'boolify',
fallback => 1,
);
@@ -36,16 +40,31 @@
}
sub _spec { $_[0]->{file_spec_class} || 'File::Spec' }
+
+sub boolify { 1 }
sub is_absolute {
- # 5.6.0 has a bug with regexes and stringification that's ticked by
- # file_name_is_absolute(). Help it along.
- $_[0]->_spec->file_name_is_absolute($_[0]->stringify)
+ # 5.6.0 has a bug with regexes and stringification that's ticked by
+ # file_name_is_absolute(). Help it along with an explicit stringify().
+ $_[0]->_spec->file_name_is_absolute($_[0]->stringify)
}
+
+sub is_relative { ! $_[0]->is_absolute }
sub cleanup {
my $self = shift;
my $cleaned = $self->new( $self->_spec->canonpath($self) );
+ %$self = %$cleaned;
+ return $self;
+}
+
+sub resolve {
+ my $self = shift;
+ my $cleaned = $self->new( Cwd::realpath($self->stringify) );
+
+ # realpath() always returns absolute path, kind of annoying
+ $cleaned = $cleaned->relative if $self->is_relative;
+
%$self = %$cleaned;
return $self;
}
Modified: branches/upstream/libpath-class-perl/current/lib/Path/Class/File.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpath-class-perl/current/lib/Path/Class/File.pm?rev=38120&op=diff
==============================================================================
--- branches/upstream/libpath-class-perl/current/lib/Path/Class/File.pm (original)
+++ branches/upstream/libpath-class-perl/current/lib/Path/Class/File.pm Mon Jun 15 17:28:50 2009
@@ -1,4 +1,6 @@
package Path::Class::File;
+
+$VERSION = '0.17';
use strict;
use Path::Class::Dir;
@@ -106,11 +108,13 @@
print "file: $file\n";
if ($file->is_absolute) { ... }
+ if ($file->is_relative) { ... }
my $v = $file->volume; # Could be 'C:' on Windows, empty string
# on Unix, 'Macintosh HD:' on Mac OS
$file->cleanup; # Perform logical cleanup of pathname
+ $file->resolve; # Perform physical cleanup of pathname
my $dir = $file->dir; # A Path::Class::Dir object
@@ -190,12 +194,27 @@
Returns true or false depending on whether the file refers to an
absolute path specifier (like C</usr/local/foo.txt> or C<\Windows\Foo.txt>).
+=item $file->is_absolute
+
+Returns true or false depending on whether the file refers to a
+relative path specifier (like C<lib/foo.txt> or C<.\Foo.txt>).
+
=item $file->cleanup
Performs a logical cleanup of the file path. For instance:
my $file = file('/foo//baz/./foo.txt')->cleanup;
# $file now represents '/foo/baz/foo.txt';
+
+=item $dir->resolve
+
+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
+
+This actually consults the filesystem to verify the validity of the
+path.
=item $dir = $file->dir
Modified: branches/upstream/libpath-class-perl/current/t/01-basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpath-class-perl/current/t/01-basic.t?rev=38120&op=diff
==============================================================================
--- branches/upstream/libpath-class-perl/current/t/01-basic.t (original)
+++ branches/upstream/libpath-class-perl/current/t/01-basic.t Mon Jun 15 17:28:50 2009
@@ -7,7 +7,7 @@
use Path::Class;
use Cwd;
-plan tests => 65;
+plan tests => 66;
ok(1);
my $file1 = Path::Class::File->new('foo.txt');
@@ -80,6 +80,7 @@
ok dir(), '.';
ok dir('', 'var', 'tmp'), '/var/tmp';
ok dir()->absolute, dir(Cwd::cwd())->cleanup;
+ ok dir(undef), undef;
}
{
Modified: branches/upstream/libpath-class-perl/current/t/02-foreign.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpath-class-perl/current/t/02-foreign.t?rev=38120&op=diff
==============================================================================
--- branches/upstream/libpath-class-perl/current/t/02-foreign.t (original)
+++ branches/upstream/libpath-class-perl/current/t/02-foreign.t Mon Jun 15 17:28:50 2009
@@ -1,6 +1,6 @@
use Test;
use strict;
-BEGIN { plan tests => 29, todo => [28,29] };
+BEGIN { plan tests => 28 }; #30, todo => [29,30] };
use Path::Class qw(file dir foreign_file foreign_dir);
ok(1);
@@ -57,6 +57,7 @@
ok $dir->subdir('foo'), ':dir:subdir:foo:';
ok $dir->file('foo.txt'), ':dir:subdir:foo.txt';
ok $dir->parent, ':dir:';
+ok $dir->is_relative, 1;
$dir = foreign_dir('Mac', ':dir::dir2:subdir');
ok $dir, ':dir::dir2:subdir:';
@@ -65,5 +66,5 @@
$dir = foreign_dir('Mac', 'Volume:dir:subdir:');
ok $dir, 'Volume:dir:subdir:';
ok $dir->is_absolute;
-ok $dir->as_foreign('Unix'), '/dir/subdir';
-ok $dir->as_foreign('Unix')->is_absolute, 1;
+# TODO ok $dir->as_foreign('Unix'), '/dir/subdir';
+# TODO ok $dir->as_foreign('Unix')->is_absolute, 1;
Modified: branches/upstream/libpath-class-perl/current/t/03-filesystem.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpath-class-perl/current/t/03-filesystem.t?rev=38120&op=diff
==============================================================================
--- branches/upstream/libpath-class-perl/current/t/03-filesystem.t (original)
+++ branches/upstream/libpath-class-perl/current/t/03-filesystem.t Mon Jun 15 17:28:50 2009
@@ -1,26 +1,29 @@
use strict;
use Test::More;
-use Path::Class;
-
-plan tests => 64;
-ok 1;
-
-my $file = file('t', 'testfile');
-ok $file;
+use File::Temp qw(tmpnam tempdir);
+use File::Spec;
+
+plan tests => 72;
+
+use_ok 'Path::Class';
+
+
+my $file = file(scalar tmpnam());
+ok $file, "Got a filename via tmpnam()";
{
my $fh = $file->open('w');
- ok $fh;
-
- ok print $fh "Foo\n";
-}
-
-ok -e $file;
+ ok $fh, "Opened $file for writing";
+
+ ok print( $fh "Foo\n"), "Printed to $file";
+}
+
+ok -e $file, "$file should exist";
{
my $fh = $file->open;
- is scalar <$fh>, "Foo\n";
+ is scalar <$fh>, "Foo\n", "Read contents of $file correctly";
}
{
@@ -36,10 +39,8 @@
ok not -e $file;
-my $dir = dir('t', 'testdir');
+my $dir = dir(tempdir(CLEANUP => 1));
ok $dir;
-
-ok mkdir($dir, 0777);
ok -d $dir;
$file = $dir->file('foo.x');
@@ -48,20 +49,27 @@
{
my $dh = $dir->open;
- ok $dh;
+ ok $dh, "Opened $dir for reading";
my @files = readdir $dh;
is scalar @files, 3;
ok scalar grep { $_ eq 'foo.x' } @files;
}
-ok $dir->rmtree;
-ok !-e $dir;
+ok $dir->rmtree, "Removed $dir";
+ok !-e $dir, "$dir no longer exists";
{
$dir = dir('t', 'foo', 'bar');
- ok $dir->mkpath;
- ok -d $dir;
+ $dir->parent->rmtree if -e $dir->parent;
+
+ ok $dir->mkpath, "Created $dir";
+ ok -d $dir, "$dir is a directory";
+
+ # Use a Unix sample path to test cleaning it up
+ my $ugly = Path::Class::Dir->new_foreign(Unix => 't/foo/..//foo/bar');
+ $ugly->resolve;
+ is $ugly->as_foreign('Unix'), 't/foo/bar';
$dir = $dir->parent;
ok $dir->rmtree;
@@ -74,15 +82,15 @@
ok $dir->subdir('dir')->mkpath;
ok -d $dir->subdir('dir');
- ok $dir->file('file.x')->open('w');
- ok $dir->file('0')->open('w');
+ ok $dir->file('file.x')->touch;
+ ok $dir->file('0')->touch;
my @contents;
while (my $file = $dir->next) {
push @contents, $file;
}
is scalar @contents, 5;
- my $joined = join ' ', map $_->basename, sort grep {-f $_} @contents;
+ my $joined = join ' ', sort map $_->basename, grep {-f $_} @contents;
is $joined, '0 file.x';
my ($subdir) = grep {$_ eq $dir->subdir('dir')} @contents;
@@ -93,6 +101,26 @@
ok $file;
is -d $file, '';
+ ok $dir->rmtree;
+ ok !-e $dir;
+
+
+ # Try again with directory called '0', in curdir
+ my $orig = dir()->absolute;
+
+ ok $dir->mkpath;
+ ok chdir($dir);
+ my $dir2 = dir();
+ ok $dir2->subdir('0')->mkpath;
+ ok -d $dir2->subdir('0');
+
+ @contents = ();
+ while (my $file = $dir2->next) {
+ push @contents, $file;
+ }
+ ok grep {$_ eq '0'} @contents;
+
+ ok chdir($orig);
ok $dir->rmtree;
ok !-e $dir;
}
More information about the Pkg-perl-cvs-commits
mailing list