t/controller_Stemweb.t

   1 #!/usr/bin/env perl
   2
   3 use strict;
   4 use warnings;
   5 use feature 'say';
   6 use HTTP::Request::Common;
   7 use JSON qw/ decode_json /;
   8 use Test::More;
   9 use Test::WWW::Mechanize::Catalyst;
  10 use Text::Tradition::Directory;
  11
  12 use Catalyst::Test 'stemmaweb';
  13 use LWP::UserAgent;
  14
  15 eval { no warnings; $DB::deep = 1000; };
  16
  17 # Set up the test data
  18 use vars qw( $orig_db $was_link );
  19 my $textids;
  20 my $dbfile = 'db/traditions.db';
  21 ( $orig_db, $was_link, $textids ) = _make_testing_database();
  22
  23 # Here is the test data we will use
  24 my $answer = '{"status": 0, "job_id": "4", "algorithm": "RHM", "format": "newick", "start_time": "2013-10-26 10:44:14.050263", "result": "((((((((((((F,U),V),S),T1),T2),A),J),B),L),D),M),C);\n", "end_time": "2013-10-26 10:45:55.398944"}';
  25
  26 # First try without a job ID in the database anywhere
  27 my $unclaimed_request = request POST '/stemweb/result',
  28         'Content-Type' => 'application/json',
  29         'Content' => $answer;
  30 like( $unclaimed_request->header('Content-Type'), qr/application\/json/,
  31         "Returned JSON answer for unclaimed request" );
  32 is( $unclaimed_request->code, 400, "No tradition found with given job ID" );
  33 like( $unclaimed_request->content, qr/No tradition found with Stemweb job ID/,
  34         "Correct error message returned" );
  35
  36 # Now add the relevant job ID to two traditions and test for that error
  37 {
  38         my $dsn = "dbi:SQLite:dbname=$dbfile";
  39         my $dir = Text::Tradition::Directory->new( 'dsn' => $dsn );
  40         my $scope = $dir->new_scope();
  41         my $t1 = $dir->lookup( $textids->{'public'} );
  42         $t1->set_stemweb_jobid( '4' );
  43         $dir->save( $t1 );
  44         my $t2 = $dir->lookup( $textids->{'private'} );
  45         $t2->set_stemweb_jobid( '4' );
  46         $dir->save( $t2 );
  47 }
  48 # Now try with the job ID in more than one place in the database
  49 my $oversubscribed_request = request POST '/stemweb/result',
  50         'Content-Type' => 'application/json',
  51         'Content' => $answer;
  52 like( $oversubscribed_request->header('Content-Type'), qr/application\/json/,
  53         "Returned JSON answer for oversubscribed request" );
  54 is( $oversubscribed_request->code, 500, "Multiple traditions found with given job ID" );
  55 like( $oversubscribed_request->content, qr/Multiple traditions with Stemweb job ID/,
  56         "Correct error message returned" );
  57
  58 # Finally, try with the job ID on only one tradition.
  59 {
  60         my $dsn = "dbi:SQLite:dbname=$dbfile";
  61         my $dir = Text::Tradition::Directory->new( 'dsn' => $dsn );
  62         my $scope = $dir->new_scope();
  63         my $t2 = $dir->lookup( $textids->{'private'} );
  64         $t2->_clear_stemweb_jobid;
  65         $dir->save( $t2 );
  66 }
  67 my $expected_request = request POST '/stemweb/result',
  68         'Content-Type' => 'application/json',
  69         'Content' => $answer;
  70 like( $expected_request->header('Content-Type'), qr/application\/json/,
  71         "Returned JSON answer for expected request" );
  72 is( $expected_request->code, 200, "Request processed successfully" );
  73 like( $expected_request->content, qr/success/,
  74         "Correct success message returned" );
  75
  76 # Now check that the tradition in question actually has a stemma!
  77 my $stemma_request = request('/stemmadot/' . $textids->{'public'} . '/0' );
  78 like( $stemma_request->header('Content-Type'), qr/application\/json/,
  79         "Returned JSON answer for stemma request" );
  80 my $new_stemma = decode_json( $stemma_request->content );
  81 # It will be undirected.
  82 like( $new_stemma->{dot}, qr/^graph .RHM 1382777054_0/,
  83         "Found an undirected stemma DOT file where we expected" );
  84
  85 # And check that the job ID was in fact removed.
  86 my $duplicate_request = request POST '/stemweb/result',
  87         'Content-Type' => 'application/json',
  88         'Content' => $answer;
  89 like( $duplicate_request->header('Content-Type'), qr/application\/json/,
  90         "Returned JSON answer for duplicate request" );
  91 like( $duplicate_request->content, qr/No tradition found with Stemweb job ID/,
  92         "Job ID was removed from relevant tradition" );
  93
  94 done_testing();
  95
  96
  97 sub _make_testing_database {
  98         my $fh = File::Temp->new();
  99         my $file = $fh->filename;
 100         $fh->unlink_on_destroy( 0 );
 101         $fh->close;
 102         my $dsn = 'dbi:SQLite:dbname=' . $file;
 103         my $dir = Text::Tradition::Directory->new( 'dsn' => $dsn,
 104                 'extra_args' => { 'create' => 1 } );
 105         my $scope = $dir->new_scope;
 106
 107         my $textids = {};
 108         # Create a (public) tradition
 109         my $pubtrad = Text::Tradition->new( input => 'Self', file => 't/data/besoin.xml' );
 110         $pubtrad->public( 1 );
 111         $textids->{'public'} = $dir->store( $pubtrad );
 112
 113         # Create a user
 114         my $adminobj = $dir->add_user( { username => 'stadmin', password => 'stadminpass', role => 'admin' } );
 115         my $userobj = $dir->add_user( { username => 'swtest', password => 'swtestpass' } );
 116         # Create a tradition for the normal user
 117         my $privtrad = Text::Tradition->new( input => 'Tabular', sep_char => ',',
 118                 file => 't/data/florilegium.csv' );
 119         $userobj->add_tradition( $privtrad );
 120         $privtrad->add_stemma( dotfile => 't/data/florilegium.dot' );
 121         $textids->{'private'} = $dir->store( $privtrad );
 122         $dir->store( $userobj );
 123
 124         ## Now replace the existing traditions database with the test one
 125         my( $orig, $was_link );
 126         if( -l $dbfile ) {
 127                 $was_link = 1;
 128                 $orig = readlink( $dbfile );
 129                 unlink( $dbfile ) or die "Could not replace database file $dbfile";
 130         } elsif( -e $dbfile ) {
 131                 my $suffix = '.backup.' . time();
 132                 $orig = $dbfile.$suffix;
 133                 rename( $dbfile, $orig ) or die "Could not move database file $dbfile";
 134         }
 135         symlink( $file, $dbfile );
 136         return( $orig, $was_link, $textids );
 137 }
 138
 139 END {
 140         # Restore the original database
 141         unlink( readlink( $dbfile ) );
 142         unlink( $dbfile );
 143         if( $was_link ) {
 144                 symlink( $orig_db, $dbfile );
 145         } elsif( $orig_db ) {
 146                 rename( $orig_db, $dbfile );
 147         }
 148 }