more metadata generalization and modification
[bse.git] / t / 050-local / 010-api.t
1 #!perl -w
2 use strict;
3 use BSE::Test qw(make_ua base_url);
4 use Test::More tests => 90;
5 use File::Spec;
6 use File::Slurp;
7 use Carp qw(confess);
8
9 $SIG{__DIE__} = sub { confess @_ };
10
11 BEGIN {
12   unshift @INC, File::Spec->catdir(BSE::Test::base_dir(), "cgi-bin", "modules");
13 }
14
15 BEGIN { use_ok("BSE::API", ":all") }
16
17 my $ua = make_ua();
18
19 my $base_cgi = File::Spec->catdir(BSE::Test::base_dir(), "cgi-bin");
20 ok(bse_init($base_cgi),   "initialize api")
21   or print "# failed to bse_init in $base_cgi\n";
22 my $cfg = bse_cfg();
23 ok($cfg, "we have a cfg object");
24
25 my $art = bse_make_article(cfg => $cfg,
26                            title => "API test");
27 ok($art, "make a basic article");
28
29 my $child = bse_make_article(cfg => $cfg,
30                              title => "API test child",
31                              parentid => $art->id);
32 ok($child, "make a child article");
33
34 ok($child->is_descendant_of($art), "check decendant by object");
35 ok($child->is_descendant_of($art->id), "check decendant by id");
36
37 my $im1 = bse_add_image($cfg, $art, file => "t/data/t101.jpg");
38 ok($im1, "add an image, just a filename");
39
40 my $byindex = $art->image_by_index(1);
41 is($byindex->id, $im1->id, "check image_by_index()");
42
43 my $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
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
93 SKIP: {
94   eval { require Imager; }
95     or skip "No Imager", 2;
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
106 {
107   my $error;
108   ok($art->set_tags([ "colour: red", "size: large" ], \$error),
109      "set some tags should succeed");
110   my $cat = BSE::TB::Articles->tag_category("colour");
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
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",
141               file => "t/t000load.t",
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,
149               filename => "t/t000load.t",
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",
159      filename => "t/t000load.t",
160      store => 0,
161     );
162   ok($file, "added a file");
163
164   # check the content
165   my $mine = read_file("t/t000load.t");
166   my $stored = read_file($file->full_filename);
167   is($stored, $mine, "check contents");
168
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
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;
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");
222 }
223
224 {
225   {
226     # fail adding an image
227     my %errors;
228     my $im = bse_add_image
229       (
230        $cfg, $art,
231        file => "t/t000load.t",
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
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
285 ok($child->remove($cfg), "remove child");
286 undef $child;
287 ok($art->remove($cfg), "remove article");
288 undef $art;
289
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
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
322   my $site = bse_site();
323   my @images = $site->images;
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
333   # fetch by name
334   my $named = $site->image_by_name($prefix . "A");
335   is($named->id, $im3->id, "check we got the right image by name");
336
337   ok($im4->remove, "remove the global image (no name)");
338   undef $im4;
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;
349     $im4->remove if $im4;
350   }
351 }
352
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
392 END {
393   $child->remove($cfg) if $child;
394   $art->remove($cfg) if $art;
395 }