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