Commit | Line | Data |
0fa271b6 |
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 | } |