add Existing* types

diff --git a/lib/MooseX/Types/Path/Class.pm b/lib/MooseX/Types/Path/Class.pm
index e47b779..985485f 100644 (file)
--- a/lib/MooseX/Types/Path/Class.pm
+++ b/lib/MooseX/Types/Path/Class.pm
@@ -10,7 +10,7 @@ use Path::Class ();
 # TODO: export dir() and file() from Path::Class? (maybe)
 
 use MooseX::Types
-    -declare => [qw( Dir File )];
+    -declare => [qw( Dir File ExistingDir ExistingFile )];
 
 use MooseX::Types::Moose qw(Str ArrayRef);
 
@@ -20,13 +20,19 @@ class_type('Path::Class::File');
 subtype Dir, as 'Path::Class::Dir';
 subtype File, as 'Path::Class::File';
 
-for my $type ( 'Path::Class::Dir', Dir ) {
+subtype ExistingFile, as File, where { -e $_->stringify },
+  message { "File '$_' must exist." };
+
+subtype ExistingDir, as Dir, where { -e $_->stringify && -d $_->stringify },
+  message { "Directory '$_' must exist" };
+
+for my $type ( 'Path::Class::Dir', Dir, ExistingDir ) {
     coerce $type,
         from Str,      via { Path::Class::Dir->new($_) },
         from ArrayRef, via { Path::Class::Dir->new(@$_) };
 }
 
-for my $type ( 'Path::Class::File', File ) {
+for my $type ( 'Path::Class::File', File, ExistingFile ) {
     coerce $type,
         from Str,      via { Path::Class::File->new($_) },
         from ArrayRef, via { Path::Class::File->new(@$_) };
@@ -36,7 +42,7 @@ for my $type ( 'Path::Class::File', File ) {
 eval { require MooseX::Getopt; };
 if ( !$@ ) {
     MooseX::Getopt::OptionTypeMap->add_option_type_to_map( $_, '=s', )
-        for ( 'Path::Class::Dir', 'Path::Class::File', Dir, File, );
+        for ( 'Path::Class::Dir', 'Path::Class::File', Dir, File, ExistingDir, ExistingFile );
 }
 
 1;
@@ -73,7 +79,7 @@ MooseX::Types::Path::Class - A Path::Class type library for Moose
   # appropriate Path::Class objects
   MyClass->new( dir => '/some/directory/', file => '/some/file' );
 
-  
+
 =head1 DESCRIPTION
 
 MooseX::Types::Path::Class creates common L<Moose> types,
@@ -116,6 +122,12 @@ These exports can be used instead of the full class names.  Example:
       coerce   => 1,
   );
 
+=item ExistingDir, ExistingFile
+
+Like File and Dir, but the files or directories must exist on disk
+when the type is checked, and the object on disk must be a file (for
+ExistingFile) or directory (for ExistingDir).
+
 Note that there are no quotes around Dir or File.
 
 =item is_Dir($value), is_File($value)

diff --git a/t/04.existing.t b/t/04.existing.t
new file mode 100644 (file)
index 0000000..8292d9c
--- /dev/null
+++ b/t/04.existing.t
@@ -0,0 +1,14 @@
+use strict;
+use warnings;
+use Test::More;
+
+plan skip_all => "Preconditions failed; your filesystem is strange"
+  unless -d "/etc" && -e "/etc/passwd";
+
+use MooseX::Types::Path::Class qw(ExistingFile ExistingDir);
+
+ok is_ExistingFile(to_ExistingFile("/etc/passwd")), '/etc/passwd is an existing file';
+
+ok is_ExistingDir(to_ExistingDir("/etc/")), '/etc/ is an existing directory';
+
+done_testing;