t/role.t

   1 use strict;
   2 use warnings FATAL => 'all';
   3
   4 use Test::More;
   5
   6 {
   7   package BazRole;
   8   use Web::Simple::Role;
   9
  10   around dispatch_request => sub {
  11     my ($orig, $self) = @_;
  12     return (
  13       $self->$orig,
  14       sub (GET + /baz) {
  15         [ 200,
  16           [ "Content-type" => "text/plain" ],
  17           [ 'baz' ],
  18         ]
  19       }
  20     );
  21   };
  22 }
  23 {
  24   package FooBar;
  25   use Web::Simple;
  26   with 'BazRole';
  27   sub dispatch_request {
  28     sub (GET + /foo) {
  29       [ 200,
  30         [ "Content-type" => "text/plain" ],
  31         [ 'foo' ],
  32       ]
  33     },
  34     sub (GET + /bar) {
  35       [ 200,
  36         [ "Content-type" => "text/plain" ],
  37         [ 'bar' ],
  38       ]
  39     },
  40   }
  41 }
  42
  43 use HTTP::Request::Common qw(GET POST);
  44
  45 my $app = FooBar->new;
  46 sub run_request { $app->run_test_request(@_); }
  47
  48 for my $word (qw/ foo bar baz /) {
  49   my $get = run_request(GET "http://localhost/${word}");
  50   is($get->content, $word, "Dispatch $word");
  51 }
  52
  53 done_testing;