sketch for httpmethods _ new psgi utils / tests
[catagits/Catalyst-Runtime.git] / t / http_method.t
CommitLineData
9c7b6768 1use warnings;
2use strict;
3
4# Test case to check that we now send scalar and filehandle like
5# bodys directly to the PSGI engine, rather than call $writer->write
6# or unroll the filehandle ourselves.
7
8{
9 package MyApp::Controller::User;
10
11 use base 'Catalyst::Controller';
12 use JSON::MaybeXS;
13
14 my %user = (
15 name => 'John',
16 age => 44,
17 );
18
19
20 sub get_user :Chained(/) PathPrefix CaptureArgs(0)
21 {
22 pop->stash(user=>\%user);
23 }
24
25 sub show :GET Chained(get_user) PathPart('') Args(0) {
26 my ($self, $c) = @_;
27 my $user = $c->stash->{user};
28 $c->res->format(
29 'application/json' => sub { encode_json $user },
30 'text/html' => sub { "<p>Hi I'm $user->{name} and my age is $user->{age}</p>" }
31 );
32 }
33
34 sub post_user :POST Chained(root) PathPart('') Args(0) Consumes(HTMLForm,JSON)
35 {
36 my ($self, $c) = @_;
37 %user = (%user, %{$c->req->body_data});
38 $c->res->status(201);
39 $c->res->location($c->uri_for( $self->action_for('show')));
40 }
41
42 $INC{'MyApp/Controller/User.pm'} = '1';
43
44 package MyApp;
45 use Catalyst;
46
47 use HTTP::Headers::ActionPack;
48
49 my $cn = HTTP::Headers::ActionPack->new
50 ->get_content_negotiator;
51
52 sub Catalyst::Response::format
53 {
54 my $self = shift;
55 my %formats = @_;
56 my @formats = keys %formats;
57
58 my $accept = $self->_context->req->header('Accept') ||
59 $format{default} ||
60 $_[0];
61
62 $self->headers->header('Vary' => 'Accept');
63 $self->headers->header('Accepts' => (join ',', @formats));
64
65 if(my $which = $cn->choose_media_type(\@formats, $accept)) {
66 $self->content_type($which);
67 if(my $possible_body = $formats{$which}->($self)) {
68 $self->body($possible_body) unless $self->has_body || $self->has_write_fh;
69 }
70 } else {
71 $self->status(406);
72 $self->body("Method Not Acceptable");
73 }
74 }
75
76
77 MyApp->setup;
78}
79
80
81
82use Devel::Dwarn;
83use Test::More;
84use HTTP::Request::Common;
85use Catalyst::Test 'MyApp';
86
87ok my($res, $c) = ctx_request('/');
88
89
90
91
92Dwarn(MyApp->dispatcher);
93
94done_testing();