Commit | Line | Data |
01183e70 |
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; |