File Coverage

blib/lib/Eve/HttpResourceGraphTestBase.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             # -*- mode: Perl; -*-
2             package Eve::HttpResourceGraphTestBase;
3              
4 1     1   1546 use parent qw(Eve::Test);
  1         2  
  1         8  
5              
6 1     1   39 use strict;
  1         2  
  1         26  
7 1     1   5 use warnings;
  1         2  
  1         22  
8              
9 1     1   4 use Test::More;
  1         1  
  1         5  
10              
11 1     1   808 use Eve::RegistryStub;
  0            
  0            
12              
13             use Eve::Registry;
14              
15             Eve::HttpResourceGraphTestBase->SKIP_CLASS(1);
16              
17             =head1 NAME
18              
19             B - a base class for all Graph API
20             HTTP resource classes.
21              
22             =head1 SYNOPSIS
23              
24             package BogusHttpResourceTest;
25              
26             use parent qw(Eve::HttpResourceGraphTestBase);
27              
28             # put your HTTP resource tests here
29              
30             Get a ready HTTP dispatcher object for your test case:
31              
32             $self->set_dispatcher(
33             Eve::PsgiStub->get_request(
34             'method' => $method_string,
35             'uri' => $uri_string,
36             'host' => $domain_strin,
37             'query' => $query_string,
38             'cookie' => $cookie_string));
39              
40             =head1 DESCRIPTION
41              
42             B is the class that provides all
43             required test cases for every Graph API HTTP resource class.
44              
45             =head1 METHODS
46              
47             =head2 B
48              
49             =cut
50              
51             sub setup {
52             my $self = shift;
53              
54             $self->{'registry'} = Eve::Registry->new();
55             $self->{'session'} = $self->{'registry'}->get_session(id => undef);
56             }
57              
58             =head2 B
59              
60             Returns an C object ready for HTTP resource
61             testing. To get a ready request object to be used as an argument a
62             L stub class can be used.
63              
64             =head3 Arguments
65              
66             =over 4
67              
68             =item
69              
70             Any C object.
71              
72             =back
73              
74             =cut
75              
76             sub set_dispatcher {
77             my ($self, $request) = @_;
78              
79             $self->{'dispatcher'} = Eve::HttpDispatcher->new(
80             request_constructor => sub {
81             return $request;
82             },
83             response => $self->{'registry'}->get_http_response(),
84             event_map => $self->{'registry'}->get_event_map(),
85             base_uri => $self->{'registry'}->get_base_uri());
86              
87             $self->{'resource'} = $self->{'resource_constructor'}->(
88             dispatcher => $self->{'dispatcher'});
89              
90             for my $binding_hash (@{$self->{'dispatcher_binding_list'}}) {
91             $self->{'dispatcher'}->bind(%{$binding_hash});
92             }
93              
94             return;
95             }
96              
97             =head2 B
98              
99             Performs all tests for the GET functionality of a Graph API resource.
100              
101             =cut
102              
103             sub do_test_read {
104             my ($self, $data_hash_list) = @_;
105              
106             $self->do_test($data_hash_list, 'GET');
107             }
108              
109             =head2 B
110              
111             Performs all tests for the POST functionality of a Graph API resource.
112              
113             =cut
114              
115             sub do_test_publish {
116             my ($self, $data_hash_list) = @_;
117              
118             $self->do_test($data_hash_list, 'POST');
119             }
120              
121             =head2 B
122              
123             Performs all tests for the DELETE functionality of a Graph API resource.
124              
125             =cut
126              
127             sub do_test_remove {
128             my ($self, $data_hash_list) = @_;
129              
130             $self->do_test($data_hash_list, 'DELETE');
131             }
132              
133             =head2 B
134              
135             Performs all tests for specified data and request method.
136              
137             =cut
138              
139             sub do_test {
140             my ($self, $data_hash_list, $method) = @_;
141              
142             for my $data_hash (@{$data_hash_list}) {
143              
144             my $request = Eve::PsgiStub->get_request(
145             method => $method,
146             uri => $data_hash->{'uri_hash'}->{'uri_string'},
147             query => $data_hash->{'uri_hash'}->{'query_string'},
148             host => 'example.com',
149             body => $data_hash->{'request_body'},
150             cookie => 'session_id=' . $self->{'session'}->get_id());
151              
152             if (defined $data_hash->{'upload_hash'}) {
153             $request->cgi->{'env'}->{'plack.request.upload'} =
154             $data_hash->{'upload_hash'};
155             }
156              
157             $self->set_dispatcher($request);
158              
159             $self->set_session_parameters($data_hash->{'session_hash'});
160             $self->mock_gateway_methods($data_hash->{'gateway_list'});
161              
162             my $event = Eve::Event::PsgiRequestReceived->new(
163             event_map => $self->{'registry'}->get_event_map(),
164             env_hash => {});
165              
166             $self->{'dispatcher'}->handle(event => $event);
167              
168             $self->assert_response(
169             $event->response, 200, $data_hash->{'resource_result'});
170             }
171             }
172              
173             =head2 B
174              
175             Sets session parameters for the current test.
176              
177             =cut
178              
179             sub set_session_parameters {
180             my ($self, $session_hash) = @_;
181              
182             for my $parameter_name (keys %{$session_hash}) {
183             $self->{'session'}->set_parameter(
184             name => $parameter_name,
185             value => $session_hash->{$parameter_name});
186             }
187             }
188              
189             =head2 B
190              
191             Adds gateway method mocking with provided data.
192              
193             =cut
194              
195             sub mock_gateway_methods {
196             my ($self, $gateway_list) = @_;
197              
198             for my $gateway_data_hash (@{$gateway_list}) {
199             $gateway_data_hash->{'object'}->mock(
200             $gateway_data_hash->{'method'},
201             sub {
202             shift;
203             if (not defined $gateway_data_hash->{'no_argument_check'}) {
204             is_deeply(
205             {@_},
206             $gateway_data_hash->{'arguments'},
207             'Gateway method arguments for '
208             . $gateway_data_hash->{'method'}
209             . ' method.');
210             }
211              
212             return $gateway_data_hash->{'result'};
213             });
214             }
215             }
216              
217             =head2 B
218              
219             Checks the response of a resource and compares it to the one specified
220             in the arguments.
221              
222             =cut
223              
224             sub assert_response {
225             my ($self, $response, $code, $body) = @_;
226              
227             if (ref $body eq 'Regexp') {
228             like($response->get_text, $body);
229              
230             } else {
231              
232             my $expected_response = $self->{'registry'}->get_http_response()->new();
233             $expected_response->set_header(
234             name => 'Content-Type', value => 'text/javascript');
235             $expected_response->set_status(code => $code);
236             $expected_response->set_body(
237             text => $self->{'registry'}->get_json()->encode(
238             reference => $body));
239              
240             is(
241             $response->get_text(),
242             $expected_response->get_text(),
243             'Response text');
244             }
245             }
246              
247             =head1 SEE ALSO
248              
249             =over 4
250              
251             =item L
252              
253             =item L
254              
255             =back
256              
257             =head1 LICENSE AND COPYRIGHT
258              
259             Copyright 2010-2013 Sergey Konoplev, Igor Zinovyev.
260              
261             This program is free software; you can redistribute it and/or modify it
262             under the terms of either: the GNU General Public License as published
263             by the Free Software Foundation; or the Artistic License.
264              
265             See http://dev.perl.org/licenses/ for more information.
266              
267             =head1 AUTHOR
268              
269             =over 4
270              
271             =item L
272              
273             =item L
274              
275             =back
276              
277             =cut
278              
279             1;