X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst%2FUtils.pm;fp=lib%2FCatalyst%2FUtils.pm;h=440d9e9c7867fc821441c251ea06309a2653bd15;hp=6ba6f86dc9287490ea5fe75a790f731a22baea6b;hb=a8946dc8b4ba4c46b4db564b8f9692d48cc7a62f;hpb=7f0a549ee025a2057aa4a760b6f4ef4f54ec36a3 diff --git a/lib/Catalyst/Utils.pm b/lib/Catalyst/Utils.pm index 6ba6f86..440d9e9 100644 --- a/lib/Catalyst/Utils.pm +++ b/lib/Catalyst/Utils.pm @@ -6,10 +6,9 @@ use HTTP::Request; use Path::Class; use URI; use Carp qw/croak/; +use Cwd; use Class::MOP; use String::RewritePrefix; -use List::MoreUtils qw/ any /; -use Cwd qw/ cwd /; use namespace::clean; @@ -155,24 +154,21 @@ sub class2tempdir { return $tmpdir->stringify; } +=head2 home($class) + +Returns home directory for given class. + =head2 dist_indicator_file_list -Returns a list of files which can be tested to check if you're inside a checkout +Returns a list of files which can be tested to check if you're inside +a checkout =cut sub dist_indicator_file_list { - qw/ Makefile.PL Build.PL dist.ini /; + qw{Makefile.PL Build.PL dist.ini}; } -=head2 home($class) - -Returns home directory for given class. - -Note that the class must be loaded for the home directory to be found using this function. - -=cut - sub home { my $class = shift; @@ -185,8 +181,25 @@ sub home { # find the @INC entry in which $file was found (my $path = $inc_entry) =~ s/$file$//; - my $home = find_home_unloaded_in_checkout($path); - return $home if $home; + $path ||= cwd() if !defined $path || !length $path; + my $home = dir($path)->absolute->cleanup; + + # pop off /lib and /blib if they're there + $home = $home->parent while $home =~ /b?lib$/; + + # only return the dir if it has a Makefile.PL or Build.PL or dist.ini + if (grep { -f $home->file($_) } dist_indicator_file_list()) { + # clean up relative path: + # MyApp/script/.. -> MyApp + + my $dir; + my @dir_list = $home->dir_list(); + while (($dir = pop(@dir_list)) && $dir eq '..') { + $home = dir($home)->parent->parent; + } + + return $home->stringify; + } } { @@ -202,45 +215,7 @@ sub home { } # we found nothing - return; -} - -=head2 find_home_unloaded_in_checkout ($path) - -Tries to determine if C<$path> (or the current working directory if not supplied) -looks like a checkout. Any leading lib, script or blib components -will be removed, then the directory produced will be checked -for the existence of a C<< dist_indicator_file_list() >>. - -If one is found, the directory will be returned, otherwise false. - -=cut - -# XXX - Is this actually sane - should we just split into two simpler routines -# one for when we do have an @INC entry and one for when we don't? -sub find_home_unloaded_in_checkout { - my ($path) = @_; - $path ||= cwd() if !defined $path || !length $path; - my $home = dir($path)->absolute->cleanup; - my $last_home; - do { - # only return the dir if it has a Makefile.PL or Build.PL or dist.ini - if (any { $_ } map { -f $home->file($_) } dist_indicator_file_list()) { - # clean up relative path: - # MyApp/script/.. -> MyApp - - my $dir; - my @dir_list = $home->dir_list(); - while (($dir = pop(@dir_list)) && $dir eq '..') { - $home = dir($home)->parent->parent; - } - return $home->stringify; - } - $last_home = $home; - $home = $home->parent; - } - while # pop off /lib and /blib or /script or /t/ if they're there - ($last_home =~ /b?lib$/ || $last_home =~ /script$/ || $last_home =~ /\/t(\/|$)/); + return 0; } =head2 prefix($class, $name);