The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Test::Webservice::InterMine::Service;

#TODO - add tests for apply role, and new_query

use strict;
use warnings;
use base 'Test::Class';
use Test::More;
use Test::Exception;
use Test::MockObject;
use InterMine::Model::TestModel;
use URI;

sub class         { 'Webservice::InterMine::Service' }
sub fake_queryurl { URI->new('fake.url/path') }
sub fake_viewlist { [qw/one two three/] }
sub user_agent    { 'WebserviceInterMinePerlAPIClient' }

sub object {
    my $test = shift;
    return $test->{object};
}

sub setup : Test(setup) {
    my $test = shift;

    # Set up all the mock stuff

    my $model = InterMine::Model::TestModel->instance;
    $test->{model} = $model;

    my $fake_query = Test::MockObject->new;
    $fake_query->fake_module( 'Webservice::InterMine::Query', new => sub { }, );
    $test->{fq} = $fake_query;
    my $connection = Test::MockObject->new;
    $connection->fake_module(
        'Net::HTTP',
        new => sub {
            my $class = shift;
            my @args  = @_;
            $connection->{_init_args} = {@args};
            return $connection;
        },
    );
    $connection->mock(
        write_request => sub {
            my $self = shift;
            my @args = @_;
            $self->{_write_args} = {@args};
            return $self;
        },
    );
    $test->{connection} = $connection;
    $test->{version}    = 1_000_000;
    $test->{release}    = 'SOME RELEASE STRING';
    $test->{listdata}    = 'SOME LIST DATA';

    my $fakeRes = Test::MockObject->new;
    $fakeRes->fake_module(
        'Webservice::InterMine::ResultIterator',
        new => sub {
            my $class = shift;
            my @args  = @_;
            $fakeRes->{_init_args} = {@args};
            return $fakeRes;
        },
    );
    $fakeRes->mock( status_line => sub { "Hello, I'm a status line" } )
            ->mock( content => sub { $_[0]->{_content} } )
            ->mock( base => sub { $_[0]->{_base} } );
    $fakeRes->set_false('is_error')->mock( code => sub { 'FAKE_CODE' } )
      ->mock( message => sub { 'FAKE_MESSAGE' } );
    $test->{Res} = $fakeRes;

    my $fakeLWP = Test::MockObject->new();
    $fakeLWP->{get_count} = 0;
    $fakeLWP->fake_module( 'LWP::UserAgent', new => sub { return $fakeLWP }, );
    $fakeLWP->set_isa('LWP::UserAgent');
    $fakeLWP->mock( env_proxy => sub { } )->mock(
        agent => sub {
            my $self         = shift;
            my $agent_string = shift;
            $self->{agent} = $agent_string;
        }
      )->mock(
        get => sub {
            my ( $self, $uri ) = @_;
            $self->{get_count}++;
            my $url = "$uri";
            $fakeRes->{_base} = URI->new($uri);
            if ( $url =~ m!/model! ) {
                $fakeRes->{_content} = $model;
            }
            elsif ( $url =~ m!/lists! ) {
                $fakeRes->{_content} = $test->{listdata};
            }
            elsif ( $url =~ m!/release! ) {
                $fakeRes->{_content} = $test->{release};
            }
            elsif ( $url =~ m!/version! ) {
                $fakeRes->{_content} = $test->{version};
            }
            else {
                $fakeRes->{_content} .= $url;
            }
            return $fakeRes;
        }
      )->mock(
        default_header => sub {
            my ($self, @header)  = @_;
            $self->{header} = \@header;
        }
    );
    $test->{LWP} = $fakeLWP;

    my $fake_TemplateFactory = Test::MockObject->new;
    $fake_TemplateFactory->fake_module(
        'Webservice::InterMine::TemplateFactory',
        new => sub {
            return $fake_TemplateFactory;
        },
    );
    $fake_TemplateFactory->set_isa('Webservice::InterMine::TemplateFactory');
    $fake_TemplateFactory->mock(
        get_template_by_name => sub {
            my $self = shift;
            my $name = shift;
            return "Mock Template Result - $name";
        },
    )->mock(get_templates => sub {"Many Templates"});
    $test->{TF} = $fake_TemplateFactory;

    my $fake_ListFactory = Test::MockObject->new;
    $fake_TemplateFactory->fake_module(
        'Webservice::InterMine::ListFactory',
        new => sub {
            return $fake_ListFactory;
        },
    );
    $fake_ListFactory->set_isa('Webservice::InterMine::ListFactory');
    $test->{LF} = $fake_ListFactory;
}

