6 use HTTP::Request::Common;
7 use JSON qw/ decode_json /;
9 use Test::WWW::Mechanize::Catalyst;
10 use Text::Tradition::Directory;
12 use Catalyst::Test 'stemmaweb';
15 eval { no warnings; $DB::deep = 1000; };
17 # Set up the test data
18 use vars qw( $orig_db $was_link );
20 my $dbfile = 'db/traditions.db';
21 ( $orig_db, $was_link, $textids ) = _make_testing_database();
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"}';
26 # First try without a job ID in the database anywhere
27 my $unclaimed_request = request POST '/stemweb/result',
28 'Content-Type' => 'application/json',
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" );
36 # Now add the relevant job ID to two traditions and test for that error
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' );
44 my $t2 = $dir->lookup( $textids->{'private'} );
45 $t2->set_stemweb_jobid( '4' );
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',
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" );
58 # Finally, try with the job ID on only one tradition.
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;
67 my $expected_request = request POST '/stemweb/result',
68 'Content-Type' => 'application/json',
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" );
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" );
85 # And check that the job ID was in fact removed.
86 my $duplicate_request = request POST '/stemweb/result',
87 'Content-Type' => 'application/json',
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" );
97 sub _make_testing_database {
98 my $fh = File::Temp->new();
99 my $file = $fh->filename;
100 $fh->unlink_on_destroy( 0 );
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;
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 );
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 );
124 ## Now replace the existing traditions database with the test one
125 my( $orig, $was_link );
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";
135 symlink( $file, $dbfile );
136 return( $orig, $was_link, $textids );
140 # Restore the original database
141 unlink( readlink( $dbfile ) );
144 symlink( $orig_db, $dbfile );
145 } elsif( $orig_db ) {
146 rename( $orig_db, $dbfile );