Added path_to method

diff --git a/Changes b/Changes
index 37efc42..3412c6a 100644 (file)
--- a/Changes
+++ b/Changes
@@ -3,6 +3,7 @@ Tis file documents the revision history for Perl extension Catalyst.
 5.50
         - Whole new dispatcher!
         - Added index action
+        - Added path_to method
         - Added support for passing an IO::Handle object to $c->res->body.
           (Andrew Bramble)
         - Added a new welcome screen.

diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm
index b7bb450..aaa8624 100644 (file)
--- a/lib/Catalyst.pm
+++ b/lib/Catalyst.pm
@@ -263,6 +263,23 @@ sub forward { my $c = shift; $c->dispatcher->forward( $c, @_ ) }
 
 Accessor to the namespace of the current action
 
+=item $c->path_to(@path)
+
+Merges C<@path> with $c->config->{home} and returns a L<Path::Class> object.
+
+For example:
+
+    $c->path_to( 'db', 'sqlite.db' );
+
+=cut
+
+sub path_to {
+    my ( $c, @path ) = @_;
+    my $path = dir( $c->config->{home}, @path );
+    if ( -d $path ) { return $path }
+    else { return file( $c->config->{home}, @path ) }
+}
+
 =item $c->setup
 
 Setup.

diff --git a/t/unit/core/path_to.t b/t/unit/core/path_to.t
new file mode 100644 (file)
index 0000000..a21d7f9
--- /dev/null
+++ b/t/unit/core/path_to.t
@@ -0,0 +1,33 @@
+use strict;
+use warnings;
+
+use Test::More tests => 3;
+use Test::MockObject;
+
+my %non_unix = (
+    MacOS   => 1,
+    MSWin32 => 1,
+    os2     => 1,
+    VMS     => 1,
+    epoc    => 1,
+    NetWare => 1,
+    dos     => 1,
+    cygwin  => 1
+);
+
+my $os = $non_unix{$^O} ? $^O : 'Unix';
+
+plan skip_all => 'tests require Unix' unless $os eq 'Unix';
+
+my $context = Test::MockObject->new;
+
+use_ok('Catalyst');
+
+$context->mock( 'config', sub { { home => '/home/sri/my-app/' } } );
+
+is( Catalyst::path_to( $context, 'foo' ), '/home/sri/my-app/foo', 'Unix path' );
+
+$context->mock( 'config', sub { { home => '/Users/sri/myapp' } } );
+
+is( Catalyst::path_to( $context, 'foo', 'bar' ),
+    '/Users/sri/myapp/foo/bar', 'deep Unix path' );