Web::Simple::Role

[catagits/Web-Simple.git] / t / role.t

diff --git a/t/role.t b/t/role.t
new file mode 100644 (file)
index 0000000..6da5181
--- /dev/null
+++ b/t/role.t
@@ -0,0 +1,53 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Test::More;
+
+{
+  package BazRole;
+  use Web::Simple::Role;
+
+  around dispatch_request => sub {
+    my ($orig, $self) = @_;
+    return (
+      $self->$orig,
+      sub (GET + /baz) {
+        [ 200,
+          [ "Content-type" => "text/plain" ],
+          [ 'baz' ],
+        ]
+      }
+    );
+  };
+}
+{
+  package FooBar;
+  use Web::Simple;
+  with 'BazRole';
+  sub dispatch_request {
+    sub (GET + /foo) {
+      [ 200,
+        [ "Content-type" => "text/plain" ],
+        [ 'foo' ],
+      ]
+    },
+    sub (GET + /bar) {
+      [ 200,
+        [ "Content-type" => "text/plain" ],
+        [ 'bar' ],
+      ]
+    },
+  }
+}
+
+use HTTP::Request::Common qw(GET POST);
+
+my $app = FooBar->new;
+sub run_request { $app->run_test_request(@_); }
+
+for my $word (qw/ foo bar baz /) {
+  my $get = run_request(GET "http://localhost/${word}");
+  is($get->content, $word, "Dispatch $word");
+}
+
+done_testing;