improve failure reporting
[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         or diag "left: ", Dumper($data->{article}{tags}),
133             "\nright: ", Dumper([$tag_name1, $tag_name2 ]);
134       $art = $data->{article};
135     }
136   }
137
138   { # grab the tree
139     my %tree_req =
140       (
141        a_tree => 1,
142        id => -1,
143       );
144     my $data = do_req($add_url, \%tree_req, "fetch tree");
145     $data or skip("not a json response", 6);
146     ok($data->{success}, "was successful");
147     ok($data->{articles}, "has articles");
148     my $art = $data->{articles}[0];
149     ok(defined $art->{level}, "entries have level");
150     ok($art->{title}, "entries have a title");
151     ok(defined $art->{listed}, "entries have a listed");
152     ok($art->{lastModified}, "entries have a lastModified");
153   }
154
155   { # grab the tags
156     my %tag_req =
157       (
158        a_tags => 1,
159        id => -1,
160       );
161     my $data = do_req($add_url, \%tag_req, "fetch tags");
162   SKIP:
163     {
164       $data or skip("not a json response", 4);
165       ok($data->{tags}, "it has tags");
166       my ($xyz_tag) = grep $_->{name} eq $tag_name2, @{$data->{tags}};
167       ok($xyz_tag, "check we found the tag we set");
168       is($xyz_tag->{cat}, "zyx", "check cat");
169       is($xyz_tag->{val}, "alpha", "check val");
170     }
171   }
172
173   my $tag1;
174   my $tag2;
175   { # grab them with article ids
176     my %tag_req =
177       (
178        a_tags => 1,
179        id => -1,
180        showarts => 1,
181       );
182     my $data = do_req($add_url, \%tag_req, "fetch tags");
183   SKIP:
184     {
185       $data or skip("not a json response", 6);
186       ok($data->{tags}, "it has tags");
187       ($tag1) = grep $_->{name} eq $tag_name1, @{$data->{tags}};
188       ($tag2) = grep $_->{name} eq $tag_name2, @{$data->{tags}};
189       ok($tag2, "check we found the tag we set");
190       is($tag2->{cat}, "zyx", "check cat");
191       is($tag2->{val}, "alpha", "check val");
192       ok($tag2->{articles}, "has articles");
193       ok(grep($_ == $art->{id}, @{$tag2->{articles}}),
194               "has our article id in it");
195     }
196   }
197
198  SKIP:
199   { # delete a tag globally
200     $tag2
201       or skip("didn't find the tag we want to remove", 6);
202     my %del_req =
203       (
204        a_tagdelete => 1,
205        id => -1,
206        tag_id => $tag2->{id},
207       );
208     my $data = do_req($add_url, \%del_req, "delete tag");
209   SKIP:
210     {
211       $data or skip("not a json response", 7);
212       ok($data->{success}, "successful");
213
214       # refetch tag list and make sure it's gone
215       my %get_req =
216         (
217          a_tags => 1,
218          id => -1,
219         );
220       my $tags_data = do_req($add_url, \%get_req, "refetch tags");
221       my ($tag) = grep $_->{name} eq $tag_name2, @{$data->{tags}};
222       ok(!$tag, "should be gone");
223
224       # try to delete it again
225       my $redel_data = do_req($add_url, \%del_req, "delete should fail");
226       $redel_data
227         or skip("not a json response", 3);
228       ok(!$redel_data->{success}, "should fail");
229       is($redel_data->{error_code}, "FIELD", "check error code");
230       ok($redel_data->{errors}{tag_id}, "and error message on field");
231     }
232   }
233
234   { # rename a tag
235     my %ren_req =
236       (
237        a_tagrename => 1,
238        id => -1,
239        tag_id => $tag1->{id},
240        name => $tag_name2, # rename over just removed tag
241       );
242
243     my $data = do_req($add_url, \%ren_req, "rename tag");
244   SKIP:
245     {
246       $data
247         or skip("not a json response", 4);
248       ok($data->{success}, "successful");
249       ok($data->{tag}, "returned updated tag");
250       is($data->{tag}{name}, $tag_name2, "check name saved");
251     }
252   }
253
254   { # refetch the article to check the tags
255     my %fetch_req =
256       (
257        a_article => 1,
258        id => $art->{id},
259       );
260     my $data = do_req($add_url, \%fetch_req, "fetch just saved")
261       or skip("no json", 2);
262     ok($data->{success}, "check success");
263     is_deeply($data->{article}{tags}, [ $tag_name2 ],
264               "check the tags");
265   }
266
267  SKIP:
268   { # add some images
269     my %image_req =
270       (
271        id => $art->{id},
272        addimg => 1,
273        image => [ "t/data/govhouse.jpg" ],
274       );
275     my $data = do_multi_req($add_url, \%image_req, "add first image")
276       or skip("response failed", 9);
277     ok($data->{success}, "success")
278       or skip("response failed", 8);
279     ok($data->{image}, "has an image");
280     my $im1 = $data->{image};
281
282     $image_req{image} = [ "t/data/t101.jpg" ];
283     $data = do_multi_req($add_url, \%image_req, "add second image")
284       or skip("response failed", 6);
285     ok($data->{success}, "success")
286       or skip("response failed: $data->{message}", 5);
287     ok($data->{image}, "has an image");
288     my $im2 = $data->{image};
289
290     # set their order
291     $data = do_req
292       ($add_url,
293        {
294         a_order_images => 1,
295         id => $art->{id},
296         order => $im1->{id} . "," . $im2->{id},
297        },
298        "set image order")
299         or skip("set image order", 3);
300     ok($data->{success}, "successfully ordered")
301       or skip("failed ordering", 2);
302     ok($data->{images}, "had images")
303       or skip("no images", 1);
304     is($data->{images}[0]{id}, $im1->{id}, "ordering worked");
305   }
306
307   # error handling on save
308  SKIP:
309   { # bad title
310     my %bad_title =
311       (
312        save => 1,
313        id => $art->{id},
314        title => "",
315        lastModified => $art->{lastModified},
316       );
317     my $data = do_req($add_url, \%bad_title, "save bad title");
318     $data or skip("not a json response", 2);
319     ok(!$data->{success}, "should be failure");
320     is($data->{error_code}, "FIELD", "should be a field error");
321     ok($data->{errors}{title}, "should be a message for the title");
322   }
323  SKIP:
324   { # bad template
325     my %bad_template =
326       (
327        save => 1,
328        id => $art->{id},
329        template => "../../etc/passwd",
330        lastModified => $art->{lastModified},
331       );
332     my $data = do_req($add_url, \%bad_template, "save bad template");
333     $data or skip("not a json response", 2);
334     ok(!$data->{success}, "should be failure");
335     is($data->{error_code}, "FIELD", "should be a field error");
336     ok($data->{errors}{template}, "should be a message for the template");
337   }
338  SKIP:
339   { # bad last modified
340     my %bad_lastmod =
341       (
342        save => 1,
343        id => $art->{id},
344        title => "test",
345        lastModified => $orig_lastmod,
346       );
347     my $data = do_req($add_url, \%bad_lastmod, "save bad lastmod");
348     $data or skip("not a json response", 2);
349     ok(!$data->{success}, "should be failure");
350     is($data->{error_code}, "LASTMOD", "should be a last mod error");
351   }
352  SKIP:
353   { # bad parent
354     my %bad_parent =
355       (
356        save => 1,
357        id => $art->{id},
358        parentid => $art->{id},
359        lastModified => $art->{lastModified},
360       );
361     my $data = do_req($add_url, \%bad_parent, "save bad parent");
362     $data or skip("not a json response", 2);
363     ok(!$data->{success}, "should be failure");
364     is($data->{error_code}, "PARENT", "should be a parent error");
365   }
366
367   # grab config data for the article
368  SKIP:
369   {
370     my %conf_req =
371       (
372        a_config => 1,
373        id => $art->{id},
374       );
375     my $data = do_req($add_url, \%conf_req, "config data");
376     $data or skip("no json to check", 7);
377     ok($data->{success}, "check for success");
378     ok($data->{templates}, "has templates");
379     ok($data->{thumb_geometries}, "has geometries");
380     ok($data->{defaults}, "has defaults");
381     ok($data->{child_types}, "has child types");
382     is($data->{child_types}[0], "Article", "check child type value");
383     ok($data->{flags}, "has flags");
384   }
385
386  SKIP:
387   { # config article for children of the article
388     my %conf_req =
389       (
390        a_config => 1,
391        parentid => $art->{id},
392       );
393     my $data = do_req($add_url, \%conf_req, "config data");
394     $data or skip("no json to check", 3);
395     ok($data->{success}, "check for success");
396     ok($data->{templates}, "has templates");
397     ok($data->{thumb_geometries}, "has geometries");
398     ok($data->{defaults}, "has defaults");
399   }
400
401  SKIP:
402   { # section config
403     my %conf_req =
404       (
405        a_config => 1,
406        parentid => -1,
407       );
408     my $data = do_req($add_url, \%conf_req, "section config data");
409     $data or skip("no json to check", 3);
410     ok($data->{success}, "check for success");
411     ok($data->{templates}, "has templates");
412     ok($data->{thumb_geometries}, "has geometries");
413     ok($data->{defaults}, "has defaults");
414     use Data::Dumper;
415     note(Dumper($data));
416   }
417
418  SKIP:
419   {
420     my $parent = do_add($add_url, { parentid => -1, title => "parent" }, "add parent");
421     my $kid1 = do_add($add_url, { parentid => $parent->{id}, title => "kid1" }, "add first kid");
422     sleep 2;
423     my $kid2 = do_add($add_url,
424                       {
425                        parentid => $parent->{id},
426                        title => "kid2",
427                        _after => $kid1->{id},
428                       }, "add second child");
429     my @expected_order = ( $kid1->{id}, $kid2->{id} );
430     my %tree_req =
431       (
432        a_tree => 1,
433        id => $parent->{id},
434       );
435     my $data = do_req($add_url, \%tree_req, "get newly ordered tree");
436     ok($data->{success}, "got the tree");
437     my @saved_order = map $_->{id}, @{$data->{articles}};
438     is_deeply(\@saved_order, \@expected_order, "check saved order");
439
440     {
441       {
442         # stepkids
443         my %add_step =
444           (
445            add_stepkid => 1,
446            id => $parent->{id},
447            stepkid => $art->{id},
448            _after => $kid1->{id},
449           );
450         sleep(2);
451         my $result = do_req($add_url, \%add_step, "add stepkid in order");
452         ok($result->{success}, "Successfully");
453         my $rel = $result->{relationship};
454         ok($rel, "has a relationship");
455         is($rel->{childId}, $art->{id}, "check the rel child id");
456         is($rel->{parentId}, $parent->{id}, "check the rel parent id");
457       }
458
459       {
460         # refetch the tree
461         my $data = do_req($add_url, \%tree_req, "get tree with stepkid");
462         my @expected_order = ( $kid1->{id}, $art->{id}, $kid2->{id} );
463         my @found_order = map $_->{id}, @{$data->{allkids}};
464         is_deeply(\@found_order, \@expected_order, "check new order");
465       }
466
467       {
468         # remove the stepkid
469         my %del_step =
470           (
471            del_stepkid => 1,
472            id => $parent->{id},
473            stepkid => $art->{id},
474            _after => $kid1->{id},
475           );
476         my $result = do_req($add_url, \%del_step, "delete stepkid");
477         ok($result->{success}, "check success");
478
479         $result = do_req($add_url, \%del_step, "delete stepkid again (should failed)");
480         ok(!$result->{success}, "it failed");
481
482         my $data = do_req($add_url, \%tree_req, "get tree with stepkid removed");
483         my @expected_order = ( $kid1->{id}, $kid2->{id} );
484         my @found_order = map $_->{id}, @{$data->{allkids}};
485         is_deeply(\@found_order, \@expected_order, "check new order with stepkid removed");
486       }
487     }
488
489     do_req($add_url, { remove => 1, id => $kid1->{id} }, "remove kid1");
490     do_req($add_url, { remove => 1, id => $kid2->{id} }, "remove kid2");
491     do_req($add_url, { remove => 1, id => $parent->{id} }, "remove parent");
492   }
493
494   # delete it
495  SKIP:
496   {
497     my %del_req =
498       (
499        remove => 1,
500        id => $art->{id},
501        _context => $art->{id},
502       );
503     my $data = do_req($add_url, \%del_req, "remove test article");
504     $data or skip("no json from req", 3);
505     ok($data->{success}, "successfully deleted");
506     is($data->{article_id}, $art->{id}, "check id returned");
507     is($data->{context}, $art->{id}, "check context returned");
508   }
509
510   # shouldn't be fetchable anymore
511  SKIP:
512   {
513     my %fetch_req =
514       (
515        a_article => 1,
516        id => $art->{id},
517       );
518     my $data = do_req($add_url, \%fetch_req, "fetch just deleted")
519       or skip("no json", 2);
520     ok(!$data->{success}, "failed as expected");
521   }
522 }
523
524 SKIP:
525 { # tag cleanup
526   my %clean_req =
527     (
528      a_tagcleanup => 1,
529      id => -1,
530     );
531   my $data = do_req($add_url, \%clean_req, "tag cleanup");
532   $data
533     or skip("no json response", 2);
534   ok($data->{success}, "successful");
535   ok($data->{count}, "should have cleaned up something");
536 }
537
538 sub do_req {
539   my ($url, $req_data, $comment) = @_;
540
541   my @entries;
542   for my $key (keys %$req_data) {
543     my $value = $req_data->{$key};
544     if (ref $value) {
545       for my $val (@$value) {
546         push @entries, "$key=" . escape_uri($val);
547       }
548     }
549     else {
550       push @entries, "$key=" . escape_uri($value);
551     }
552   }
553   my $content = join("&", @entries);
554
555   print <<EOS;
556 # Request:
557 # URL: $add_url
558 # Content: $content
559 EOS
560
561   my $req = HTTP::Request->new(POST => $add_url, \@ajax_hdr);
562
563   $req->content($content);
564
565   my $resp = $ua->request($req);
566   ok($resp->is_success, "$comment successful at http level");
567   my $data = eval { from_json($resp->decoded_content) };
568   ok($data, "$comment response decoded as json")
569     or print "# $@\n";
570
571   return $data;
572 }
573
574 sub do_multi_req {
575   my ($url, $req, $comment) = @_;
576
577   my $res = $ua->post($url,
578                       @ajax_hdr,
579                       Content_Type => "form-data",
580                       Content => $req);
581   unless ($res->is_success) {
582     fail("$comment: http request " . $res->status_line);
583     return;
584   }
585   my $data = eval { from_json($res->decoded_content) };
586   ok($data, "$comment: response decoded as json")
587     or note $@;
588
589   return $data;
590 }
591
592 sub do_add {
593   my ($url, $req, $comment) = @_;
594
595   $req->{save} = 1;
596
597   my $result = do_req($url, $req, $comment);
598   my $article;
599  SKIP:
600   {
601     $result or skip("No JSON result", 1);
602     if (ok($result->{success} && $result->{article}, "check success and article")) {
603       return $result->{article};
604     }
605   };
606
607   return;
608 }