Additional dispatcher tests from phaylon

diff --git a/t/lib/TestApp/Controller/Priorities.pm b/t/lib/TestApp/Controller/Priorities.pm
new file mode 100644 (file)
index 0000000..ec98d5b
--- /dev/null
+++ b/t/lib/TestApp/Controller/Priorities.pm
@@ -0,0 +1,75 @@
+package TestApp::Controller::Priorities;
+
+use strict;
+use base 'Catalyst::Base';
+
+#
+#   Regex vs. Local
+#
+
+sub re_vs_loc_re :Regex('/priorities/re_vs_loc') { $_[1]->res->body( 'regex' ) }
+sub re_vs_loc    :Local                          { $_[1]->res->body( 'local' ) }
+
+#
+#   Regex vs. LocalRegex
+#
+
+sub re_vs_locre_locre :LocalRegex('re_vs_(locre)')      { $_[1]->res->body( 'local_regex' ) }
+sub re_vs_locre_re    :Regex('/priorities/re_vs_locre') { $_[1]->res->body( 'regex' ) }
+
+#
+#   Regex vs. Path
+#
+
+sub re_vs_path_path :Path('/priorities/re_vs_path')  { $_[1]->res->body( 'path' ) }
+sub re_vs_path_re   :Regex('/priorities/re_vs_path') { $_[1]->res->body( 'regex' ) }
+
+#
+#   Local vs. LocalRegex
+#
+
+sub loc_vs_locre_locre :LocalRegex('loc_vs_locre') { $_[1]->res->body( 'local_regex' ) }
+sub loc_vs_locre       :Local                      { $_[1]->res->body( 'local' ) }
+
+#
+#   Local vs. Path (depends on definition order)
+#
+
+sub loc_vs_path1_loc :Path('/priorities/loc_vs_path1') { $_[1]->res->body( 'path' ) }
+sub loc_vs_path1     :Local                            { $_[1]->res->body( 'local' ) }
+
+sub loc_vs_path2     :Local                            { $_[1]->res->body( 'local' ) }
+sub loc_vs_path2_loc :Path('/priorities/loc_vs_path2') { $_[1]->res->body( 'path' ) }
+
+#
+#   Path vs. LocalRegex
+#
+
+sub path_vs_locre_locre :LocalRegex('path_vs_(locre)')     { $_[1]->res->body( 'local_regex' ) }
+sub path_vs_locre_path  :Path('/priorities/path_vs_locre') { $_[1]->res->body( 'path' ) }
+
+#
+#   Regex vs. index (has sub controller)
+#
+
+sub re_vs_idx :Regex('/priorities/re_vs_index') { $_[1]->res->body( 'regex' ) }
+
+#
+#   Local vs. index (has sub controller)
+#
+
+sub loc_vs_index :Local { $_[1]->res->body( 'local' ) }
+
+#
+#   LocalRegex vs. index (has sub controller)
+#
+
+sub locre_vs_idx :LocalRegex('locre_vs_index') { $_[1]->res->body( 'local_regex' ) }
+
+#
+#   Path vs. index (has sub controller)
+#
+
+sub path_vs_idx :Path('/priorities/path_vs_index') { $_[1]->res->body( 'path' ) }
+
+1;

diff --git a/t/lib/TestApp/Controller/Priorities/loc_vs_index.pm b/t/lib/TestApp/Controller/Priorities/loc_vs_index.pm
new file mode 100644 (file)
index 0000000..86a2ab1
--- /dev/null
+++ b/t/lib/TestApp/Controller/Priorities/loc_vs_index.pm
@@ -0,0 +1,8 @@
+package TestApp::Controller::Priorities::loc_vs_index;
+
+use strict;
+use base 'Catalyst::Base';
+
+sub index :Private { $_[1]->res->body( 'index' ) }
+
+1;

diff --git a/t/lib/TestApp/Controller/Priorities/locre_vs_index.pm b/t/lib/TestApp/Controller/Priorities/locre_vs_index.pm
new file mode 100644 (file)
index 0000000..db4cb0d
--- /dev/null
+++ b/t/lib/TestApp/Controller/Priorities/locre_vs_index.pm
@@ -0,0 +1,8 @@
+package TestApp::Controller::Priorities::locre_vs_index;
+
+use strict;
+use base 'Catalyst::Base';
+
+sub index :Private { $_[1]->res->body( 'index' ) }
+
+1;

