package Test::Clustericious;

use strict;
use warnings;
use base 'Test::Mojo';
use JSON::MaybeXS qw( encode_json decode_json );
use YAML::XS;
use Carp;
use List::Util qw(first);
use Clustericious::Config;

# ABSTRACT: Test Clustericious applications
our $VERSION = '1.05'; # VERSION


require Test::More;


__PACKAGE__->attr('server');
__PACKAGE__->attr('server_url');


sub new
{
    my $class = shift;
    shift @_ if (@_==2 && $_[0] eq 'app'); # allow deprecated app => 'foo'
    my $self = $class->SUPER::new(@_);

    if ($self->app)
    {
        $self->server_url('');
    }
    elsif ($self->server)
    {
        $self->server_url(Clustericious::Config->new($self->server)->url);
    }
    else
    {
        return undef unless $self->server_url;
    }

    return $self;
}


sub testdata
{
    my $self = shift;
    my ($filename) = @_;

    $filename = first { -r }
                map { $_, "$_.yaml", "$_.json" }
                map { $_, "t/$_", "data/$_", "t/data/$_" }
                $filename;

    my $content;
    do {
        use autodie;
        open my $fh, '<', $filename;
        $content = <$fh>;
        close $fh;
    };

    return decode_json($content) if $filename =~ /json$/;

    return Load($content) if $filename =~ /yaml$/;

    return $content;
}

sub _url
{
    my $self = shift;
    my ($url) = @_;

    my $server_url = $self->server_url;
    return $url if $url =~ /^$server_url/;
    return $server_url . $url;
}


sub decoded_body
{
    my $self = shift;

    my $res = $self->tx->res;

    my $body = $res->body;

    if ($res->headers->content_type and
        $res->headers->content_type =~ /^application\/json(;.*)?$/)
    {
        $body = decode_json($body);
    }

    return $res->is_status_class(200) ? $body : undef;
}


sub create_ok
{
    my $self = shift;
    my $url = shift;

    if (@_ > 1)
    {
        $self->create_ok($url, $_) for @_;
        return;
    }

    my $object = shift;

    $url = $self->_url($url);

    unless (ref $object)
    {
        $object = $self->testdata($object) or return;
    }

    $self->post_ok($url, json => $object, "Create $url")
         ->status_is(200, "Created $url")
         ->decoded_body;
}


sub update_ok { create_ok(@_) }


sub retrieve_ok
{
    my $self = shift;
    my ($url) = @_;
    
    $url = $self->_url($url);

    $self->get_ok($url, '', "GET $url");
    my $res = $self->tx->res;
    Test::More::ok ($res->is_status_class(200), "GET $url status is 200");
    return $self->decoded_body;
}


sub remove_ok
{
    my $self = shift;
    my ($url) = @_;

    $url = $self->_url($url);

    $self->delete_ok($url, '', "DELETE $url")
         ->status_is(200, "deleted $url status is 200" )
         ->content_is("ok", "Deleted $url content is ok")
         ->notfound_ok($url);
}


sub notfound_ok
{
    my $self = shift;
    my ($url, $object) = @_;

    $url = $self->_url($url);

    if ($object)
    {
        $self->post_ok($url, { "Content-Type" => "application/json" },
                       encode_json($object), "POST $url");
    }
    else
    {
        $self->get_ok($url);
    };

    $self->status_is(404, "$url status is 404")
         ->content_like(qr/(Not found|null)/i, "$url content is null or Not Found");
}


# Should probably do this directly on the server side for speed,
# but this way is fun..

sub truncate_ok
{
    my $self = shift;
    my ($url) = @_;

    while (1)
    {
        my $list = $self->retrieve_ok($url) or return;

        return unless @$list;

        foreach my $key (@$list)
        {
            $self->remove_ok("$url/$key") or return;
        }
    }
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Test::Clustericious - Test Clustericious applications

=head1 VERSION

version 1.05

=head1 SYNOPSIS

 use Test::Clustericious;

 my $t = Test::Clustericious->new(app => 'SomeMojoApp');
 my $t = Test::Clustericious->new(server => 'myapp');
 my $t = Test::Clustericious->new(server_url => 'http://foo');

 my $obj = $t->create_ok('/my/url', { my => 'object' }); # 2 tests

 my $obj = $t->retrieve_ok('/url/id'); # 2 tests, returns decoded object

 $t->update_ok('/url/id', { my => 'object' }); # 2 tests

 $t->remove_ok('/url/id'); # 6 tests: deletes, then gets to verify gone

=head1 DESCRIPTION

L<Test::Clustericious> is a collection of testing helpers for everyone
developing L<Clustericious> applications.  It inherits from
L<Test::Mojo>, and add the following new attributes and methods.

=head1 ATTRIBUTES

=head2 server

 my $t = Test::Clustericious->new(server => 'MyServer');

Looks up the URL for the server in the config file for the
specified server.

=head2 server_url

 my $t = Test::Clustericious->new(server_url => 'http://foo/');

Explicitly define a server url to test against.

=head1 METHODS

=head2 new

 my $t = Test::Clustericious(app => 'SomeMojoApp');
 my $t = Test::Clustericious(server => 'myapp');
 my $t = Test::Clustericious(server_url => 'http://foo'); 

=head2 testdata

 my $object = $t->testdata('filename');

Looks for filename, filename.json, filename.yaml in 't', 'data' or
't/data' directories.  Parses with json or yaml if appropriate, then
returns the object.

=head2 decoded_body

 $obj = $t->decoded_body;

Returns the body from the last request, parsing with JSON if
Content-Type is application/json.

Returns undef if the parse fails or the last request wasn't status
2xx.

=head2 create_ok

 $obj = $t->create_ok('/url', { some => 'object' });
 $obj = $t->create_ok('/url', 'filename');
 $t->create_ok('/url', <many/files*>);

if called with a filename, loads the object from the file as
described in testdata().

Uses POST to the url to create the object, encoded with JSON.
Checks for status 200 and returns the decoded body.

You can also create multiple objects/files at once, but then there is
no returned object.

This counts as 2 TAP tests.

=head2 update_ok

 update_ok is really just an alias for create_ok

=head2 retrieve_ok

 $obj = $t->retrieve_ok('/url');

Makes a GET request on the url, checks for status 200, and returns the 
decoded body.

This counts as 2 TAP tests.

=head2 remove_ok

 $t->remove_ok($url);

Makes a DELETE request on the url, checks for status 200 and content of 
'ok'.  Then does a GET of the same url and checks for not found.

This counts as 6 TAP tests.

=head2 notfound_ok

 $t->notfound_ok($url[, $object]);

Makes a GET request on the url, or if $object specified, a POST request 
the encoded object and checks for a 404 response code and "not found" or 
"null".

This counts as 3 TAP tests.

=head2 truncate_ok

 $t->truncate_ok($url);

Makes a GET request the URL, which should return a list of keys, then 
iterates over the list and delete_ok() each one.

=head1 SEE ALSO

L<Clustericious>

=head1 AUTHOR

Original author: Brian Duggan

Current maintainer: Graham Ollis E<lt>plicease@cpan.orgE<gt>

Contributors:

Curt Tilmes

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2013 by NASA GSFC.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut