File Coverage

blib/lib/Plack/App/DAIA/Test.pm

Criterion	Covered	Total	%
statement	22	24	91.6
branch			n/a
condition			n/a
subroutine	8	8	100.0
pod			n/a
total	30	32	93.7

use strict;
use warnings;
use v5.10.1;
package Plack::App::DAIA::Test;
#ABSTRACT: Test DAIA Servers
our $VERSION = '0.55'; #VERSION
use base 'Test::Builder::Module';
our @EXPORT = qw(test_daia_psgi test_daia daia_app);

use URI::Escape;
use Test::More;
use Plack::Test;
use Plack::App::DAIA;
use Scalar::Util qw(reftype blessed);
use HTTP::Request::Common;
use Test::JSON::Entails;
use JSON;

sub test_daia {
    my $app = daia_app(shift) || do {
        __PACKAGE__->builder->ok(0,"Could not construct DAIA application");
        return;
    };
    my $test_name = "test_daia";
    $test_name = pop(@_) if @_ % 2;
    while (@_) {
        my $id = shift;
        my $expected = shift;
        my $res = $app->retrieve($id);
        if (!_if_daia_check( $res, $expected, $test_name )) {
            $@ = "retrieve method returned a DAIA::Response" unless $@;
            __PACKAGE__->builder->ok(0, $@);
        }
    }
}

sub test_daia_psgi {
    my $app = shift;

    # TODO: load psgi file if string given and allow for URL
    my $test_name = "test_daia";
    $test_name = pop(@_) if @_ % 2;
    while (@_) {
        my $id = shift;
        my $expected = shift;
        test_psgi $app, sub {
            my $req = shift->(GET "/?id=".uri_escape($id).'&format=xml');
            my $res = eval { DAIA::parse( $req->content ); };
            if ($@) {
                $@ =~ s/DAIA::([A-Z]+::)?[a-z_]+\(\)://ig;
                $@ =~ s/ at .* line.*//g;
                $@ =~ s/\s*$//sg;
            }
            if (!_if_daia_check( $res, $expected, $test_name )) {
                $@ = "application returned a DAIA::Response" unless $@;
                __PACKAGE__->builder->ok(0, $@);
            }
        };
    }
}

sub daia_app {
    my $app = shift;
    if ( blessed($app) and $app->isa('Plack::App::DAIA') ) {
        return $app;
    } elsif ( $app =~ qr{^https?://} ) {
        my $baseurl = $app . ($app =~ /\?/ ? '&id=' : '?id=');
        $app = sub {
            my $id = shift;
            my $url = $baseurl.$id."&format=json";
            my @daia = eval { DAIA->parse($url) };
            if (!@daia) {
                $@ ||= '';
                if ($@) {
                    $@ =~ s/DAIA::([A-Z]+::)?[a-z_]+\(\)://ig;
                    $@ =~ s/ at .* line.*//g;
                    $@ =~ s/\s*$//sg;
                }
                $@ = "invalid DAIA from $url: $@";
            }
            return $daia[0];
        };
    }
    if ( ref($app) and reftype($app) eq 'CODE' ) {
        return Plack::App::DAIA->new( code => $app );
    }
    return;
}

# Call C<$code> with C<$daia> and set as C<$_>, if C<$daia> is a L
# and return C<$daia> on success. Return C otherwise.
sub _if_daia_check {
    my ($daia, $expected, $test_name) = @_;
    if ( blessed($daia) and $daia->isa('DAIA::Response') ) {
        if ( (reftype($expected)||'') eq 'CODE') {
            local $_ = $daia;
            $expected->($daia);
        } else {
            local $Test::Builder::Level = $Test::Builder::Level + 2;
            my $json = decode_json( $daia->json );
            entails $json, $expected, $test_name;
        }
        return $daia;
    }
}

1;

__END__