diff --git a/t/lib/TestApp/Controller/Priorities/path_vs_index.pm b/t/lib/TestApp/Controller/Priorities/path_vs_index.pm
new file mode 100644 (file)
index 0000000..3a58c9e
--- /dev/null
+++ b/t/lib/TestApp/Controller/Priorities/path_vs_index.pm
@@ -0,0 +1,8 @@
+package TestApp::Controller::Priorities::path_vs_index;
+
+use strict;
+use base 'Catalyst::Base';
+
+sub index :Private { $_[1]->res->body( 'index' ) }
+
+1;

diff --git a/t/lib/TestApp/Controller/Priorities/re_vs_index.pm b/t/lib/TestApp/Controller/Priorities/re_vs_index.pm
new file mode 100644 (file)
index 0000000..67dfd1d
--- /dev/null
+++ b/t/lib/TestApp/Controller/Priorities/re_vs_index.pm
@@ -0,0 +1,8 @@
+package TestApp::Controller::Priorities::re_vs_index;
+
+use strict;
+use base 'Catalyst::Base';
+
+sub index :Private { $_[1]->res->body( 'index' ) }
+
+1;

diff --git a/t/live_priorities.t b/t/live_priorities.t
new file mode 100644 (file)
index 0000000..624aea2
--- /dev/null
+++ b/t/live_priorities.t
@@ -0,0 +1,76 @@
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More tests => 22;
+use Catalyst::Test 'TestApp';
+use Data::Dumper;
+
+local $^W = 0;
+
+my $uri_base = 'http://localhost/priorities';
+my @tests = (
+
+    #   Simple
+    'Regex vs. Local',      { path => '/re_vs_loc',      expect => 'local' },
+    'Regex vs. LocalRegex', { path => '/re_vs_locre',    expect => 'regex' },
+    'Regex vs. Path',       { path => '/re_vs_path',     expect => 'path' },
+    'Local vs. LocalRegex', { path => '/loc_vs_locre',   expect => 'local' },
+    'Local vs. Path 1',     { path => '/loc_vs_path1',   expect => 'local' },
+    'Local vs. Path 2',     { path => '/loc_vs_path2',   expect => 'path' },
+    'Path  vs. LocalRegex', { path => '/path_vs_locre',  expect => 'path' },
+
+    #   index
+    'index vs. Regex',      { path => '/re_vs_index',    expect => 'index' },
+    'index vs. Local',      { path => '/loc_vs_index',   expect => 'index' },
+    'index vs. LocalRegex', { path => '/locre_vs_index', expect => 'index' },
+    'index vs. Path',       { path => '/path_vs_index',  expect => 'index' },
+);
+
+while ( @tests ) {
+
+    my $name = shift @tests;
+    my $data = shift @tests;
+
+    #   Run tests for path with trailing slash and without
+  SKIP: for my $req_uri 
+    ( 
+        join( '' => $uri_base, $data->{ path } ),      # Without trailing path
+        join( '' => $uri_base, $data->{ path }, '/' ), # With trailing path
+    ) {
+        my $end_slash = ( $req_uri =~ qr(/$) ? 1 : 0 );
+
+        #   use slash_expect argument if URI ends with slash 
+        #   and the slash_expect argument is defined
+        my $expect = $data->{ expect } || '';
+        if ( $end_slash and exists $data->{ slash_expect } ) {
+            $expect = $data->{ slash_expect };
+        }
+
+        #   Call the URI on the TestApp
+        my $response = request( $req_uri );
+
+        #   Leave expect out to see the result
+        unless ( $expect ) {
+            skip 'Nothing expected, winner is ' . $response->content, 1;
+        }
+
+        #   Show error if response was no success
+        if ( not $response->is_success ) {
+            diag 'Error: ' . $response->headers->{ 'x-catalyst-error' };
+        }
+
+        #   Test if content matches expectations.
+        #   TODO This might flood the screen with the catalyst please-come-later
+        #        page. So I don't know it is a good idea.
+        is( $response->content, $expect,
+            "$name: @{[ $data->{ expect } ]} wins"
+            . ( $end_slash ? ' (trailing slash)' : '' )
+        );
+    }
+}
+