File: post.t

package info (click to toggle)
libweb-simple-perl 0.033-2
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 380 kB
  • sloc: perl: 1,622; makefile: 7
file content (128 lines) | stat: -rw-r--r-- 2,911 bytes parent folder | download | duplicates (4)
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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
use strict;
use warnings FATAL => 'all';

use Test::More qw(no_plan);

{
  use Web::Simple 'PostTest';
  package PostTest;
  sub dispatch_request {
    sub (%:foo=&:bar~) {
      $_[1]->{bar} ||= 'EMPTY';
      [ 200,
        [ "Content-type" => "text/plain" ],
        [ join(' ',@{$_[1]}{qw(foo bar)}) ]
      ]
    },
    sub (*baz=) {
      [ 200,
        [ "Content-type" => "text/plain" ],
        [ $_[1]->reason || $_[1]->filename ],
      ]
    },
    sub (POST + %* + %biff=) {
      $_[1]->{bar} ||= 'EMPTY';
      [ 200,
        [ "Content-type" => "text/plain" ],
        [ join(' ',@{$_[1]}{qw(biff bong)}) ]
      ]
    },
  }
}

use HTTP::Request::Common qw(GET POST);

my $app = PostTest->new;
sub run_request { $app->run_test_request(@_); }

my $get = run_request(GET 'http://localhost/');

cmp_ok($get->code, '==', 404, '404 on GET');

my $no_body = run_request(POST 'http://localhost/');

cmp_ok($no_body->code, '==', 404, '404 with empty body');

my $no_foo = run_request(POST 'http://localhost/' => [ bar => 'BAR' ]);

cmp_ok($no_foo->code, '==', 404, '404 with no foo param');

my $no_bar = run_request(POST 'http://localhost/' => [ foo => 'FOO' ]);

cmp_ok($no_bar->code, '==', 200, '200 with only foo param');

is($no_bar->content, 'FOO EMPTY', 'bar defaulted');

my $both = run_request(
  POST 'http://localhost/' => [ foo => 'FOO', bar => 'BAR' ]
);

cmp_ok($both->code, '==', 200, '200 with both params');

is($both->content, 'FOO BAR', 'both params returned');

my $upload = run_request(
  POST 'http://localhost'
    => Content_Type => 'form-data'
    => Content => [
      foo => 'FOO',
      bar => 'BAR'
    ]
);

cmp_ok($upload->code, '==', 200, '200 with multipart');

is($upload->content, 'FOO BAR', 'both params returned');

my $upload_splat = run_request(
  POST 'http://localhost'
    => Content_Type => 'form-data'
    => Content => [
      biff => 'frew',
      bong => 'fru'
    ]
);

cmp_ok($upload_splat->code, '==', 200, '200 with multipart');

is($upload_splat->content, 'frew fru', 'both params returned');

my $upload_wrongtype = run_request(
  POST 'http://localhost'
    => [ baz => 'fleem' ]
);

is(
  $upload_wrongtype->content,
  'field baz exists with value fleem but body was not multipart/form-data',
  'error points out wrong body type'
);

my $upload_notupload = run_request(
  POST 'http://localhost'
    => Content_Type => 'form-data'
    => Content => [ baz => 'fleem' ]
);

is(
  $upload_notupload->content,
  'field baz exists with value fleem but was not an upload',
  'error points out field was not an upload'
);

my $upload_isupload = run_request(
  POST 'http://localhost'
    => Content_Type => 'form-data'
    => Content => [
      baz => [
        undef, 'TESTFILE',
        Content => 'test content', 'Content-Type' => 'text/plain'
      ],
    ]
);

is(
  $upload_isupload->content,
  'TESTFILE',
  'Actual upload returns filename ok'
);