more metadata generalization and modification
[bse.git] / t / 050-local / 010-api.t
CommitLineData
bd903bc5
TC
1#!perl -w
2use strict;
eb893bf5 3use BSE::Test qw(make_ua base_url);
4029e8ab 4use Test::More tests => 90;
bd903bc5 5use File::Spec;
60618c6c 6use File::Slurp;
bd903bc5
TC
7use Carp qw(confess);
8
9$SIG{__DIE__} = sub { confess @_ };
10
11BEGIN {
12 unshift @INC, File::Spec->catdir(BSE::Test::base_dir(), "cgi-bin", "modules");
13}
14
15BEGIN { use_ok("BSE::API", ":all") }
16
eb893bf5
TC
17my $ua = make_ua();
18
bd903bc5
TC
19my $base_cgi = File::Spec->catdir(BSE::Test::base_dir(), "cgi-bin");
20ok(bse_init($base_cgi), "initialize api")
21 or print "# failed to bse_init in $base_cgi\n";
22my $cfg = bse_cfg();
23ok($cfg, "we have a cfg object");
24
25my $art = bse_make_article(cfg => $cfg,
26 title => "API test");
27ok($art, "make a basic article");
28
66645f03
TC
29my $child = bse_make_article(cfg => $cfg,
30 title => "API test child",
31 parentid => $art->id);
32ok($child, "make a child article");
33
34ok($child->is_descendant_of($art), "check decendant by object");
35ok($child->is_descendant_of($art->id), "check decendant by id");
36
bd903bc5
TC
37my $im1 = bse_add_image($cfg, $art, file => "t/data/t101.jpg");
38ok($im1, "add an image, just a filename");
39
fb400436
TC
40my $byindex = $art->image_by_index(1);
41is($byindex->id, $im1->id, "check image_by_index()");
42
bd903bc5
TC
43my $im2;
44{
45 open my $fh, "<", "t/data/t101.jpg"
46 or die "Cannot open test image: $!\n";
47 $im2 = bse_add_image($cfg, $art, fh => $fh, display_name => "t101.jpg");
48 ok($im2, "add an image by fh");
49}
50
51# just set alt text
52{
53 my %errors;
54 ok(bse_save_image($im1, alt => "Test", errors => \%errors),
55 "update alt text");
56 my $im = BSE::TB::Images->getByPkey($im1->id);
57 ok($im, "found im1 independently");
58 is($im->alt, "Test", "alt is set");
59}
60
61{ # change the image content (by name)
62 my %errors;
63 ok(bse_save_image($im1, file => "t/data/govhouse.jpg", errors => \%errors),
64 "save new image content");
65 is_deeply(\%errors, {}, "no errors");
66 like($im1->src, qr(^/), "src should start with /, assuming no storage");
67}
68
69{ # change the image content (by fh)
70 my %errors;
71 open my $fh, "<", "t/data/govhouse.jpg"
72 or die "Cannot open t/data/govhouse.jpg: $!";
73 ok(bse_save_image($im2, fh => $fh, , display_name => "govhouse.jpg",
74 errors => \%errors),
75 "save new image content (by fh)");
76 is_deeply(\%errors, {}, "no errors");
77 like($im2->src, qr(^/), "src should start with /, assuming no storage");
78}
79
eb893bf5
TC
80{
81 # check we can retrieve the image
82 my $src = base_url() . $im2->image_url;
83 my $imres = $ua->get($src);
84 open my $fh, "<", "t/data/govhouse.jpg"
85 or die "Cannot open t/data/govhouse.jpg: $!";
86 binmode $fh;
87 my $orig = do { local $/; <$fh> };
88 close $fh;
89 ok($imres->is_success, "got some data");
90 is($imres->decoded_content, $orig, "check it matches");
91}
92
6271b583
TC
93SKIP: {
94 eval { require Imager; }
95 or skip "No Imager", 2;
eb893bf5
TC
96 # check thumbnailing
97 my $thumb_url = base_url() . $im2->dynamic_thumb_url(geo => "editor");
98 $thumb_url .= "&cache=0";
99 print "# $thumb_url\n";
100 my $thumb_res = $ua->get($thumb_url);
101 ok($thumb_res->is_success, "successful fetch");
102 like($thumb_res->content_type, qr(^image/[a-z]+$), "check content type");
103 print "# ", $thumb_res->content_type, "\n";
104}
105
34c37938
TC
106{
107 my $error;
108 ok($art->set_tags([ "colour: red", "size: large" ], \$error),
109 "set some tags should succeed");
e0ed81d7 110 my $cat = BSE::TB::Articles->tag_category("colour");
34c37938
TC
111 ok($cat, "get the 'colour' tag cat");
112 my @orig_deps = $cat->deps;
113
114 ok($cat->set_deps([], \$error), "empty deps list")
115 or diag "setting deps empty: ", $error;
116
117 ok($cat->set_deps([ "abc:", "def :", "efg: ", "alpha:beta" ], \$error),
118 "set deps");
119 is_deeply([$cat->deps],
120 [ "abc:", "alpha: beta", "def:", "efg:" ],
121 "check they were set");
122
123 ok($cat->set_deps([ "abc:", "hij:" ], \$error),
124 "set deps that add and remove to the list");
125
126 is_deeply([$cat->deps],
127 [ "abc:", "hij:" ],
128 "check they were set");
129
130 ok($cat->set_deps(\@orig_deps, \$error), "restore deps list")
131 or diag "restoring deps: ", $error;
132}
133
60618c6c
TC
134{ # adding a file
135 { # this should fail, file isn't a handle
136 my $file;
137 ok(!eval { $file = $art->add_file
138 (
139 $cfg,
140 displayName => "test.txt",
8d57c486 141 file => "t/t000load.t",
60618c6c
TC
142 store => 0,
143 ) }, "file must be a file handle");
144 like($@, qr/file must be a file handle/, "check message");
145
146 ok(!eval { $file = $art->add_file
147 (
148 $cfg,
8d57c486 149 filename => "t/t000load.t",
60618c6c
TC
150 store => 0,
151 ) }, "displayName is required");
152 like($@, qr/displayName must be non-blank/, "check message");
153 }
154
155 my $file = $art->add_file
156 (
157 $cfg,
158 displayName => "test.txt",
8d57c486 159 filename => "t/t000load.t",
60618c6c
TC
160 store => 0,
161 );
162 ok($file, "added a file");
163
164 # check the content
8d57c486 165 my $mine = read_file("t/t000load.t");
60618c6c
TC
166 my $stored = read_file($file->full_filename);
167 is($stored, $mine, "check contents");
61c61429 168
4029e8ab
TC
169 # add some metadata
170 my $name = "n" . time();
171 my $meta = $file->add_meta
172 (
173 name => $name,
174 value => "Test text",
175 );
176 ok($meta, "add meta data");
177 is($meta->name, $name, "check name");
178 is($meta->content_type, "text/plain", "check content type");
179 ok($meta->is_text, "it qualifies as text");
180 is($meta->value, "Test text", "check value");
181
182 my @names = $file->metanames;
183 ok(@names, "we got some meta names");
184 my ($found) = grep $_ eq $name, @names;
185 ok($found, "and found the meta name we added");
186
187 my @meta = $file->metadata;
188 ok(@meta, "we have some metadata");
189 my ($found_meta) = grep $_->name eq $name, @meta;
190 ok($found_meta, "and found the one we added");
191
192 my @tmeta = $file->text_metadata;
193 ok(@tmeta, "we have some text metadata");
194 my ($found_tmeta) = grep $_->name eq $name, @tmeta;
195 ok($found_tmeta, "and found the one we added");
196
197 my $named = $file->meta_by_name($name);
198 ok($named, "found added meta by name");
199
200 my @info = $file->metainfo;
201 ok(@info, "found metainfo");
202 my ($info) = grep $_->{name} eq $name, @info;
203 ok($info, "and found the info we added");
204
61c61429
TC
205 my @files = $art->files;
206 is (@files, 1, "should be one file");
207 is($files[0]->id, $file->id, "should be what we added");
208
209 my $file2 = $art->add_file
210 (
211 $cfg,
212 displayName => "test2.txt",
213 filename => "t/data/t101.jpg",
214 store => 0,
215 name => "test",
216 );
217 ok($file2, "add a second file (named)");
218 $art->uncache_files;
4029e8ab
TC
219 my $named_test = $art->file_by_name("test");
220 ok($named_test, "got the named file");
221 is($named_test->id, $file2->id, "and it's the file we added");
60618c6c
TC
222}
223
ec9b99b2
TC
224{
225 {
226 # fail adding an image
227 my %errors;
228 my $im = bse_add_image
229 (
230 $cfg, $art,
8d57c486 231 file => "t/t000load.t",
ec9b99b2
TC
232 errors => \%errors,
233 );
234 ok(!$im, "image failed to add");
235 ok($errors{image}, "failed on the image itself");
236 is($errors{image}, "Unknown image file type", "check message");
237 }
238 {
239 my %errors;
240 my $im = bse_add_image
241 (
242 $cfg, $art,
243 file => "t/data/govhouse.jpg",
244 display_name => "test.php",
245 errors => \%errors,
246 );
247 ok($im, "image failed to add");
248 like($im->image, qr/\.jpeg$/, "check proper extension");
249 }
250}
251
496ba394
TC
252{ # testing the indexing flags
253 my $index = bse_make_article(cfg => $cfg,
254 title => "index test child",
255 parentid => $art->id);
256 ok($index, "make article for should_index tests");
257 ok($index->should_index, "default should be indexed");
258 $index->set_listed(0);
259 $index->uncache;
260 ok(!$index->should_index, "not indexed if not listed");
261 $index->set_flags("I");
262 $index->uncache;
263 ok($index->should_index, "indexed if I flag set");
264 $index->set_listed(1);
265 $index->set_flags("N");
266 $index->uncache;
267 ok(!$index->should_index, "not indexed if N flag set");
268 $index->set_flags("C");
269 $index->uncache;
270 ok(!$index->should_index, "not indexed if C flag set");
271 $index->set_flags("");
272 $art->set_flags("C");
273 $art->save;
274 $index->uncache;
275 ok(!$index->should_index, "not indexed if parent's C flag set");
276
277 ok($index->remove($cfg), "remove index test");
278 undef $index;
279
280 END {
281 $index->remove($cfg) if $index;
282 }
283}
284
66645f03 285ok($child->remove($cfg), "remove child");
60618c6c 286undef $child;
bd903bc5 287ok($art->remove($cfg), "remove article");
60618c6c
TC
288undef $art;
289
47e2aec7
TC
290{
291 my $prefix = "g" . time;
292 # deliberately out of order
293 my $im1 = bse_add_global_image
294 (
295 $cfg,
296 file => "t/data/govhouse.jpg",
297 name => $prefix . "b"
298 );
299 ok($im1, "make a global image (b)");
300 my $im2 = bse_add_global_image
301 (
302 $cfg,
303 file => "t/data/govhouse.jpg",
304 name => $prefix . "c"
305 );
306 ok($im2, "make a global image (c)");
307 my $im3 = bse_add_global_image
308 (
309 $cfg,
310 file => "t/data/govhouse.jpg",
311 name => $prefix . "a"
312 );
313 ok($im3, "make a global image (a)");
314
42c261c3
TC
315 my $im4 = bse_add_global_image
316 (
317 $cfg,
318 file => "t/data/govhouse.jpg",
319 );
320 ok($im4, "make a global image (no name)");
321
fb400436
TC
322 my $site = bse_site();
323 my @images = $site->images;
47e2aec7
TC
324 cmp_ok(@images, '>=', 3, "we have some global images");
325
326 my @mine = grep $_->name =~ /^\Q$prefix/, @images;
327
328 # check sort order
329 is($mine[0]->displayOrder, $im1->displayOrder, "first should be first");
330 is($mine[1]->displayOrder, $im2->displayOrder, "middle should be middle");
331 is($mine[2]->displayOrder, $im3->displayOrder, "last should be last");
332
fb400436 333 # fetch by name
e1d80b8d 334 my $named = $site->image_by_name($prefix . "A");
fb400436
TC
335 is($named->id, $im3->id, "check we got the right image by name");
336
42c261c3
TC
337 ok($im4->remove, "remove the global image (no name)");
338 undef $im4;
47e2aec7
TC
339 ok($im3->remove, "remove the global image");
340 undef $im3;
341 ok($im2->remove, "remove the global image");
342 undef $im2;
343 ok($im1->remove, "remove the global image");
344 undef $im1;
345 END {
346 $im1->remove if $im1;
347 $im2->remove if $im2;
348 $im3->remove if $im3;
42c261c3 349 $im4->remove if $im4;
47e2aec7
TC
350 }
351}
352
7bf4efe4
TC
353{ # test that access controls are removed on article removal
354 # https://rt4.develop-help.com/Ticket/Display.html?id=1368
355 my $art = bse_make_article(cfg => $cfg,
356 title => "010-api - access control");
357 my $artid = $art->id; # save for later
358 ok($art, "make an article");
359 $art->add_group_id(-1);
360 is_deeply([ $art->group_ids ], [ -1 ], "added group, check it stuck");
361
362 # make an admin group
363 require BSE::TB::AdminGroups;
364 my $name = "010-api group " . time;
365 my $group = BSE::TB::AdminGroups->make
366 (
367 name => $name,
368 );
369 ok($group, "make a group");
370
371 require BSE::Permissions;
372 my $perms = BSE::Permissions->new($cfg);
373 $perms->set_article_perm($artid, $group, "");
374 my $aperm = $perms->get_article_perm($artid, $group);
375 ok($aperm, "added article perms for group");
376
377 $art->remove($cfg);
378 undef $art;
379 # hack - taken from Article.pm
380 my @now_ids = map $_->{id}, BSE::DB->query(siteuserGroupsForArticle => $artid);
381 is_deeply(\@now_ids, [], "should be no groups for that article id after article is removed");
382
383 my $aperm2 = $perms->get_article_perm($artid, $group);
384 ok(!$aperm2, "should no longer be admin permissions for that article/group");
385
386 END {
387 $art->remove($cfg) if $art;
388 $group->remove if $group;
389 }
390}
391
60618c6c
TC
392END {
393 $child->remove($cfg) if $child;
394 $art->remove($cfg) if $art;
395}