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
|
package TestWebApp;
use base qw(CGI::Application);
use CGI::Application::Plugin::JSON qw(to_json);
use CGI::Application::Plugin::AJAXUpload;
use File::Temp;
use Test::More;
use Test::Warn;
$ENV{CGI_APP_RETURN_ONLY} = 1;
sub setup {
my $self = shift;
$self->header_props(-encoding=>'utf-8',-charset=>'utf-8');
if ($self->param('document_root')) {
my $setup = $self->param('document_root');
$self->$setup();
}
else {
$self->{_TESTWEBAPP_TEMPDIR} = File::Temp->newdir();
my $httpdocs_dir = $self->{_TESTWEBAPP_TEMPDIR}->dirname;
mkdir "${httpdocs_dir}/img";
mkdir "${httpdocs_dir}/img/uploads";
$self->ajax_upload_httpdocs($httpdocs_dir);
}
if ($self->param('ajax_spec')) {
$self->ajax_upload_setup(%{$self->param('ajax_spec')});
}
else {
$self->ajax_upload_setup();
}
return;
}
sub response_like {
my $self = shift;
my $header_re = shift;
my $body_re = shift;
my $comment = shift;
my $warning_re = shift;
my $output = undef;
if ($warning_re) {
warning_like {$output = $self->run;} $warning_re, "warning: $comment";
}
else {
$output = $self->run;
}
my ($header, $body) = split /\r\n\r\n/, $output;
like($header, $header_re, "$comment (header match)");
like($body, $body_re, "$comment (body match)");
return;
}
1
|
