d33b5104f487f5afcadf7845c2004b413f740fe4
[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 => 76;
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   my @files = $art->files;
170   is (@files, 1, "should be one file");
171   is($files[0]->id, $file->id, "should be what we added");
172
173   my $file2 = $art->add_file
174     (
175      $cfg,
176      displayName => "test2.txt",
177      filename => "t/data/t101.jpg",
178      store => 0,
179      name => "test",
180     );
181   ok($file2, "add a second file (named)");
182   $art->uncache_files;
183   my $named = $art->file_by_name("test");
184   ok($named, "got the named file");
185   is($named->id, $file2->id, "and it's the file we added");
186 }
187
188 {
189   {
190     # fail adding an image
191     my %errors;
192     my $im = bse_add_image
193       (
194        $cfg, $art,
195        file => "t/t000load.t",
196        errors => \%errors,
197       );
198     ok(!$im, "image failed to add");
199     ok($errors{image}, "failed on the image itself");
200     is($errors{image}, "Unknown image file type", "check message");
201   }
202   {
203     my %errors;
204     my $im = bse_add_image
205       (
206        $cfg, $art,
207        file => "t/data/govhouse.jpg",
208        display_name => "test.php",
209        errors => \%errors,
210       );
211     ok($im, "image failed to add");
212     like($im->image, qr/\.jpeg$/, "check proper extension");
213   }
214 }
215
216 { # testing the indexing flags
217   my $index = bse_make_article(cfg => $cfg,
218                                title => "index test child",
219                                parentid => $art->id);
220   ok($index, "make article for should_index tests");
221   ok($index->should_index, "default should be indexed");
222   $index->set_listed(0);
223   $index->uncache;
224   ok(!$index->should_index, "not indexed if not listed");
225   $index->set_flags("I");
226   $index->uncache;
227   ok($index->should_index, "indexed if I flag set");
228   $index->set_listed(1);
229   $index->set_flags("N");
230   $index->uncache;
231   ok(!$index->should_index, "not indexed if N flag set");
232   $index->set_flags("C");
233   $index->uncache;
234   ok(!$index->should_index, "not indexed if C flag set");
235   $index->set_flags("");
236   $art->set_flags("C");
237   $art->save;
238   $index->uncache;
239   ok(!$index->should_index, "not indexed if parent's C flag set");
240
241   ok($index->remove($cfg), "remove index test");
242   undef $index;
243
244   END {
245     $index->remove($cfg) if $index;
246   }
247 }
248
249 ok($child->remove($cfg), "remove child");
250 undef $child;
251 ok($art->remove($cfg), "remove article");
252 undef $art;
253
254 {
255   my $prefix = "g" . time;
256   # deliberately out of order
257   my $im1 = bse_add_global_image
258     (
259      $cfg,
260      file => "t/data/govhouse.jpg",
261      name => $prefix . "b"
262     );
263   ok($im1, "make a global image (b)");
264   my $im2 = bse_add_global_image
265     (
266      $cfg,
267      file => "t/data/govhouse.jpg",
268      name => $prefix . "c"
269     );
270   ok($im2, "make a global image (c)");
271   my $im3 = bse_add_global_image
272     (
273      $cfg,
274      file => "t/data/govhouse.jpg",
275      name => $prefix . "a"
276     );
277   ok($im3, "make a global image (a)");
278
279   my $im4 = bse_add_global_image
280     (
281      $cfg,
282      file => "t/data/govhouse.jpg",
283     );
284   ok($im4, "make a global image (no name)");
285
286   my $site = bse_site();
287   my @images = $site->images;
288   cmp_ok(@images, '>=', 3, "we have some global images");
289
290   my @mine = grep $_->name =~ /^\Q$prefix/, @images;
291
292   # check sort order
293   is($mine[0]->displayOrder, $im1->displayOrder, "first should be first");
294   is($mine[1]->displayOrder, $im2->displayOrder, "middle should be middle");
295   is($mine[2]->displayOrder, $im3->displayOrder, "last should be last");
296
297   # fetch by name
298   my $named = $site->image_by_name($prefix . "A");
299   is($named->id, $im3->id, "check we got the right image by name");
300
301   ok($im4->remove, "remove the global image (no name)");
302   undef $im4;
303   ok($im3->remove, "remove the global image");
304   undef $im3;
305   ok($im2->remove, "remove the global image");
306   undef $im2;
307   ok($im1->remove, "remove the global image");
308   undef $im1;
309   END {
310     $im1->remove if $im1;
311     $im2->remove if $im2;
312     $im3->remove if $im3;
313     $im4->remove if $im4;
314   }
315 }
316
317 { # test that access controls are removed on article removal
318   # https://rt4.develop-help.com/Ticket/Display.html?id=1368
319   my $art = bse_make_article(cfg => $cfg,
320                              title => "010-api - access control");
321   my $artid = $art->id; # save for later
322   ok($art, "make an article");
323   $art->add_group_id(-1);
324   is_deeply([ $art->group_ids ], [ -1 ], "added group, check it stuck");
325
326   # make an admin group
327   require BSE::TB::AdminGroups;
328   my $name = "010-api group " . time;
329   my $group = BSE::TB::AdminGroups->make
330     (
331      name => $name,
332     );
333   ok($group, "make a group");
334
335   require BSE::Permissions;
336   my $perms = BSE::Permissions->new($cfg);
337   $perms->set_article_perm($artid, $group, "");
338   my $aperm = $perms->get_article_perm($artid, $group);
339   ok($aperm, "added article perms for group");
340
341   $art->remove($cfg);
342   undef $art;
343   # hack - taken from Article.pm
344   my @now_ids =  map $_->{id}, BSE::DB->query(siteuserGroupsForArticle => $artid);
345   is_deeply(\@now_ids, [], "should be no groups for that article id after article is removed");
346
347   my $aperm2 = $perms->get_article_perm($artid, $group);
348   ok(!$aperm2, "should no longer be admin permissions for that article/group");
349
350   END {
351     $art->remove($cfg) if $art;
352     $group->remove if $group;
353   }
354 }
355
356 END {
357   $child->remove($cfg) if $child;
358   $art->remove($cfg) if $art;
359 }