/ 
Test-Chado-v4.1.1
River stage zero No dependents
/ bobby_tables4.pl

NAME

bobby_tables4.pl

VERSION

version v4.1.1

Using Test::Chado with web applications

Using Test::Chado with web applications is not so different than using it with a distributable perl module. However, the most use will be to load fixtures before every test to check the GET request and to check for a database entry probably after every POST request. Here an example is given with Mojolicious framework for better understanding the use cases.

Setup

Install Mojolicious

cpanm Mojolicious

This guide assume to have you running v4.0+.

Create project folder

mkdir -p test_chado_with_mojo/t

The t folder will contain the test file.

Add Test::Chado as dependencies

Since web applications are generally not meant to packaged and/or distributable, a cpanfile is used for declaring dependencies. Save the below as cpanfile inside the project folder

requires 'Mojolicious', '4.0';
on 'test' => sub {
    requires 'Test::Chado', '1.0.0';
};

Install Test::Chado

cpanm .

Create application

Create a Mojolicious::Lite application in a file app.pl. First, we are going to create routes for creating and accession cvterms.

use Mojolicious::Lite;
use Mojo::Base -base;
use Bio::Chado::Schema;
use FindBin qw($Bin);
use File::Spec::Functions;

app->attr(
    schema => sub {
        my $dbname = catfile( $Bin, "db", "chado.sqlite" );
                return Bio::Chado::Schema->connect( "dbi:SQLite:dbname=$dbname", "", "" );
    }
);


post '/cvterms' => [ format => [qw/json/] ] => sub {
    my $self   = shift;
    my $params = $self->req->json;
    for my $p (qw/namespace id name/) {
        if ( not defined $params->{$p} ) {
            $self->res->message("Required parameter $p missing");
            $self->rendered(400);
            return;
        }
    }
    my ( $db, $id ) = split /:/, $params->{id};
    my $schema     = app->schema;
    my $cvterm_row = $schema->resultset('Cvterm')->create(
        {   name  => $params->{name},
            cv_id => $schema->resultset('Cv')
                ->find_or_create( { name => $params->{namespace} } )->cv_id,
            dbxref => {
                accession => $id,
                db_id     => $schema->resultset('Db')
                    ->find_or_create( { name => $db } )->db_id
            }
        }
    );

    $self->res->headers->location( "/cvterms/" . $params->{id} . ".json" );
    $self->rendered(201);
};

$app->start;

During the unit testing, the schema attribute will hold the Test::Chado schema and pass it along to the post route.

Now, write a unit test file(basic.t) inside the t/ folder.

use Test::More qw/no_plan/;
use Test::Mojo;
use Test::Chado;
use Test::Chado::Common;
use Module::Load;
use FindBin qw($Bin);

load "$Bin/../app.pl";

my $schema = chado_schema( load_fixture => 1 );
my $t = Test::Mojo->new;
$t->app->schema($schema);

my $post = $t->post_ok(
    '/cvterms.json' => json => {
        namespace => 'test-chado-mojoapp',
        id        => 'TC:000001',
        name      => 'test chado rocks'
    },
    "it should post the new cvterm"
);
$post->status_is( 201, "should get the correct response" );
$post->header_is(
    Location => "/cvterms/TC:000001.json",
    "should get the correct HTTP location header"
);
has_cvterm( $schema, "test chado rocks", "should have the new cvterm" );
has_dbxref( $schema, "000001", "should have the new dbxref" );

Run it

perl app.pl test

Running tests from '/home/cybersiddhu/Projects/Experiments/test_chado_with_mojo/t'.
t/basic.t .. 
ok 1 - POST /cvterms.json
ok 2 - should get the correct response
ok 3 - should get the correct HTTP location header
ok 4 - should have the new cvterm
ok 5 - should have the new dbxref
1..5
ok
All tests successful.
Files=1, Tests=5,  6 wallclock secs ( 0.02 usr  0.00 sys +  5.74 cusr  0.26 csys =  6.02 CPU)
Result: PASS

Now add a GET route and mojolicious test for it In app.pl

get '/cvterms/:id' => [ format => [qw/json/] ] => sub {
    my $self   = shift;
    my $schema = app->schema;
    my ( $db, $id ) = split /:/, $self->stash('id');
    my $row = $schema->resultset('Dbxref')
        ->search( { accession => $id }, { rows => 1 } )->single;
    if ( !$row ) {
        $self->rendered(401);
        return;
    }
    $self->render(
        json => {
            name => $row->cvterm->name,
            id   => $self->stash("id")
        }
    );
};

In basic.t

$t->get_ok("/cvterms/TC:000001.json")->status_is(200)
    ->json_is( { name => "test chado rocks", id => "TC:000001" },
        "should get correct name and id" );

perl app.pl test -v

