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
|
#!perl -T
use Test::More tests => 6;
use strict;
use warnings;
BEGIN { use_ok('CGI::Application::Plugin::AutoRunmode') };
$ENV{CGI_APP_RETURN_ONLY} = 1;
{
package MyTestApp;
use base 'CGI::Application';
use CGI::Application::Plugin::AutoRunmode
qw [ cgiapp_prerun ]; # for CGI::App 3 compatibility
sub mode1 : StartRunmode {
'called mode1';
}
sub mode2 {
'called mode2 in the super class'
}
}
{
package MyTestSubApp;
use base 'MyTestApp';
sub mode2 : StartrunMode {
'called mode2 in the sub class';
}
}
{
package MyTestSubAppWithStartCalledStart;
use base 'MyTestApp';
sub start : StartrunMode {
'called start mode called start';
}
}
{
my $testname = "autodetect startrunmode ";
my $app = new MyTestApp();
my $t = $app->run;
ok ($t =~ /called mode1/, $testname);
}
{
my $testname = "autodetect startrunmode in subclass and case-insensitive ";
my $app = new MyTestSubApp();
my $t = $app->run;
ok ($t =~ /called mode2 in the sub class/, $testname);
}
{
my $testname = "cannot install two StartRunmodes ";
eval <<'CODE';
package MyTestAppBroken;
use base 'CGI::Application';
use CGI::Application::Plugin::AutoRunmode;
sub mode1 : StartRunmode {
'called mode1';
}
sub mode2 : StartRunmode {
'called mode2';
}
CODE
ok ($@ =~ /StartRunmode for package MyTestAppBroken is already installed/, $testname);
}
TODO:
{
{
my $testname = "autodetect startrunmode called start";
local $TODO = 'you cannot have a runmode called start, because CGI::App already registers one';
my $app = new MyTestApp();
my $t = $app->run;
ok ($t =~ /called start mode called start/, $testname);
}
{
my $testname = "override startrunmode per instance";
local $TODO = 'http://rt.cpan.org/Ticket/Display.html?id=23966';
my $app = new MyTestApp();
$app->start_mode('mode2');
my $t = $app->run;
ok ($t =~ /called mode2 in the super class/, $testname)
or diag $t;
}
}
|
