File Coverage

File:t/OpenAPI.pm
Coverage:87.5%

linestmtbrancondsubpodtimecode
1package t::OpenAPI;
2
3
22
22
22
22
289
93
297
use Test::Base -Base;
4
5#use Smart::Comments;
6my $client_module;
7
22
22
22
22
375
107
324
use OpenAPI::Config;
8BEGIN {
9
22
22
235
    OpenAPI::Config->init;
10
22
376
    my $use_http = $OpenAPI::Config{'test_suite.use_http'};
11
22
50
157
    if ($use_http) {
12
0
0
        $client_module = 'WWW::OpenAPI';
13
0
0
        require WWW::OpenAPI;
14    } else {
15
22
92
        $client_module = 'WWW::OpenAPI::Embedded';
16
22
312
        require WWW::OpenAPI::Embedded;
17    }
18}
19
22
22
22
22
319
93
258
use Test::LongString;
20
22
22
22
22
240
64
240
use Encode 'from_to';
21
22our @EXPORT = qw(init do_request run_tests run_test);
23
24
22
22
22
22
297
95
345
use Benchmark::Timer;
25my $timer = Benchmark::Timer->new();
26my $SavedCapture;
27
28our $host = $OpenAPI::Config{'test_suite.server'} || 'http://localhost';
29$host = "http://$host" if $host !~ m{^http://};
30
31my $client = $client_module->new({ server => $host, timer => $timer });
32
33#init();
34
35sub run_tests () {
36
21
21
0
255
    for my $block (blocks()) {
37
602
37515
        run_test($block);
38    }
39}
40
41sub run_test ($) {
42
602
602
0
5437
    my $block = shift;
43
602
7194
    my $name = $block->name;
44
602
39077
    my $request = $block->request;
45
602
50
26901
    if (!$request) {
46
0
0
        warn "No request section found in $name\n";
47
0
0
        return;
48    }
49
602
100
8798
    my $charset = $block->charset || 'UTF-8';
50
602
100
20297
    my $format = $block->format || 'JSON';
51
602
19609
    my $res_type = $block->res_type;
52
602
14640
    my $type = $block->request_type;
53
602
50
14622
    if ($request =~ /^(GET|POST|HEAD|PUT|DELETE)\s+([^\n]+)\s*\n(.*)/s) {
54
602
7364
        my ($method, $url, $body) = ($1, $2, $3);
55
602
3433
        $url =~ s/\$SavedCapture\b/$SavedCapture/g;
56
602
2502
        $body =~ s/\$SavedCapture\b/$SavedCapture/g;
57        ### $method
58        ### $url
59        ### $body
60        ### $host
61
602
3635
        $url = $host.$url;
62
602
100
4400
        from_to($url, 'UTF-8', $charset) unless $charset eq 'UTF-8';
63
602
100
3507
        from_to($body, 'UTF-8', $charset) unless $charset eq 'UTF-8';
64
602
5722
        $client->content_type($type);
65
602
4653
        my $res = $client->request($body, $method, $url);
66
602
178710
        ok $res->is_success, "request returns OK - $name";
67
602
67
608570
        my $expected_res = $block->response || $block->response_like;
68
602
100
67
47188
        if ($format eq 'JSON' and $expected_res) {
69
599
8846
            $expected_res =~ s/\n[ \t]*([^\n\s])/$1/sg;
70        }
71
602
50
5092
        if ($expected_res) {
72
602
100
9711
            if ($block->response_like) {
73
82
50
5961
                if ($res->content =~ qr/$expected_res/) {
74
82
100
9355
                    $SavedCapture = $1 if defined $1;
75                }
76
82
1009
                like $res->content, qr/$expected_res/, "$name - response matched";
77            } else {
78
520
100
25282
                from_to($expected_res, 'UTF-8', $charset) unless $charset eq 'UTF-8';
79
520
8115
                is $res->content, $expected_res, "response content OK - $name";
80            }
81        } else {
82
0
0
            is $res->content, $expected_res, "response content OK - $name";
83        }
84
602
100
518419
        if ($res_type) {
85
11
206
            is $res->header('Content-Type'), $res_type, "Content-Type in response ok - $name";
86        } else {
87
591
9899
            like $res->header('Content-Type'), qr/\Q; charset=$charset\E$/, "charset okay - $name";
88        }
89    } else {
90
0
        my ($firstline) = ($request =~ /^([^\n]*)/s);
91
0
        die "Invalid request head: \"$firstline\" in $name\n";
92    }
93}
94
95END {
96
22
22
22
22
266
74
400
    use YAML::Syck;
97
22
22
22
22
255
75
326
    use Hash::Merge 'merge';
98    #use Data::Dumper;
99    #warn scalar $timer->reports;
100    my $file = "t/cur-timer.dat";
101    my $cur_data = $timer->data;
102    if (!$cur_data) {
103        return;
104    }
105    $cur_data = { @$cur_data };
106    #warn Dumper($cur_data);
107    if (-f $file) {
108        my $last_data = LoadFile($file);
109        $cur_data = merge($cur_data, $last_data);
110    }
111    DumpFile($file, $cur_data);
112}
113
1141;
115