Running tests from '/home/cybersiddhu/Projects/Experiments/test_chado_with_mojo/t'.
t/basic.t .. 
ok 1 - POST /cvterms.json
ok 2 - should get the correct response
ok 3 - should get the correct HTTP location header
ok 4 - should have the new cvterm
ok 5 - should have the new dbxref
ok 6 - GET /cvterms/TC:000001.json
ok 7 - 200 OK
ok 8 - should get correct name and id
1..8
ok
All tests successful.
Files=1, Tests=8,  6 wallclock secs ( 0.02 usr  0.01 sys +  5.82 cusr  0.27 csys =  6.12 CPU)
Result: PASS

Now, add few more tests for chado feature and featureloc tables entry In app.pl

post 'features' => [ format => [qw/json/] ] => sub {
    my $self   = shift;
    my $schema = app->schema;
    my $params = $self->req->json;
    for my $p (qw/name organism type/) {
        if ( not defined $params->{$p} ) {
            $self->res->message("Required parameter $p missing");
            $self->rendered(400);
            return;
        }
    }

    my $org_row
        = $schema->resultset('Organism')
        ->search( { common_name => $params->{organism} }, { rows => 1 } )
        ->single;
    my $feat_row = $schema->resultset('Feature')->create(
        {   name       => $params->{name},
            uniquename => $params->{name},
            type_id    => $schema->resultset('Cvterm')
                ->find( { name => $params->{type} } )->cvterm_id,
            organism_id => $org_row->organism_id
        }
    );
    if ( defined $params->{start} and defined $params->{end} ) {
        $feat_row->create_related( 'featureloc_features',
            { fmin => $params->{start}, fmax => $params->{end} } );
    }
    $self->res->headers->location( "/features/" . $params->{name} . ".json" );
    $self->rendered(201);

};

In app.pl, we have added a HTTP POST route features which creates an entry in feature table and add a featureloc if the values are provided. Now in basic.t, add few tests for this piece of code

my $post2 = $t->post_ok(
    '/features.json' => json => {
        name     => 'tcpl',
        type     => 'gene',
        organism => 'human'
    },
    "it should post the new feature"
);
$post2->status_is( 201, "should get the correct response" );
$post2->header_is(
    Location => "/features/tcpl.json",
    "should get the correct HTTP location header"
);
has_feature( $schema, 'tcpl', 'should have the new feature in database' );

perl app.pl test -v

ok 1 - POST /cvterms.json
ok 2 - should get the correct response
ok 3 - should get the correct HTTP location header
ok 4 - should have the new cvterm
ok 5 - should have the new dbxref
ok 6 - GET /cvterms/TC:000001.json
ok 7 - 200 OK
ok 8 - should get correct name and id
ok 9 - POST /features.json
ok 10 - should get the correct response
ok 11 - should get the correct HTTP location header
ok 12 - should have the new feature in database
1..12
ok
All tests successful.
Files=1, Tests=12,  6 wallclock secs ( 0.02 usr  0.00 sys +  5.81 cusr  0.18 csys =  6.01 CPU)
Result: PASS

Now test another feature with feature location. Append the following in basic.t

my $post3 = $t->post_ok(
    '/features.json' => json => {
        name     => 'panda',
        type     => 'contig',
        organism => 'human',
        start    => 48,
        end      => 500
    },
    "it should post the new feature with featureloc"
);
$post3->status_is( 201, "should get the correct response" );
$post3->header_is(
    Location => "/features/panda.json",
    "should get the correct HTTP location header"
);
has_feature( $schema, 'panda', 'should have the new feature in database' );
has_featureloc( $schema, 'panda',
    'should have the new feature with location in database' );
    
perl app.pl test -v


ok 1 - POST /cvterms.json
ok 2 - should get the correct response
ok 3 - should get the correct HTTP location header
ok 3 - should get the correct HTTP location header
ok 4 - should have the new cvterm
ok 5 - should have the new dbxref
ok 6 - GET /cvterms/TC:000001.json
ok 7 - 200 OK
ok 8 - should get correct name and id
ok 9 - POST /features.json
ok 10 - should get the correct response
ok 11 - should get the correct HTTP location header
ok 12 - should have the new feature in database
ok 13 - POST /features.json
ok 14 - should get the correct response
ok 15 - should get the correct HTTP location header
ok 16 - should have the new feature in database
ok 17 - should have the new feature with location in database
1..17
ok
All tests successful.
Files=1, Tests=17,  6 wallclock secs ( 0.02 usr  0.01 sys +  5.86 cusr  0.16 csys =  6.05 CPU)
Result: PASS

That's all folks!

AUTHOR

Siddhartha Basu <biosidd@gmail.com>

COPYRIGHT AND LICENSE

This software is copyright (c) 2011 by Siddhartha Basu.

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