From: David Kamholz <dkamholz@cpan.org>
Date: Thu, 19 Oct 2006 17:03:13 +0000 (+0000)
Subject: clean up Catalyst::Utils and fix a couple bugs in it, add some tests
X-Git-Tag: 5.7099_04~317
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=0ef447d8c6880fa4dda2648aa19a005245ef036a

clean up Catalyst::Utils and fix a couple bugs in it, add some tests
---

diff --git a/lib/Catalyst/Utils.pm b/lib/Catalyst/Utils.pm
index 9e389e3..456497f 100644
--- a/lib/Catalyst/Utils.pm
+++ b/lib/Catalyst/Utils.pm
@@ -28,22 +28,22 @@ See L<Catalyst>.
 
 sub appprefix {
     my $class = shift;
-    $class =~ s/\:\:/_/g;
+    $class =~ s/::/_/g;
     $class = lc($class);
     return $class;
 }
 
 =head2 class2appclass($class);
 
-    MyApp::C::Foo::Bar becomes MyApp
-    My::App::C::Foo::Bar becomes My::App
+    MyApp::Controller::Foo::Bar becomes MyApp
+    My::App::Controller::Foo::Bar becomes My::App
 
 =cut
 
 sub class2appclass {
     my $class = shift || '';
     my $appname = '';
-    if ( $class =~ /^(.*)::([MVC]|Model|View|Controller)?::.*$/ ) {
+    if ( $class =~ /^(.+?)::([MVC]|Model|View|Controller)::.+$/ ) {
         $appname = $1;
     }
     return $appname;
@@ -51,15 +51,15 @@ sub class2appclass {
 
 =head2 class2classprefix($class);
 
-    MyApp::C::Foo::Bar becomes MyApp::C
-    My::App::C::Foo::Bar becomes My::App::C
+    MyApp::Controller::Foo::Bar becomes MyApp::Controller
+    My::App::Controller::Foo::Bar becomes My::App::Controller
 
 =cut
 
 sub class2classprefix {
     my $class = shift || '';
     my $prefix;
-    if ( $class =~ /^(.*::[MVC]|Model|View|Controller)?::.*$/ ) {
+    if ( $class =~ /^(.+?::([MVC]|Model|View|Controller))::.+$/ ) {
         $prefix = $1;
     }
     return $prefix;
@@ -67,14 +67,14 @@ sub class2classprefix {
 
 =head2 class2classsuffix($class);
 
-    MyApp::C::Foo::Bar becomes C::Foo::Bar
+    MyApp::Controller::Foo::Bar becomes Controller::Foo::Bar
 
 =cut
 
 sub class2classsuffix {
     my $class = shift || '';
     my $prefix = class2appclass($class) || '';
-    $class =~ s/$prefix\:\://;
+    $class =~ s/$prefix\:://;
     return $class;
 }
 
@@ -89,7 +89,7 @@ Returns the environment name for class.
 
 sub class2env {
     my $class = shift || '';
-    $class =~ s/\:\:/_/g;
+    $class =~ s/::/_/g;
     return uc($class);
 }
 
@@ -97,7 +97,7 @@ sub class2env {
 
 Returns the uri prefix for a class. If case is false the prefix is converted to lowercase.
 
-    My::App::C::Foo::Bar becomes foo/bar
+    My::App::Controller::Foo::Bar becomes foo/bar
 
 =cut
 
@@ -105,9 +105,9 @@ sub class2prefix {
     my $class = shift || '';
     my $case  = shift || 0;
     my $prefix;
-    if ( $class =~ /^.*::([MVC]|Model|View|Controller)?::(.*)$/ ) {
+    if ( $class =~ /^.+?::([MVC]|Model|View|Controller)::(.+)$/ ) {
         $prefix = $case ? $2 : lc $2;
-        $prefix =~ s/\:\:/\//g;
+        $prefix =~ s{::}{/}g;
     }
     return $prefix;
 }
@@ -199,7 +199,7 @@ sub home {
 
 Returns a prefixed action.
 
-    MyApp::C::Foo::Bar, yada becomes foo/bar/yada
+    MyApp::Controller::Foo::Bar, yada becomes foo/bar/yada
 
 =cut
 
@@ -272,17 +272,17 @@ sub merge_hashes {
     return $lefthash unless defined $righthash;
     
     my %merged = %$lefthash;
-    for my $key ( keys %$righthash ) {
-        my $right_ref = ( ref $righthash->{ $key } || '' ) eq 'HASH';
-        my $left_ref  = ( ( exists $lefthash->{ $key } && ref $lefthash->{ $key } ) || '' ) eq 'HASH';
-        if( $right_ref and $left_ref ) {
+    for my $key ( keys %$righthash ) {
+        my $right_ref = ( ref $righthash->{ $key } || '' ) eq 'HASH';
+        my $left_ref  = ( ( exists $lefthash->{ $key } && ref $lefthash->{ $key } ) || '' ) eq 'HASH';
+        if( $right_ref and $left_ref ) {
             $merged{ $key } = merge_hashes(
                 $lefthash->{ $key }, $righthash->{ $key }
-            );
+            );
         }
         else {
             $merged{ $key } = $righthash->{ $key };
-        }
+        }
     }
     
     return \%merged;
diff --git a/t/unit_utils_prefix.t b/t/unit_utils_prefix.t
new file mode 100644
index 0000000..63429b7
--- /dev/null
+++ b/t/unit_utils_prefix.t
@@ -0,0 +1,26 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 7;
+
+use lib "t/lib";
+
+BEGIN { use_ok("Catalyst::Utils") };
+
+is( Catalyst::Utils::class2prefix('MyApp::V::Foo::Bar'), 'foo/bar', 'class2prefix works with M/V/C' );
+
+is( Catalyst::Utils::class2prefix('MyApp::Controller::Foo::Bar'), 'foo/bar', 'class2prefix works with Model/View/Controller' );
+
+is( Catalyst::Utils::class2prefix('MyApp::Controller::Foo::View::Bar'), 'foo/view/bar', 'class2prefix works with tricky components' );
+
+is( Catalyst::Utils::appprefix('MyApp::Foo'), 'myapp_foo', 'appprefix works' );
+
+is( Catalyst::Utils::class2appclass('MyApp::Foo::Controller::Bar::View::Baz'), 'MyApp::Foo', 'class2appclass works' );
+
+is( Catalyst::Utils::class2classprefix('MyApp::Foo::Controller::Bar::View::Baz'), 'MyApp::Foo::Controller', 'class2classprefix works' );
+
+is( Catalyst::Utils::class2classsuffix('MyApp::Foo::Controller::Bar::View::Baz'), 'Controller::Bar::View::Baz', 'class2classsuffix works' );
+
+is( Catalyst::Utils::class2env('MyApp::Foo'), 'MYAPP_FOO', 'class2env works' );