sub _compilation : Test(1)  {
    my $test = shift;
    use_ok( $test->class );
}

sub basic_service : Test(3) {
    my $test = shift;
    my @args = ( root => $test->fake_queryurl );
    my $service = new_ok( $test->class, [@args] );
    is( $service->version, $test->{version}, "It gets its version ok" );

    is($service->get_authstring, undef, "No user, no authentication");

}

sub auth_service : Test(2) {
    my $test = shift;
    my @args = ( root => $test->fake_queryurl, user => 'Foo', pass => 'Bar' );
    $SIG{__WARN__} = sub {};
    my $service;
    lives_ok {$service = $test->class->new(@args)};
    isnt($service->get_authstring, undef, "With a user, there is authentication");
}
    

sub bad_services : Test(5) {
    my $test = shift;
    my @args = ( root => $test->fake_queryurl );

    throws_ok {$test->class->new(@args, user => "Foo")} qr/not both/, 
        "demands a password for a user";

    throws_ok {$test->class->new(@args, pass => "Foo")} qr/not both/, 
        "demands a user for a password";

    throws_ok {$test->class->new(@args, user => "Foo", pass => "Foo", token => "Foo")} qr/choose only one/,
        "doesn't accept tokens and passwords";

    $test->{version} = 5;
    throws_ok {$test->class->new(@args, token => "Foo")} qr/does not support token/,
        "Requires a sufficiently advanced service to handle tokens";

    $test->{version} = 0;
    throws_ok {$test->class->new(@args)} qr/check the url/, 
        "Throws a sensible error when it can't get the version";


}

sub release : Test(2) {
    my $test = shift;
    my @args = ( root => $test->fake_queryurl );
    my $service = $test->class->new(@args);
    my $c = $test->{LWP}->{get_count};
    is($service->release, $test->{release}, "Can get the release string");
    is($test->{LWP}->{get_count}, $c + 1, "Was fetched lazily");
}

sub templates : Test(2) {
    my $test = shift;
    my @args = ( root => $test->fake_queryurl, _templates => $test->{TF} );
    my $service = $test->class->new(@args);
    is($service->template('Foo'), "Mock Template Result - Foo", 
        "Can delegate template fetching");
    is($service->get_templates, "Many Templates", 
        "Can delegate fetching of all templates");
}

sub list_methods : Test(3) {
    my $test = shift;
    my @args = ( root => $test->fake_queryurl );
    my $service = $test->class->new(@args);
    can_ok($service, qw/list lists lists_with_object list_names new_list 
        join_lists subtract_lists intersect_lists diff_lists delete_lists 
        delete_temp_lists list_count refresh_lists/);
    is($service->get_list_data, $test->{listdata}, "Can fetch list data");

    $test->{version} = 3;
    $service = $test->class->new(@args);
    throws_ok {$service->get_list_data} qr/not support list operations/, 
        "Informs the user if the webservice cannot handle lists";
    
}

sub token_auth : Test(4) {

    my $test = shift;
    my @args = ( root => $test->fake_queryurl );
    my $service = $test->class->new(@args, token => "FOO");

    NO_PARAMS: {
        my $uri = $service->build_uri("http://some.url");
        is_deeply([$uri->query_form], [token => "FOO"], "Adds tokens to uris it constructs");
    }

    PARAMS: {
        my $uri = $service->build_uri("http://some.url", some => "param");
        is_deeply([$uri->query_form], [some => "param", token => "FOO"], "... and plays nice with other params")
    }

    HASH_PARAMS: {
        my $uri = $service->build_uri("http://some.url", {some => "param"});
        is_deeply([$uri->query_form], [some => "param", token => "FOO"], "... even when they are as a hashref")
    }

    ARRAY_PARAMS: {
        my $uri = $service->build_uri("http://some.url", [some => "param"]);
        is_deeply([$uri->query_form], [some => "param", token => "FOO"], "... and when they are as a arrayref")
    }

}
    

1;