require methods we assume existence of; add Module::Load to Language
[scpubgit/stemmatology.git] / base / t / text_tradition_user.t
1 #!/usr/bin/perl
2
3 use strict;
4 use warnings;
5
6 use Test::More 'no_plan';
7 use File::Temp;
8 use TryCatch;
9
10 use_ok('Text::Tradition::Directory');
11
12 my $fh = File::Temp->new();
13 my $file = $fh->filename;
14 $fh->close;
15 my $dsn = "dbi:SQLite:dbname=$file";
16
17 my $user_store = Text::Tradition::Directory->new('dsn' => $dsn,
18                                                  'extra_args' => { 'create' => 1 } );
19
20 my $scope = $user_store->new_scope;
21
22 ## passwords
23 my $shortpass = 'bloggs';
24 ok(!$user_store->validate_password($shortpass), '"bloggs" is too short for a password');
25 try {
26         my $dud_user = $user_store->add_user({ username => 'joe',
27                                                                                    password => $shortpass });
28         ok( 0, "User with short password should not have been created" );
29 } catch ( Text::Tradition::Error $e ) {
30         is( $e->message, "Invalid password - must be at least " 
31                 . $user_store->MIN_PASS_LEN . " characters long",
32                 "Attempt to add user with too-short password threw correct error" );
33 }
34
35 ## create user
36 my $new_user = $user_store->add_user({ username => 'fred',
37                                        password => 'bloggspass'});
38 isa_ok($new_user, 'Text::Tradition::User');
39 is($new_user->active, 1, 'New user created and active');
40 is($new_user->email, 'fred', 'Email value set to username');
41 ok(!$new_user->is_admin, 'New user is not an admin');
42
43 ## find user
44 my $find_user = $user_store->find_user({ username => 'fred'});
45 isa_ok($find_user, 'Text::Tradition::User');
46 ok($find_user->check_password('bloggspass'), 'Stored & retrieved with correct password');
47
48 ## modify user
49 my $changed_user = $user_store->modify_user({ username => 'fred',
50                                               password => 'passbloggs' });
51 isa_ok($changed_user, 'Text::Tradition::User');
52 my $changed = $user_store->find_user({ username => 'fred'});
53 ok($changed->check_password('passbloggs'), 'Modified & retrieved with correct new password');
54
55 {
56 ## deactivate user
57 ## Sets all traditions to non-public, deactivates
58     my $user = $user_store->add_user({ username => 'testactive',
59                                        password => 'imanactiveuser' });
60     ok($user->active, 'Deactivate test user starts active');
61
62     my $d_user = $user_store->deactivate_user({ username => 'testactive' });
63     is($d_user->active, 0, 'Deactivated user');
64     is($user_store->find_user({ username => 'testactive' }), undef, 'Deactivated user not returned by find_user');
65
66 ## TODO - add test where user has traditions to start with
67 }
68
69 {
70 ## reactivate user
71 ## reactivates user, does not mess with their traditions (as we don't know which were public to start with)
72
73     my $user = $user_store->add_user({ username => 'testinactive',
74                                        password => 'imaninactiveuser' });
75     my $d_user = $user_store->deactivate_user({ username => 'testinactive' });
76     ok(!$d_user->active, 'Deactivate test user starts active');   
77     
78     my $a_user = $user_store->reactivate_user({ username => 'testinactive' });
79     is($a_user->active, 1, 'Re-activated user');
80     ok($user_store->find_user({ username => 'testinactive' }), 'Re-activated user returned by find_user again');
81 }
82
83 {
84 ## delete user (admin only?)
85     my $user = $user_store->add_user({ username => 'testdelete',
86                                        password => 'imgoingtobedeleted' });
87
88     my $gone = $user_store->delete_user({ username => 'testdelete' });
89
90     my $d_user = $user_store->find_user({ username => 'testdelete' });
91
92     ok($gone && !$d_user, 'Deleted user completely from store');
93 }
94
95 {
96 ## add_tradition
97     use Text::Tradition;
98     my $t = Text::Tradition->new( 
99         'name'  => 'inline', 
100         'input' => 'Tabular',
101         'file'  => 't/data/simple.txt',
102         );
103
104     my $uuid = $user_store->save($t);
105     my $user = $user_store->add_user({ username => 'testadd',
106                                        password => 'testingtraditions' });
107     $user->add_tradition($t);
108     $user_store->update($user);
109
110     is( scalar @{$user->traditions}, 1, 'Added one tradition');
111
112     my @tlist = $user_store->traditionlist($user);
113     is($tlist[0]->{name}, $t->name, 'Traditionlist returns same named user->tradition');
114     is($tlist[0]->{id}, $uuid, 'Traditionlist returns actual tradition with same uuid we put in earlier');
115     my $fetched_t = $user_store->tradition($tlist[0]->{id});
116     is($fetched_t->user->id, $user->id, 'Traditionlist returns item belonging to this user');
117
118     ## add a second, not owned by this user, we shouldn't return it from
119     ## traditionslist
120     my $t2 = Text::Tradition->new( 
121         'name'  => 'inline', 
122         'input' => 'Tabular',
123         'file'  => 't/data/simple.txt',
124         );
125     $user_store->save($t2);
126     my @tlist2 = $user_store->traditionlist($user);
127     is(scalar @tlist2, 1, 'With 2 stored traditions, we only fetch one');
128     my $fetched_t2 = $user_store->tradition($tlist[0]->{id});
129     is($fetched_t2->user->id, $user->id, 'Traditionlist returns item belonging to this user');
130     
131     
132 }
133
134
135 ## Fetch public traditions, not user traditions, when not fetching with a user
136 use Text::Tradition;
137 my $t = Text::Tradition->new( 
138         'name'  => 'inline', 
139         'input' => 'Tabular',
140         'file'  => 't/data/simple.txt',
141 );
142
143 $user_store->save($t);
144 my $user = $user_store->add_user({ username => 'testpublic',
145                                                                    password => 'testingtraditions' });
146 $user->add_tradition($t);
147 $user_store->update($user);
148
149 ## add a second, not owned by this user, we shouldn't return it from
150 ## traditionslist
151 my $t2 = Text::Tradition->new( 
152         'name'  => 'inline', 
153         'input' => 'Tabular',
154         'file'  => 't/data/simple.txt',
155 );
156 $t2->public(1);
157 my $uuid = $user_store->save($t2);
158
159 my @tlist = $user_store->traditionlist('public');
160 is(scalar @tlist, 1, 'Got one public tradition');
161 is($tlist[0]->{name}, $t2->name, 'Traditionlist returns same named user->tradition');
162 is($tlist[0]->{id}, $uuid, 'Traditionlist returns actual tradition with same uuid we put in earlier');
163 my $fetched_t = $user_store->tradition($tlist[0]->{id});
164 ok($fetched_t->public, 'Traditionlist returns public item');
165
166
167 {
168 ## remove_tradition
169     use Text::Tradition;
170     my $t = Text::Tradition->new( 
171         'name'  => 'inline', 
172         'input' => 'Tabular',
173         'file'  => 't/data/simple.txt',
174         );
175
176     my $uuid = $user_store->save($t);
177     my $user = $user_store->add_user({ username => 'testremove',
178                                        password => 'testingtraditions' });
179     $user->add_tradition($t);
180     $user_store->update($user);
181
182     $user->remove_tradition($t);
183     $user_store->update($user);
184     my $changed_t = $user_store->tradition($uuid);
185
186     is( scalar @{$user->traditions}, 0, 'Added and removed one tradition');
187     ok(!$changed_t->has_user, 'Removed user from tradition');
188
189     my @tlist = $user_store->traditionlist($user);
190     is(scalar @tlist, 0, 'Traditionlist now empty');
191 }
192
193 {
194     ## Add admin user
195     my $admin = $user_store->add_user({
196         username => 'adminuser',
197         password => 'adminpassword',
198         role     => 'admin' });
199
200     ok($admin->is_admin, 'Got an admin user');
201
202     ## test admins get all traditions
203     use Text::Tradition;
204     my $t = Text::Tradition->new( 
205         'name'  => 'inline', 
206         'input' => 'Tabular',
207         'file'  => 't/data/simple.txt',
208         );
209
210     $user_store->save($t);
211
212     my @tlist = $user_store->traditionlist(); ## all traditions
213     my @admin_tlist = $user_store->traditionlist($admin);
214
215     is(scalar @admin_tlist, scalar @tlist, 'Got all traditions for admin user');
216
217 }
218
219 {
220     ## Add/find simple openid user with OpenIDish parameters:
221
222     my $openid_user = $user_store->create_user({ 
223         url => 'http://username.myopenid.com',
224         email => 'username.myopenid.com',
225     });
226     ok($openid_user, 'Created user from OpenID params');
227
228     my $get_openid_user = $user_store->find_user({
229         url => 'http://username.myopenid.com',
230         email => 'username.myopenid.com',
231     });
232
233     ok($openid_user == $get_openid_user, 'Found OpenID user again');
234     is($get_openid_user->id, 'http://username.myopenid.com', 'Set id to unique url from openid');
235     is($get_openid_user->email, 'username.myopenid.com', 'Kept original email value');
236 }
237
238 {
239     ## Add/find openid user with email attribute:
240     my $openid_user = $user_store->create_user({ 
241         url => 'http://blahblah.com/foo/bar/baz/lotsofjunk',
242         email => 'http://blahblah.com/foo/bar/baz/lotsofjunk',
243         extensions => {
244             'http://openid.net/srv/ax/1.0' => { 
245                 'value.email' => 'fredbloggs@blahblah.com',
246                 'type.email' => 'http://axschema.org/contact/email',
247                 'mode' => 'fetch_response',
248             },
249         },
250     });
251     ok($openid_user, 'Created user from OpenID params');
252
253     my $get_openid_user = $user_store->find_user({
254         url => 'http://blahblah.com/foo/bar/baz/lotsofjunk',
255         email => 'http://blahblah.com/foo/bar/baz/lotsofjunk',
256         extensions => {
257             'http://openid.net/srv/ax/1.0' => { 
258                 'value.email' => 'fredbloggs@blahblah.com',
259                 'type.email' => 'http://axschema.org/contact/email',
260                 'mode' => 'fetch_response',
261             },
262         },
263     });
264
265     ok($openid_user == $get_openid_user, 'Found OpenID user again');
266     is($get_openid_user->id, 'http://blahblah.com/foo/bar/baz/lotsofjunk', 'Set id to unique url from openid');
267     is($get_openid_user->email, 'fredbloggs@blahblah.com', 'Set email value to email from extension');
268 }