# -*- mode: Perl; -*-
package Eve::HttpResourceGraphTestBase;
use parent qw(Eve::Test);
use strict;
use warnings;
use Test::More;
use Eve::RegistryStub;
use Eve::Registry;
Eve::HttpResourceGraphTestBase->SKIP_CLASS(1);
=head1 NAME
B<Eve::HttpResourceGraphTestBase> - a base class for all Graph API
HTTP resource classes.
=head1 SYNOPSIS
package BogusHttpResourceTest;
use parent qw(Eve::HttpResourceGraphTestBase);
# put your HTTP resource tests here
Get a ready HTTP dispatcher object for your test case:
$self->set_dispatcher(
Eve::PsgiStub->get_request(
'method' => $method_string,
'uri' => $uri_string,
'host' => $domain_strin,
'query' => $query_string,
'cookie' => $cookie_string));
=head1 DESCRIPTION
B<Eve::HttpResourceGraphTestBase> is the class that provides all
required test cases for every Graph API HTTP resource class.
=head1 METHODS
=head2 B<setup()>
=cut
sub setup {
my $self = shift;
$self->{'registry'} = Eve::Registry->new();
$self->{'session'} = $self->{'registry'}->get_session(id => undef);
}
=head2 B<set_dispatcher()>
Returns an C<Eve::HttpDispatcher> object ready for HTTP resource
testing. To get a ready request object to be used as an argument a
L<Eve::PsgiStub> stub class can be used.
=head3 Arguments
=over 4
=item
Any C<Eve::HttpRequest> object.
=back
=cut
sub set_dispatcher {
my ($self, $request) = @_;
$self->{'dispatcher'} = Eve::HttpDispatcher->new(
request_constructor => sub {
return $request;
},
response => $self->{'registry'}->get_http_response(),
event_map => $self->{'registry'}->get_event_map(),
base_uri => $self->{'registry'}->get_base_uri());
$self->{'resource'} = $self->{'resource_constructor'}->(
dispatcher => $self->{'dispatcher'});
for my $binding_hash (@{$self->{'dispatcher_binding_list'}}) {
$self->{'dispatcher'}->bind(%{$binding_hash});
}
return;
}
=head2 B<do_test_read()>
Performs all tests for the GET functionality of a Graph API resource.
=cut
sub do_test_read {
my ($self, $data_hash_list) = @_;
$self->do_test($data_hash_list, 'GET');
}
=head2 B<do_test_publish()>
Performs all tests for the POST functionality of a Graph API resource.
=cut
sub do_test_publish {
my ($self, $data_hash_list) = @_;
$self->do_test($data_hash_list, 'POST');
}
=head2 B<do_test_remove()>
Performs all tests for the DELETE functionality of a Graph API resource.
=cut
sub do_test_remove {
my ($self, $data_hash_list) = @_;
$self->do_test($data_hash_list, 'DELETE');
}
=head2 B<do_test()>
Performs all tests for specified data and request method.
=cut
sub do_test {
my ($self, $data_hash_list, $method) = @_;
for my $data_hash (@{$data_hash_list}) {
my $request = Eve::PsgiStub->get_request(
method => $method,
uri => $data_hash->{'uri_hash'}->{'uri_string'},
query => $data_hash->{'uri_hash'}->{'query_string'},
host => 'example.com',
body => $data_hash->{'request_body'},
cookie => 'session_id=' . $self->{'session'}->get_id());
if (defined $data_hash->{'upload_hash'}) {
$request->cgi->{'env'}->{'plack.request.upload'} =
$data_hash->{'upload_hash'};
}
$self->set_dispatcher($request);
$self->set_session_parameters($data_hash->{'session_hash'});
$self->mock_gateway_methods($data_hash->{'gateway_list'});
my $event = Eve::Event::PsgiRequestReceived->new(
event_map => $self->{'registry'}->get_event_map(),
env_hash => {});
$self->{'dispatcher'}->handle(event => $event);
$self->assert_response(
$event->response, 200, $data_hash->{'resource_result'});
}
}
=head2 B<set_session_parameters()>
Sets session parameters for the current test.
=cut
sub set_session_parameters {
my ($self, $session_hash) = @_;
for my $parameter_name (keys %{$session_hash}) {
$self->{'session'}->set_parameter(
name => $parameter_name,
value => $session_hash->{$parameter_name});
}
}
=head2 B<mock_gateway_methods()>
Adds gateway method mocking with provided data.
=cut
sub mock_gateway_methods {
my ($self, $gateway_list) = @_;
for my $gateway_data_hash (@{$gateway_list}) {
$gateway_data_hash->{'object'}->mock(
$gateway_data_hash->{'method'},
sub {
shift;
if (not defined $gateway_data_hash->{'no_argument_check'}) {
is_deeply(
{@_},
$gateway_data_hash->{'arguments'},
'Gateway method arguments for '
. $gateway_data_hash->{'method'}
. ' method.');
}
return $gateway_data_hash->{'result'};
});
}
}
=head2 B<assert_response()>
Checks the response of a resource and compares it to the one specified
in the arguments.
=cut
sub assert_response {
my ($self, $response, $code, $body) = @_;
if (ref $body eq 'Regexp') {
like($response->get_text, $body);
} else {
my $expected_response = $self->{'registry'}->get_http_response()->new();
$expected_response->set_header(
name => 'Content-Type', value => 'text/javascript');
$expected_response->set_status(code => $code);
$expected_response->set_body(
text => $self->{'registry'}->get_json()->encode(
reference => $body));
is(
$response->get_text(),
$expected_response->get_text(),
'Response text');
}
}
=head1 SEE ALSO
=over 4
=item L<Eve::Test>
=item L<Test::Class>
=back
=head1 LICENSE AND COPYRIGHT
Copyright 2010-2013 Sergey Konoplev, Igor Zinovyev.
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.
See http://dev.perl.org/licenses/ for more information.
=head1 AUTHOR
=over 4
=item L<Sergey Konoplev|mailto:gray.ru@gmail.com>
=item L<Igor Zinovyev|mailto:zinigor@gmail.com>
=back
=cut
1;