X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst%2FUtils.pm;h=4e5571e1536dc1384886fbb2018a3a3b02625041;hp=9dc2c09a4a7b9fa8e35c219a87e935e544cf162f;hb=059c085bfcead450e70ace9ef193aa99ac2ab37d;hpb=f4c0f6f787fe962604cf62cf7ad7c87f0c59b673 diff --git a/lib/Catalyst/Utils.pm b/lib/Catalyst/Utils.pm index 9dc2c09..4e5571e 100644 --- a/lib/Catalyst/Utils.pm +++ b/lib/Catalyst/Utils.pm @@ -7,6 +7,7 @@ use HTTP::Request; use Path::Class; use URI; use Class::Inspector; +use Carp qw/croak/; =head1 NAME @@ -22,7 +23,7 @@ See L. =head2 appprefix($class) - MyApp::Foo becomes myapp_foo + MyApp::Foo becomes myapp_foo =cut @@ -170,8 +171,9 @@ sub home { # 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; } @@ -232,16 +234,30 @@ sub request { return $request; } -=head2 ensure_class_loaded($class_name) +=head2 ensure_class_loaded($class_name, \%opts) Loads the class unless it already has been loaded. +If $opts{ignore_loaded} is true always tries the require whether the package +already exists or not. Only pass this if you're either (a) sure you know the +file exists on disk or (b) have code to catch the file not found exception +that will result if it doesn't. + =cut sub ensure_class_loaded { my $class = shift; my $opts = shift; + croak "Malformed class Name $class" + if $class =~ m/(?:\b\:\b|\:{3,})/; + + croak "Malformed class Name $class" + if $class =~ m/[^\w:]/; + + croak "ensure_class_loaded should be given a classname, not a filename ($class)" + if $class =~ m/\.pm$/; + return if !$opts->{ ignore_loaded } && Class::Inspector->loaded( $class ); # if a symbol entry exists we don't load again @@ -249,7 +265,9 @@ sub ensure_class_loaded { my $error; { local $@; - eval "require $class"; + my $file = $class . '.pm'; + $file =~ s{::}{/}g; + eval { CORE::require($file) }; $error = $@; } @@ -288,6 +306,28 @@ sub merge_hashes { return \%merged; } +=head2 env_value($class, $key) + +Checks for and returns an environment value. For instance, if $key is +'home', then this method will check for and return the first value it finds, +looking at $ENV{MYAPP_HOME} and $ENV{CATALYST_HOME}. + +=cut + +sub env_value { + my ( $class, $key ) = @_; + + $key = uc($key); + my @prefixes = ( class2env($class), 'CATALYST' ); + + for my $prefix (@prefixes) { + if ( defined( my $value = $ENV{"${prefix}_${key}"} ) ) { + return $value; + } + } + + return; +} =head1 AUTHOR