#PODNAME: bobby_tables4.pl
__END__
=pod
=head1 NAME
bobby_tables4.pl
=head1 VERSION
version v4.1.1
=head2 Using Test::Chado with web applications
Using B<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 B<GET> request and to check for a database entry probably after every B<POST> request.
Here an example is given with L<Mojolicious> framework for better understanding the use cases.
=head3 Setup
=head4 Install Mojolicious
cpanm Mojolicious
This guide assume to have you running v4.0+.
=head4 Create project folder
mkdir -p test_chado_with_mojo/t
The B<t> folder will contain the test file.
=head4 Add Test::Chado as dependencies
Since web applications are generally not meant to packaged and/or distributable, a L<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 .
=head4 Create application
Create a L<Mojolicious::Lite> application in a file B<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 B<schema> attribute will hold the L<Test::Chado> schema and pass it along to the B<post> route.
Now, write a unit test file(basic.t) inside the B<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 B<GET> route and mojolicious test for it
B<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")
}
);
};
B<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 B<feature> and B<featureloc> tables entry
In B<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 B<app.pl>, we have added a HTTP I<POST> route B<features> which creates an entry in feature table and add a featureloc if the values are provided.
Now in B<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 B<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!
=head1 AUTHOR
Siddhartha Basu <biosidd@gmail.com>
=head1 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.
=cut