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
|
package Plack::Test::Adopt::Catalyst;
use strict;
use Catalyst::Engine::PSGI;
BEGIN { $ENV{CATALYST_ENGINE} = 'PSGI' };
use Class::MOP;
use Test::TCP;
use App::Prove;
use Plack::Loader;
sub import {
my($self, $class) = @_;
my $caller = caller;
no strict; ## no critic
*{"$caller\::runtests"} = make_runtests($class);
}
sub make_runtests {
my $class = shift;
return sub {
my @tests = @_;
my %apps2tests = analyze_tests($class, @tests);
while (my($app_class, $tests) = each %apps2tests) {
warn "Testing $app_class\n";
Class::MOP::load_class($app_class);
my $app = sub { $app_class->run(@_) };
test_tcp(
client => sub {
my $port = shift;
$ENV{CATALYST_SERVER} = "http://127.0.0.1:$port/";
my $p = App::Prove->new;
$p->process_args(@$tests);
$p->run;
},
server => sub {
my $port = shift;
Plack::Loader->auto(port => $port, host => "127.0.0.1")->run($app);
},
);
}
};
}
sub analyze_tests {
my($class, @tests) = @_;
my %map;
for my $test (@tests) {
my $cat_app_class = test_app_for($test) || $class;
push @{$map{$cat_app_class}}, $test;
}
return %map;
}
sub test_app_for {
my $test = shift;
open my $fh, "<", $test or return;
while (<$fh>) {
m@^\s*use Catalyst::Test (?:q[qw]?)?[/'"\(]?\s*([a-zA-Z0-9:]+)@
and return $1;
}
return;
}
1;
__END__
=head1 NAME
Plack::Test::Adopt::Catalyst - Run Catalyst::Test based tests against Plack implementations
=head1 SYNOPSIS
env PLACK_SERVER=Standalone \
perl -MPlack::Test::Adopt::Catalyst=TestApp -e 'runtests @ARGV' *.t
=head1 AUTHOR
Tatsuhiko Miyagawa
=head1 SEE ALSO
L<Catalyst::Test> L<Plack::Test>
=cut
|
