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
|
package Reaction::Test;
use base qw/Test::Class Reaction::Object/;
use Reaction::Class;
sub simple_mock_context {
my ($q_p, $b_p, $path) = ({}, {}, 'test/path');
my $req = bless({
query_parameters => sub { $q_p }, body_parameters => sub { $b_p },
path => sub { shift; $path = shift if @_; $path; },
}, 'Reaction::Test::Mock::Request');
my %res_info = (content_type => '', body => '', status => 200, headers => {});
my $res = bless({
(map {
my $key = $_;
($key => sub { shift; $res_info{$key} = shift if @_; $res_info{$key} });
} keys %res_info),
header => sub {
shift; my $h = shift;
$res_info{headers}{$h} = shift if @_;
$res_info{headers}{$h};
},
}, 'Reaction::Test::Mock::Response');
return bless({
req => sub { $req }, res => sub { $res },
}, 'Reaction::Test::Mock::Context');
}
=head1 NAME
Reaction::Test
=head1 DESCRIPTION
=head1 AUTHORS
See L<Reaction::Class> for authors.
=head1 LICENSE
See L<Reaction::Class> for the license.
=cut
package Reaction::Test::Mock::Context;
sub isa {
shift; return 1 if (shift eq 'Catalyst');
}
sub view {
return $_[0]->{view}->(@_);
}
sub req {
return $_[0]->{req}->(@_);
}
sub res {
return $_[0]->{res}->(@_);
}
package Reaction::Test::Mock::Request;
sub query_parameters {
return $_[0]->{query_parameters}->(@_);
}
sub body_parameters {
return $_[0]->{body_parameters}->(@_);
}
sub path {
return $_[0]->{path}->(@_);
}
package Reaction::Test::Mock::Response;
sub body {
return $_[0]->{body}->(@_);
}
sub content_type {
return $_[0]->{content_type}->(@_);
}
sub status {
return $_[0]->{status}->(@_);
}
sub headers {
return $_[0]->{headers}->(@_);
}
sub header {
return $_[0]->{header}->(@_);
}
1;
|
