5 use HTTP::Request::Common;
6 use JSON qw/ decode_json /;
8 use Test::WWW::Mechanize::Catalyst;
9 use Text::Tradition::Directory;
11 use Catalyst::Test 'stemmaweb';
13 use vars qw( $orig_db $was_link );
15 my $dbfile = 'db/traditions.db';
16 ( $orig_db, $was_link, $textids ) = _make_testing_database();
18 ## Tests that do not require being logged in
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" );
28 # Test /newtradition POST
29 my $newtradpost = request POST '/newtradition',
30 'Content-Type' => 'form-data',
32 name => 'new tradition',
33 file => [ 't/data/besoin.xml' ]
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" );
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" );
55 # Test /stemma GET, POST/0, POST/n
56 my $dnestemma = request( '/stemma/doesnotexist' );
57 is( $dnestemma->code, 404, "Returned 404 on nonexistent text" );
59 local $TODO = "Need to investigate";
60 like( $dnestemma->header('Content-Type'), qr/application\/json/,
61 "Returned JSON answer for newtradition" );
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" );
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" );
79 form_id => 'login_local_form',
80 fields => { username => 'swtest', password => 'swtestpass' } );
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" );
87 # Test /stemmadot GET/0
92 sub _make_testing_database {
93 my $fh = File::Temp->new();
94 my $file = $fh->filename;
95 $fh->unlink_on_destroy( 0 );
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;
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 );
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 );
119 ## Now replace the existing traditions database with the test one
120 my( $orig, $was_link );
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";
130 symlink( $file, $dbfile );
131 return( $orig, $was_link, $textids );
135 # Restore the original database
136 unlink( readlink( $dbfile ) );
139 symlink( $orig_db, $dbfile );
140 } elsif( $orig_db ) {
141 rename( $orig_db, $dbfile );