fix a bug caught by a 5.22.0 warning
[bse.git] / t / 080-remote / 010-save.t
1 #!perl -w
2 use strict;
3 use BSE::Test qw(make_ua base_url);
4 use JSON;
5 use DevHelp::HTML;
6 use Test::More;
7 use BSE::TB::Article;
8 use Time::HiRes qw(time sleep);
9
10 my @cols = BSE::TB::Article->columns;
11
12 my $base = 130;
13
14 my $count = $base + (@cols - 13) * 4;
15
16 plan tests => $count;
17
18 $| = 1;
19
20 my $ua = make_ua;
21 my $baseurl = base_url;
22
23 my $add_url = $baseurl . "/cgi-bin/admin/add.pl";
24
25 my @ajax_hdr = qw(X-Requested-With XMLHttpRequest);
26
27 my %add_req =
28   (
29    save => 1,
30    title => "test",
31    parentid => -1,
32    _context => "test context",
33   );
34 my $art_data = do_req($add_url, \%add_req, "add article");
35
36 SKIP:
37 {
38   $art_data or skip("no response to add", 20);
39   ok($art_data->{success}, "successful json response");
40
41   is($art_data->{context}, "test context", "check context returned");
42
43   my $art = $art_data->{article};
44   my $orig_lastmod = $art->{lastModified};
45
46   # try to fetch by id
47  SKIP:
48   {
49     my %fetch_req =
50       (
51        a_article => 1,
52        id => $art->{id},
53       );
54     my $data = do_req($add_url, \%fetch_req, "fetch just saved")
55       or skip("no json", 2);
56     ok($data->{success}, "successful");
57     ok($data->{article}, "has an article");
58     my %temp = %$art;
59     for my $field (qw/release expire/) {
60       delete $temp{$field};
61       delete $data->{article}{$field};
62     }
63     is_deeply($data->{article}, \%temp, "check it matches what we saved");
64     ok($data->{article}{tags}, "has a tags member");
65     is_deeply($data->{article}{tags}, [], "which is an empty array ref");
66   }
67
68   my @fields = grep 
69     {
70       defined $art->{$_}
71         && !/^(id|created|link|admin|files|images|cached_dynamic|createdBy|generator|level|lastModified(By)?|displayOrder)$/
72           && !/^thumb/
73         } keys %$art;
74
75   for my $field (@fields) {
76     print "# save test $field\n";
77     my %reqdata =
78       (
79        save => 1,
80        id => $art->{id},
81        $field => $art->{$field},
82        lastModified => $art->{lastModified},
83       );
84     my $data = do_req($add_url, \%reqdata, "set $field");
85   SKIP:
86     {
87       $data or skip("Not json from setting $field", 2);
88       ok($data->{success}, "success flag is set");
89       ok($data->{article}, "has an article object");
90       $art = $data->{article};
91     }
92   }
93
94   { # try to set a bad value for category
95     my %req_data = 
96       (
97        save => 1,
98        id => $art->{id},
99        category => "A" . rand(),
100        lastModified => $art->{lastModified},
101       );
102     my $data = do_req($add_url, \%req_data, "save bad category");
103   SKIP:
104     {
105       $data or skip("Not json from setting bad category", 4);
106       ok(!$data->{success}, "shouldn't be successful");
107       ok(!$data->{article}, "should be no article object");
108       is($data->{error_code}, "FIELD", "should be a field error");
109       ok($data->{errors} && $data->{errors}{category},
110          "should be an error message for category");
111     }
112   }
113
114   my $tag_name1 = "YHUIOP";
115   my $tag_name2 = "zyx: alpha";
116   { # save tags
117     my %reqdata =
118       (
119        save => 1,
120        id => $art->{id},
121        _save_tags => 1,
122        tags => [ $tag_name2, " $tag_name1 " ],
123        lastModified => $art->{lastModified},
124       );
125     my $data = do_req($add_url, \%reqdata, "set tags");
126   SKIP:
127     {
128       $data or skip("Not json from setting tags", 2);
129       ok($data->{success}, "success flag set");
130       is_deeply($data->{article}{tags}, [ $tag_name1, $tag_name2 ],
131                 "check tags saved");
132       $art = $data->{article};
133     }
134   }
135
136   { # grab the tree
137     my %tree_req =
138       (
139        a_tree => 1,
140        id => -1,
141       );
142     my $data = do_req($add_url, \%tree_req, "fetch tree");
143     $data or skip("not a json response", 6);
144     ok($data->{success}, "was successful");
145     ok($data->{articles}, "has articles");
146     my $art = $data->{articles}[0];
147     ok(defined $art->{level}, "entries have level");
148     ok($art->{title}, "entries have a title");
149     ok(defined $art->{listed}, "entries have a listed");
150     ok($art->{lastModified}, "entries have a lastModified");
151   }
152
153   { # grab the tags
154     my %tag_req =
155       (
156        a_tags => 1,
157        id => -1,
158       );
159     my $data = do_req($add_url, \%tag_req, "fetch tags");
160   SKIP:
161     {
162       $data or skip("not a json response", 4);
163       ok($data->{tags}, "it has tags");
164       my ($xyz_tag) = grep $_->{name} eq $tag_name2, @{$data->{tags}};
165       ok($xyz_tag, "check we found the tag we set");
166       is($xyz_tag->{cat}, "zyx", "check cat");
167       is($xyz_tag->{val}, "alpha", "check val");
168     }
169   }
170
171   my $tag1;
172   my $tag2;
173   { # grab them with article ids
174     my %tag_req =
175       (
176        a_tags => 1,
177        id => -1,
178        showarts => 1,
179       );
180     my $data = do_req($add_url, \%tag_req, "fetch tags");
181   SKIP:
182     {
183       $data or skip("not a json response", 6);
184       ok($data->{tags}, "it has tags");
185       ($tag1) = grep $_->{name} eq $tag_name1, @{$data->{tags}};
186       ($tag2) = grep $_->{name} eq $tag_name2, @{$data->{tags}};
187       ok($tag2, "check we found the tag we set");
188       is($tag2->{cat}, "zyx", "check cat");
189       is($tag2->{val}, "alpha", "check val");
190       ok($tag2->{articles}, "has articles");
191       ok(grep($_ == $art->{id}, @{$tag2->{articles}}),
192               "has our article id in it");
193     }
194   }
195
196  SKIP:
197   { # delete a tag globally
198     $tag2
199       or skip("didn't find the tag we want to remove", 6);
200     my %del_req =
201       (
202        a_tagdelete => 1,
203        id => -1,
204        tag_id => $tag2->{id},
205       );
206     my $data = do_req($add_url, \%del_req, "delete tag");
207   SKIP:
208     {
209       $data or skip("not a json response", 7);
210       ok($data->{success}, "successful");
211
212       # refetch tag list and make sure it's gone
213       my %get_req =
214         (
215          a_tags => 1,
216          id => -1,
217         );
218       my $tags_data = do_req($add_url, \%get_req, "refetch tags");
219       my ($tag) = grep $_->{name} eq $tag_name2, @{$data->{tags}};
220       ok(!$tag, "should be gone");
221
222       # try to delete it again
223       my $redel_data = do_req($add_url, \%del_req, "delete should fail");
224       $redel_data
225         or skip("not a json response", 3);
226       ok(!$redel_data->{success}, "should fail");
227       is($redel_data->{error_code}, "FIELD", "check error code");
228       ok($redel_data->{errors}{tag_id}, "and error message on field");
229     }
230   }
231
232   { # rename a tag
233     my %ren_req =
234       (
235        a_tagrename => 1,
236        id => -1,
237        tag_id => $tag1->{id},
238        name => $tag_name2, # rename over just removed tag
239       );
240
241     my $data = do_req($add_url, \%ren_req, "rename tag");
242   SKIP:
243     {
244       $data
245         or skip("not a json response", 4);
246       ok($data->{success}, "successful");
247       ok($data->{tag}, "returned updated tag");
248       is($data->{tag}{name}, $tag_name2, "check name saved");
249     }
250   }
251
252   { # refetch the article to check the tags
253     my %fetch_req =
254       (
255        a_article => 1,
256        id => $art->{id},
257       );
258     my $data = do_req($add_url, \%fetch_req, "fetch just saved")
259       or skip("no json", 2);
260     ok($data->{success}, "check success");
261     is_deeply($data->{article}{tags}, [ $tag_name2 ],
262               "check the tags");
263   }
264
265  SKIP:
266   { # add some images
267     my %image_req =
268       (
269        id => $art->{id},
270        addimg => 1,
271        image => [ "t/data/govhouse.jpg" ],
272       );
273     my $data = do_multi_req($add_url, \%image_req, "add first image")
274       or skip("response failed", 9);
275     ok($data->{success}, "success")
276       or skip("response failed", 8);
277     ok($data->{image}, "has an image");
278     my $im1 = $data->{image};
279
280     $image_req{image} = [ "t/data/t101.jpg" ];
281     $data = do_multi_req($add_url, \%image_req, "add second image")
282       or skip("response failed", 6);
283     ok($data->{success}, "success")
284       or skip("response failed: $data->{message}", 5);
285     ok($data->{image}, "has an image");
286     my $im2 = $data->{image};
287
288     # set their order
289     $data = do_req
290       ($add_url,
291        {
292         a_order_images => 1,
293         id => $art->{id},
294         order => $im1->{id} . "," . $im2->{id},
295        },
296        "set image order")
297         or skip("set image order", 3);
298     ok($data->{success}, "successfully ordered")
299       or skip("failed ordering", 2);
300     ok($data->{images}, "had images")
301       or skip("no images", 1);
302     is($data->{images}[0]{id}, $im1->{id}, "ordering worked");
303   }
304
305   # error handling on save
306  SKIP:
307   { # bad title
308     my %bad_title =
309       (
310        save => 1,
311        id => $art->{id},
312        title => "",
313        lastModified => $art->{lastModified},
314       );
315     my $data = do_req($add_url, \%bad_title, "save bad title");
316     $data or skip("not a json response", 2);
317     ok(!$data->{success}, "should be failure");
318     is($data->{error_code}, "FIELD", "should be a field error");
319     ok($data->{errors}{title}, "should be a message for the title");
320   }
321  SKIP:
322   { # bad template
323     my %bad_template =
324       (
325        save => 1,
326        id => $art->{id},
327        template => "../../etc/passwd",
328        lastModified => $art->{lastModified},
329       );
330     my $data = do_req($add_url, \%bad_template, "save bad template");
331     $data or skip("not a json response", 2);
332     ok(!$data->{success}, "should be failure");
333     is($data->{error_code}, "FIELD", "should be a field error");
334     ok($data->{errors}{template}, "should be a message for the template");
335   }
336  SKIP:
337   { # bad last modified
338     my %bad_lastmod =
339       (
340        save => 1,
341        id => $art->{id},
342        title => "test",
343        lastModified => $orig_lastmod,
344       );
345     my $data = do_req($add_url, \%bad_lastmod, "save bad lastmod");
346     $data or skip("not a json response", 2);
347     ok(!$data->{success}, "should be failure");
348     is($data->{error_code}, "LASTMOD", "should be a last mod error");
349   }
350  SKIP:
351   { # bad parent
352     my %bad_parent =
353       (
354        save => 1,
355        id => $art->{id},
356        parentid => $art->{id},
357        lastModified => $art->{lastModified},
358       );
359     my $data = do_req($add_url, \%bad_parent, "save bad parent");
360     $data or skip("not a json response", 2);
361     ok(!$data->{success}, "should be failure");
362     is($data->{error_code}, "PARENT", "should be a parent error");
363   }
364
365   # grab config data for the article
366  SKIP:
367   {
368     my %conf_req =
369       (
370        a_config => 1,
371        id => $art->{id},
372       );
373     my $data = do_req($add_url, \%conf_req, "config data");
374     $data or skip("no json to check", 7);
375     ok($data->{success}, "check for success");
376     ok($data->{templates}, "has templates");
377     ok($data->{thumb_geometries}, "has geometries");
378     ok($data->{defaults}, "has defaults");
379     ok($data->{child_types}, "has child types");
380     is($data->{child_types}[0], "Article", "check child type value");
381     ok($data->{flags}, "has flags");
382   }
383
384  SKIP:
385   { # config article for children of the article
386     my %conf_req =
387       (
388        a_config => 1,
389        parentid => $art->{id},
390       );
391     my $data = do_req($add_url, \%conf_req, "config data");
392     $data or skip("no json to check", 3);
393     ok($data->{success}, "check for success");
394     ok($data->{templates}, "has templates");
395     ok($data->{thumb_geometries}, "has geometries");
396     ok($data->{defaults}, "has defaults");
397   }
398
399  SKIP:
400   { # section config
401     my %conf_req =
402       (
403        a_config => 1,
404        parentid => -1,
405       );
406     my $data = do_req($add_url, \%conf_req, "section config data");
407     $data or skip("no json to check", 3);
408     ok($data->{success}, "check for success");
409     ok($data->{templates}, "has templates");
410     ok($data->{thumb_geometries}, "has geometries");
411     ok($data->{defaults}, "has defaults");
412     use Data::Dumper;
413     note(Dumper($data));
414   }
415
416  SKIP:
417   {
418     my $parent = do_add($add_url, { parentid => -1, title => "parent" }, "add parent");
419     my $kid1 = do_add($add_url, { parentid => $parent->{id}, title => "kid1" }, "add first kid");
420     sleep 2;
421     my $kid2 = do_add($add_url,
422                       {
423                        parentid => $parent->{id},
424                        title => "kid2",
425                        _after => $kid1->{id},
426                       }, "add second child");
427     my @expected_order = ( $kid1->{id}, $kid2->{id} );
428     my %tree_req =
429       (
430        a_tree => 1,
431        id => $parent->{id},
432       );
433     my $data = do_req($add_url, \%tree_req, "get newly ordered tree");
434     ok($data->{success}, "got the tree");
435     my @saved_order = map $_->{id}, @{$data->{articles}};
436     is_deeply(\@saved_order, \@expected_order, "check saved order");
437
438     {
439       {
440         # stepkids
441         my %add_step =
442           (
443            add_stepkid => 1,
444            id => $parent->{id},
445            stepkid => $art->{id},
446            _after => $kid1->{id},
447           );
448         sleep(2);
449         my $result = do_req($add_url, \%add_step, "add stepkid in order");
450         ok($result->{success}, "Successfully");
451         my $rel = $result->{relationship};
452         ok($rel, "has a relationship");
453         is($rel->{childId}, $art->{id}, "check the rel child id");
454         is($rel->{parentId}, $parent->{id}, "check the rel parent id");
455       }
456
457       {
458         # refetch the tree
459         my $data = do_req($add_url, \%tree_req, "get tree with stepkid");
460         my @expected_order = ( $kid1->{id}, $art->{id}, $kid2->{id} );
461         my @found_order = map $_->{id}, @{$data->{allkids}};
462         is_deeply(\@found_order, \@expected_order, "check new order");
463       }
464
465       {
466         # remove the stepkid
467         my %del_step =
468           (
469            del_stepkid => 1,
470            id => $parent->{id},
471            stepkid => $art->{id},
472            _after => $kid1->{id},
473           );
474         my $result = do_req($add_url, \%del_step, "delete stepkid");
475         ok($result->{success}, "check success");
476
477         $result = do_req($add_url, \%del_step, "delete stepkid again (should failed)");
478         ok(!$result->{success}, "it failed");
479
480         my $data = do_req($add_url, \%tree_req, "get tree with stepkid removed");
481         my @expected_order = ( $kid1->{id}, $kid2->{id} );
482         my @found_order = map $_->{id}, @{$data->{allkids}};
483         is_deeply(\@found_order, \@expected_order, "check new order with stepkid removed");
484       }
485     }
486
487     do_req($add_url, { remove => 1, id => $kid1->{id} }, "remove kid1");
488     do_req($add_url, { remove => 1, id => $kid2->{id} }, "remove kid2");
489     do_req($add_url, { remove => 1, id => $parent->{id} }, "remove parent");
490   }
491
492   # delete it
493  SKIP:
494   {
495     my %del_req =
496       (
497        remove => 1,
498        id => $art->{id},
499        _context => $art->{id},
500       );
501     my $data = do_req($add_url, \%del_req, "remove test article");
502     $data or skip("no json from req", 3);
503     ok($data->{success}, "successfully deleted");
504     is($data->{article_id}, $art->{id}, "check id returned");
505     is($data->{context}, $art->{id}, "check context returned");
506   }
507
508   # shouldn't be fetchable anymore
509  SKIP:
510   {
511     my %fetch_req =
512       (
513        a_article => 1,
514        id => $art->{id},
515       );
516     my $data = do_req($add_url, \%fetch_req, "fetch just deleted")
517       or skip("no json", 2);
518     ok(!$data->{success}, "failed as expected");
519   }
520 }
521
522 SKIP:
523 { # tag cleanup
524   my %clean_req =
525     (
526      a_tagcleanup => 1,
527      id => -1,
528     );
529   my $data = do_req($add_url, \%clean_req, "tag cleanup");
530   $data
531     or skip("no json response", 2);
532   ok($data->{success}, "successful");
533   ok($data->{count}, "should have cleaned up something");
534 }
535
536 sub do_req {
537   my ($url, $req_data, $comment) = @_;
538
539   my @entries;
540   for my $key (keys %$req_data) {
541     my $value = $req_data->{$key};
542     if (ref $value) {
543       for my $val (@$value) {
544         push @entries, "$key=" . escape_uri($val);
545       }
546     }
547     else {
548       push @entries, "$key=" . escape_uri($value);
549     }
550   }
551   my $content = join("&", @entries);
552
553   print <<EOS;
554 # Request:
555 # URL: $add_url
556 # Content: $content
557 EOS
558
559   my $req = HTTP::Request->new(POST => $add_url, \@ajax_hdr);
560
561   $req->content($content);
562
563   my $resp = $ua->request($req);
564   ok($resp->is_success, "$comment successful at http level");
565   my $data = eval { from_json($resp->decoded_content) };
566   ok($data, "$comment response decoded as json")
567     or print "# $@\n";
568
569   return $data;
570 }
571
572 sub do_multi_req {
573   my ($url, $req, $comment) = @_;
574
575   my $res = $ua->post($url,
576                       @ajax_hdr,
577                       Content_Type => "form-data",
578                       Content => $req);
579   unless ($res->is_success) {
580     fail("$comment: http request " . $res->status_line);
581     return;
582   }
583   my $data = eval { from_json($res->decoded_content) };
584   ok($data, "$comment: response decoded as json")
585     or note $@;
586
587   return $data;
588 }
589
590 sub do_add {
591   my ($url, $req, $comment) = @_;
592
593   $req->{save} = 1;
594
595   my $result = do_req($url, $req, $comment);
596   my $article;
597  SKIP:
598   {
599     $result or skip("No JSON result", 1);
600     if (ok($result->{success} && $result->{article}, "check success and article")) {
601       return $result->{article};
602     }
603   };
604
605   return;
606 }