t/http_method.t

   1 use warnings;
   2 use 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
  82 use Devel::Dwarn;
  83 use Test::More;
  84 use HTTP::Request::Common;
  85 use Catalyst::Test 'MyApp';
  86
  87 ok my($res, $c) = ctx_request('/');
  88
  89
  90
  91
  92 Dwarn(MyApp->dispatcher);
  93
  94 done_testing();