X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FUtils.pm;h=98abdb1c1d6ecf4370e4c1452e4566e13adcc831;hb=3ad654e0c538876403f3e664f0d9f302ef470770;hp=e4c5db800c3d65320edfdf36d0923d2359f95589;hpb=d837e1a7eadff19ff04373ad19d22fa293e19db5;p=catagits%2FCatalyst-Runtime.git diff --git a/lib/Catalyst/Utils.pm b/lib/Catalyst/Utils.pm index e4c5db8..98abdb1 100644 --- a/lib/Catalyst/Utils.pm +++ b/lib/Catalyst/Utils.pm @@ -2,6 +2,7 @@ package Catalyst::Utils; use strict; use attributes (); +use Catalyst::Exception; use HTTP::Request; use Path::Class; use URI; @@ -79,7 +80,22 @@ sub class2classsuffix { return $class; } -=item class2prefix($class); +=item class2env($class); + +Returns the enviroment name for class. + + MyApp becomes MYAPP + My::App becomes MY_APP + +=cut + +sub class2env { + my $class = shift || ''; + my $class =~ s/\:\:/_/g; + return uc($class); +} + +=item class2prefix( $class, $case ); Returns the prefix for class. @@ -89,9 +105,10 @@ Returns the prefix for class. sub class2prefix { my $class = shift || ''; + my $case = shift || 0; my $prefix; if ( $class =~ /^.*::([MVC]|Model|View|Controller)?::(.*)$/ ) { - $prefix = lc $2; + $prefix = $case ? $2 : lc $2; $prefix =~ s/\:\:/\//g; } return $prefix; @@ -119,6 +136,12 @@ sub home { { $home = $subdir; } + # clean up relative path: + # MyApp/script/.. -> MyApp + my ($lastdir) = $home->dir_list( -1, 1 ); + if ( $lastdir eq '..' ) { + $home = dir($home)->parent->parent; + } } return $home; } @@ -148,12 +171,16 @@ sub reflect_actions { my $class = shift; my $actions = []; eval '$actions = $class->_action_cache'; - die qq/Couldn't reflect actions of component "$class", "$@"/ if $@; + + if ( $@ ) { + Catalyst::Exception->throw( + message => qq/Couldn't reflect actions of component "$class", "$@"/ + ); + } + return $actions; } -=back - =item request($string); Returns an C from a string.