[Catalyst-commits] r7576 - in Catalyst-Runtime/5.70/trunk: . lib/Catalyst t t/something t/something/script t/something/script/foo

[marcus at dev.catalyst.perl.org]

Author: marcus
Date: 2008-04-06 20:42:48 +0100 (Sun, 06 Apr 2008)
New Revision: 7576

Added:
   Catalyst-Runtime/5.70/trunk/t/something/
   Catalyst-Runtime/5.70/trunk/t/something/Makefile.PL
   Catalyst-Runtime/5.70/trunk/t/something/script/
   Catalyst-Runtime/5.70/trunk/t/something/script/foo/
   Catalyst-Runtime/5.70/trunk/t/something/script/foo/bar/
   Catalyst-Runtime/5.70/trunk/t/unit_utils_subdir.t
Modified:
   Catalyst-Runtime/5.70/trunk/Changes
   Catalyst-Runtime/5.70/trunk/lib/Catalyst/Utils.pm
Log:
Patch to fix homefinding for scripts in deep subdirs

Modified: Catalyst-Runtime/5.70/trunk/Changes
===================================================================
--- Catalyst-Runtime/5.70/trunk/Changes	2008-04-06 14:51:36 UTC (rev 7575)
+++ Catalyst-Runtime/5.70/trunk/Changes	2008-04-06 19:42:48 UTC (rev 7576)
@@ -1,6 +1,7 @@
 # This file documents the revision history for Perl extension Catalyst.
 
 5.7013
+        - Fix subdirs for scripts that run in subdirs more than one level deep.
         - Added test and updated docs for handling the Authorization header
           under mod_fastcgi/mod_cgi.
         - Fixed bug in HTTP engine where the connection was not closed properly if the

Modified: Catalyst-Runtime/5.70/trunk/lib/Catalyst/Utils.pm
===================================================================
--- Catalyst-Runtime/5.70/trunk/lib/Catalyst/Utils.pm	2008-04-06 14:51:36 UTC (rev 7575)
+++ Catalyst-Runtime/5.70/trunk/lib/Catalyst/Utils.pm	2008-04-06 19:42:48 UTC (rev 7576)
@@ -171,8 +171,9 @@
                 # clean up relative path:
                 # MyApp/script/.. -> MyApp
 
-                my ($lastdir) = $home->dir_list( -1, 1 );
-                if ( $lastdir eq '..' ) {
+                my $dir;
+                my @dir_list = $home->dir_list();
+                while (($dir = pop(@dir_list)) && $dir eq '..') {
                     $home = dir($home)->parent->parent;
                 }
 

Added: Catalyst-Runtime/5.70/trunk/t/something/Makefile.PL
===================================================================

Added: Catalyst-Runtime/5.70/trunk/t/unit_utils_subdir.t
===================================================================
--- Catalyst-Runtime/5.70/trunk/t/unit_utils_subdir.t	                        (rev 0)
+++ Catalyst-Runtime/5.70/trunk/t/unit_utils_subdir.t	2008-04-06 19:42:48 UTC (rev 7576)
@@ -0,0 +1,26 @@
+use Test::More tests=>7;
+
+use strict;
+use warnings;
+
+# simulates an entire testapp rooted at t/something
+# except without bothering creating it since its
+# only the -e check on the Makefile.PL that matters
+
+BEGIN { use_ok 'Catalyst::Utils' }
+use FindBin;
+
+$INC{'TestApp.pm'} = "$FindBin::Bin/something/script/foo/../../lib/TestApp.pm";
+my $home = Catalyst::Utils::home('TestApp');
+like($home, qr/t\/something/, "has path TestApp/t/something"); 
+unlike($home, qr/\/script\/foo/, "doesn't have path /script/foo");
+
+$INC{'TestApp.pm'} = "$FindBin::Bin/something/script/foo/bar/../../../lib/TestApp.pm";
+$home = Catalyst::Utils::home('TestApp');
+like($home, qr/t\/something/, "has path TestApp/t/something"); 
+unlike($home, qr/\/script\/foo\/bar/, "doesn't have path /script/foo");
+
+$INC{'TestApp.pm'} = "$FindBin::Bin/something/script/../lib/TestApp.pm";
+$home = Catalyst::Utils::home('TestApp');
+like($home, qr/t\/something/, "has path TestApp/t/something"); 
+unlike($home, qr/\/script\/foo/, "doesn't have path /script/foo");