Attached is a simple patch to add dir_class() to Path::Class::File and
file_class to Path::Class::Dir along with a simple test.
I decided on a public method rather than messing around with "protected"
because I never thought it was worth it. YMMV.
From 522fba05005e901a29a95b4b5d84c97712399379 Mon Sep 17 00:00:00 2001
From: Michael G. Schwern <schwern@pobox.com>
Date: Sat, 23 Jan 2010 18:50:36 -0800
Subject: [PATCH] Make Path::Class subclassable.
---
lib/Path/Class/Dir.pm | 13 +++++++++++--
lib/Path/Class/File.pm | 15 ++++++++++++---
t/subclass.t | 36 ++++++++++++++++++++++++++++++++++++
3 files changed, 59 insertions(+), 5 deletions(-)
create mode 100644 t/subclass.t
diff --git a/lib/Path/Class/Dir.pm b/lib/Path/Class/Dir.pm
index 6e365f1..ff90fa2 100644
--- a/lib/Path/Class/Dir.pm
+++ b/lib/Path/Class/Dir.pm
@@ -4,7 +4,6 @@ $VERSION = '0.18';
use strict;
use Path::Class::File;
-use Path::Class::Entity;
use Carp();
use base qw(Path::Class::Entity);
@@ -38,6 +37,10 @@ sub new {
return $self;
}
+sub file_class {
+ return "Path::Class::File";
+}
+
sub is_dir { 1 }
sub as_foreign {
@@ -67,7 +70,7 @@ sub volume { shift()->{volume} }
sub file {
local $Path::Class::Foreign = $_[0]->{file_spec_class} if $_[0]->{file_spec_class};
- return Path::Class::File->new(@_);
+ return $_[0]->file_class->new(@_);
}
sub dir_list {
@@ -633,6 +636,12 @@ C<File::stat> object representing the result.
Same as C<stat()>, but if C<$file> is a symbolic link, C<lstat()>
stats the link instead of the directory the link points to.
+=item $class = $file->file_class()
+
+Returns the class which should be used to create file objects.
+
+Generally overriden by subclasses.
+
=back
=head1 AUTHOR
diff --git a/lib/Path/Class/File.pm b/lib/Path/Class/File.pm
index 8c5bdd5..0750927 100644
--- a/lib/Path/Class/File.pm
+++ b/lib/Path/Class/File.pm
@@ -4,7 +4,6 @@ $VERSION = '0.18';
use strict;
use Path::Class::Dir;
-use Path::Class::Entity;
use base qw(Path::Class::Entity);
use IO::File ();
@@ -20,12 +19,16 @@ sub new {
push @dirs, $self->_spec->catpath($volume, $dirs, '');
}
- $self->{dir} = @dirs ? Path::Class::Dir->new(@dirs) : undef;
+ $self->{dir} = @dirs ? $self->dir_class->new(@dirs) : undef;
$self->{file} = $base;
return $self;
}
+sub dir_class {
+ return "Path::Class::Dir";
+}
+
sub as_foreign {
my ($self, $type) = @_;
local $Path::Class::Foreign = $self->_spec_class($type);
@@ -44,7 +47,7 @@ sub stringify {
sub dir {
my $self = shift;
return $self->{dir} if defined $self->{dir};
- return Path::Class::Dir->new($self->_spec->curdir);
+ return $self->dir_class->new($self->_spec->curdir);
}
BEGIN { *parent = \&dir; }
@@ -317,6 +320,12 @@ C<File::stat> object representing the result.
Same as C<stat()>, but if C<$file> is a symbolic link, C<lstat()>
stats the link instead of the file the link points to.
+=item $class = $file->dir_class()
+
+Returns the class which should be used to create directory objects.
+
+Generally overriden by subclasses.
+
=back
=head1 AUTHOR
diff --git a/t/subclass.t b/t/subclass.t
new file mode 100644
index 0000000..fcd3cc1
--- /dev/null
+++ b/t/subclass.t
@@ -0,0 +1,36 @@
+#!/usr/bin/perl
+
+# Test subclassing of Path::Class
+
+use strict;
+use warnings;
+
+use Test::More tests => 6;
+
+{
+ package My::File;
+ use base qw(Path::Class::File);
+
+ sub dir_class { return "My::Dir" }
+}
+
+{
+ package My::Dir;
+ use base qw(Path::Class::Dir);
+
+ sub file_class { return "My::File" }
+}
+
+{
+ my $file = My::File->new("/path/to/some/file");
+ isa_ok $file, "My::File";
+ is $file->as_foreign("Unix"), "/path/to/some/file";
+
+ my $dir = $file->dir;
+ isa_ok $dir, "My::Dir";
+ is $dir->as_foreign("Unix"), "/path/to/some";
+
+ my $file_again = $dir->file("bar");
+ isa_ok $file_again, "My::File";
+ is $file_again->as_foreign("Unix"), "/path/to/some/bar";
+}
--
1.6.6.1
RT for rt.cpan.org