The attached patches do two things.
First, it adds is_rootdir() to say if the current directory is the root
directory. That's handy regardless.
Then it uses that to change parent() to return undef for the parent of
the root directory.
From 40a58986a4eb716c5a99646250ffd50f1718e8c3 Mon Sep 17 00:00:00 2001
From: Michael G. Schwern <schwern@pobox.com>
Date: Fri, 12 Feb 2010 16:59:11 -0800
Subject: [PATCH 2/2] Change parent() to stop at the root directory
---
lib/Path/Class/Dir.pm | 9 +++++----
t/01-basic.t | 2 +-
2 files changed, 6 insertions(+), 5 deletions(-)
diff --git a/lib/Path/Class/Dir.pm b/lib/Path/Class/Dir.pm
index bc8baa5..f576abd 100644
--- a/lib/Path/Class/Dir.pm
+++ b/lib/Path/Class/Dir.pm
@@ -96,6 +96,8 @@ sub parent {
my $dirs = $self->{dirs};
my ($curdir, $updir) = ($self->_spec->curdir, $self->_spec->updir);
+ return if $self->is_rootdir;
+
if ($self->is_absolute) {
my $parent = $self->new($self);
pop @{$parent->{dirs}};
@@ -438,7 +440,8 @@ Returns the parent directory of C<$dir>. Note that this is the
I<logical> parent, not necessarily the physical parent. It really
means we just chop off entries from the end of the directory list
until we cain't chop no more. If the directory is relative, we start
-using the relative forms of parent directories.
+using the relative forms of parent directories. If the directory is
+root, it will return undef.
The following code demonstrates the behavior on absolute and relative
directories:
@@ -447,6 +450,7 @@ directories:
for (1..6) {
print "Absolute: $dir\n";
$dir = $dir->parent;
+ last if not $dir;
}
$dir = dir('foo/bar');
@@ -459,9 +463,6 @@ directories:
Absolute: /foo/bar
Absolute: /foo
Absolute: /
- Absolute: /
- Absolute: /
- Absolute: /
Relative: foo/bar
Relative: foo
Relative: .
diff --git a/t/01-basic.t b/t/01-basic.t
index 093932f..2c74252 100644
--- a/t/01-basic.t
+++ b/t/01-basic.t
@@ -58,7 +58,7 @@ ok $file->parent, '/foo/baz';
ok $dir->parent, '/foo/bar';
ok $dir->parent->parent, '/foo';
ok $dir->parent->parent->parent, '/';
- ok $dir->parent->parent->parent->parent, '/';
+ ok !$dir->parent->parent->parent->parent;
$dir = dir('foo/bar/baz');
ok $dir->parent, 'foo/bar';
--
1.6.6.1
From b6fa3a4e3b47002cb39995095abec738f9e4d0c8 Mon Sep 17 00:00:00 2001
From: Michael G. Schwern <schwern@pobox.com>
Date: Fri, 12 Feb 2010 16:50:15 -0800
Subject: [PATCH 1/2] Add is_rootdir()
This is necessary to make parent() stop at the root, and handy in general.
---
lib/Path/Class/Dir.pm | 15 +++++++++++++++
t/rootdir.t | 47 +++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 62 insertions(+), 0 deletions(-)
create mode 100644 t/rootdir.t
diff --git a/lib/Path/Class/Dir.pm b/lib/Path/Class/Dir.pm
index fb80ebd..bc8baa5 100644
--- a/lib/Path/Class/Dir.pm
+++ b/lib/Path/Class/Dir.pm
@@ -251,6 +251,12 @@ sub contains {
return !!(-d $self and (-e $other or -l $other) and $self->subsumes($other));
}
+sub is_rootdir {
+ my $self = shift;
+ my $not_root = grep $_ ne '', @{$self->{dirs}};
+ return !$not_root;
+}
+
1;
__END__
@@ -389,6 +395,15 @@ absolute path specifier (like C</usr/local> or C<\Windows>).
Returns true or false depending on whether the directory refers to a
relative path specifier (like C<lib/foo> or C<./dir>).
+=item $dir->is_rootdir
+
+Returns true or false depending on whether the directory refers to
+the root directory of the volume (like C</> or C<C:\>).
+
+This is not currently a file system check, so C<../../..> will never
+return true even if it does lead to the root directory. This may
+change.
+
=item $dir->cleanup
Performs a logical cleanup of the file path. For instance:
diff --git a/t/rootdir.t b/t/rootdir.t
new file mode 100644
index 0000000..c7593e5
--- /dev/null
+++ b/t/rootdir.t
@@ -0,0 +1,47 @@
+#!/usr/bin/perl
+
+BEGIN {
+ $^O = 'Unix'; # Test in Unix mode
+}
+
+use Test::More tests => 17;
+use warnings;
+use strict;
+use Path::Class;
+
+# Basic Unix tests
+{
+ ok dir("/")->is_rootdir;
+ ok dir("")->is_rootdir;
+ ok !dir("/foo")->is_rootdir;
+ ok !dir("foo")->is_rootdir;
+ ok dir("//")->is_rootdir;
+ ok !dir("foo/bar/baz")->is_rootdir;
+ ok !dir(".")->is_rootdir;
+ ok !dir("../")->is_rootdir;
+}
+
+# Try Windows
+{
+ my $new_win = sub { Path::Class::Dir->new_foreign("Win32", @_) };
+ ok $new_win->("C:\\")->is_rootdir;
+ ok $new_win->("\\")->is_rootdir;
+ ok $new_win->("")->is_rootdir;
+ ok $new_win->("/")->is_rootdir;
+ ok $new_win->("C:/")->is_rootdir;
+ ok !$new_win->("C:/foo")->is_rootdir;
+ ok !$new_win->("\\foo")->is_rootdir;
+ ok !$new_win->(".\\foo")->is_rootdir;
+}
+
+# Look up the current path to find the root dir
+{
+ my $dir = dir->absolute;
+ for(1..1024) {
+ if( $dir->is_rootdir ) {
+ pass("Found the root dir");
+ last;
+ }
+ $dir = $dir->parent;
+ }
+}
--
1.6.6.1
