UNTESTED: Implement a 'help' function for Stexaminer, per #21
[scpubgit/stemmaweb.git] / t / controller_Root.t
1 #!/usr/bin/env perl
2 use strict;
3 use warnings;
4 use File::Temp;
5 use HTTP::Request::Common;
6 use JSON qw/ decode_json /;
7 use Test::More;
8 use Test::WWW::Mechanize::Catalyst;
9 use Text::Tradition::Directory;
10
11 use Catalyst::Test 'stemmaweb';
12
13 use vars qw( $orig_db $was_link );
14 my $textids;
15 my $dbfile = 'db/traditions.db';
16 ( $orig_db, $was_link, $textids ) = _make_testing_database();
17
18 ## Tests that do not require being logged in
19 # Test /directory
20 my $publicdir = request('/directory');
21 ok( $publicdir->is_success, 'Got the text directory' );
22 my $listing = $publicdir->decoded_content;
23 like( $listing, qr/Public texts/, "Got directory listing HTML" );
24 unlike( $listing, qr/User texts/, "Got no user texts when we are not logged in" );
25 my @listinglines = grep { $_ =~ /traditionname/ } split( /\n/, $listing );
26 is( scalar @listinglines, 1, "Got a single listing in the directory" );
27
28 # Test /newtradition POST
29 my $newtradpost = request POST '/newtradition',
30         'Content-Type' => 'form-data',
31         'Content' => [
32                 name => 'new tradition',
33                 file => [ 't/data/besoin.xml' ]
34         ];
35 like( $newtradpost->header('Content-Type'), qr/application\/json/,
36         "Returned JSON answer for newtradition" );
37 is( $newtradpost->code, 403, "Permission denied trying to upload new tradition" );
38
39 # Test /textinfo GET, POST
40 my $dneinfo = request( '/textinfo/doesnotexist' );
41 is( $dneinfo->code, 404, "Returned 404 on nonexistent text" );
42 like( $dneinfo->header('Content-Type'), qr/application\/json/,
43         "Returned JSON answer for nonexistent textinfo" );
44 my $pubinfourl = '/textinfo/' . $textids->{public};
45 is( request( '/textinfo/' . $textids->{private} )->code, 403,
46         'Denied information listing for private text' );
47 my $infoget = request( $pubinfourl );
48 ok( $infoget->is_success, 'Got information listing for public text' );
49 my $pubtextinfo = decode_json( $infoget->content );
50 is( $pubtextinfo->{textid}, $textids->{public}, 
51         'Information listing has correct text ID' );
52 my $infopost = request POST $pubinfourl, [ name => 'Changed name' ];
53 is( $infopost->code, 403, "Permission denied on POST to public text" );
54         
55 # Test /stemma GET, POST/0, POST/n
56 my $dnestemma = request( '/stemma/doesnotexist' );
57 is( $dnestemma->code, 404, "Returned 404 on nonexistent text" );
58 TODO: {
59         local $TODO = "Need to investigate";
60         like( $dnestemma->header('Content-Type'), qr/application\/json/,
61                 "Returned JSON answer for newtradition" );
62 }
63 is( request( '/stemma/' . $textids->{private} . '/2' )->code, 403, 
64         "Permission denied to view stemma on private tradition" );
65 my $pubstemurl = '/stemma/' . $textids->{public};
66 my $psreq = request( "$pubstemurl/0" );
67 ok( $psreq->is_success, "Got OK even on nonexistent stemma" );
68 like( $psreq->header('Content-Type'), qr/xml/,
69         "Returned SVG answer for stemma by default" );
70 is( $psreq->content, '', "Got empty svg for nonexistent stemma" );
71 my $pspost = request POST "$pubstemurl/n", [
72         dot => 'digraph stemma { A -> B; A -> C }'];
73 is( $pspost->code, 403, "Permission denied trying to create new stemma" );
74
75 ### Now we need a user login
76 my $mech = Test::WWW::Mechanize::Catalyst->new( catalyst_app => 'stemmaweb' );
77 $mech->get_ok( '/login', "Requested the login page successfully" );
78 $mech->submit_form(
79         form_id => 'login_local_form',
80         fields => {  username => 'swtest', password => 'swtestpass' } );
81 $mech->get_ok( '/' );
82 $mech->content_contains( 'Hello! swtest', "Successfully logged in" );
83 $mech->get_ok( '/directory', "Loaded the directory page as local user" );
84 $mech->content_contains( 'User texts', "Directory page has our own text" );
85
86
87 # Test /stemmadot GET/0
88
89 done_testing();
90
91
92 sub _make_testing_database {
93         my $fh = File::Temp->new();
94         my $file = $fh->filename;
95         $fh->unlink_on_destroy( 0 );
96         $fh->close;
97         my $dsn = 'dbi:SQLite:dbname=' . $file;
98         my $dir = Text::Tradition::Directory->new( 'dsn' => $dsn,
99                 'extra_args' => { 'create' => 1 } );
100         my $scope = $dir->new_scope;
101         
102         my $textids = {};
103         # Create a (public) tradition
104         my $pubtrad = Text::Tradition->new( input => 'Self', file => 't/data/john.xml' );
105         $pubtrad->public( 1 );
106         $textids->{'public'} = $dir->store( $pubtrad );
107                 
108         # Create a user
109         my $adminobj = $dir->add_user( { username => 'stadmin', password => 'stadminpass', role => 'admin' } );
110         my $userobj = $dir->add_user( { username => 'swtest', password => 'swtestpass' } );
111         # Create a tradition for the normal user
112         my $privtrad = Text::Tradition->new( input => 'Tabular', sep_char => ',',
113                 file => 't/data/florilegium.csv' );
114         $userobj->add_tradition( $privtrad );
115         $privtrad->add_stemma( dotfile => 't/data/florilegium.dot' );
116         $textids->{'private'} = $dir->store( $privtrad );
117         $dir->store( $userobj );
118         
119         ## Now replace the existing traditions database with the test one
120         my( $orig, $was_link );
121         if( -l $dbfile ) {
122                 $was_link = 1;
123                 $orig = readlink( $dbfile );
124                 unlink( $dbfile ) or die "Could not replace database file $dbfile";
125         } elsif( -e $dbfile ) {
126                 my $suffix = '.backup.' . time();
127                 $orig = $dbfile.$suffix;
128                 rename( $dbfile, $orig ) or die "Could not move database file $dbfile";
129         }
130         symlink( $file, $dbfile );
131         return( $orig, $was_link, $textids );
132 }
133
134 END {
135         # Restore the original database
136         unlink( readlink( $dbfile ) );
137         unlink( $dbfile );
138         if( $was_link ) {
139                 symlink( $orig_db, $dbfile );
140         } elsif( $orig_db ) {
141                 rename( $orig_db, $dbfile );
142         }
143 }