improve failure reporting
[bse.git] / t / 080-remote / 010-save.t
CommitLineData
8f88bb20
TC
1#!perl -w
2use strict;
bf149413 3use BSE::Test qw(make_ua base_url);
8f88bb20
TC
4use JSON;
5use DevHelp::HTML;
425b90a6 6use Test::More;
ab004bbb 7use BSE::TB::Article;
343e1a99 8use Time::HiRes qw(time sleep);
425b90a6 9
ab004bbb 10my @cols = BSE::TB::Article->columns;
425b90a6 11
343e1a99 12my $base = 130;
425b90a6 13
b16d2b32 14my $count = $base + (@cols - 13) * 4;
425b90a6
TC
15
16plan tests => $count;
76c6b28e
TC
17
18$| = 1;
8f88bb20 19
8f88bb20
TC
20my $ua = make_ua;
21my $baseurl = base_url;
22
23my $add_url = $baseurl . "/cgi-bin/admin/add.pl";
24
8921ff01 25my @ajax_hdr = qw(X-Requested-With XMLHttpRequest);
8f88bb20 26
bf149413
TC
27my %add_req =
28 (
29 save => 1,
30 title => "test",
31 parentid => -1,
7350b200 32 _context => "test context",
bf149413
TC
33 );
34my $art_data = do_req($add_url, \%add_req, "add article");
8f88bb20 35
bf149413
TC
36SKIP:
37{
38 $art_data or skip("no response to add", 20);
39 ok($art_data->{success}, "successful json response");
8f88bb20 40
7350b200
TC
41 is($art_data->{context}, "test context", "check context returned");
42
bf149413
TC
43 my $art = $art_data->{article};
44 my $orig_lastmod = $art->{lastModified};
8f88bb20 45
bf149413
TC
46 # try to fetch by id
47 SKIP:
8f88bb20 48 {
bf149413
TC
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");
76c6b28e
TC
64 ok($data->{article}{tags}, "has a tags member");
65 is_deeply($data->{article}{tags}, [], "which is an empty array ref");
bf149413
TC
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
dbfbfb12
TC
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
76c6b28e
TC
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 ],
a3faa272
TC
131 "check tags saved")
132 or diag "left: ", Dumper($data->{article}{tags}),
133 "\nright: ", Dumper([$tag_name1, $tag_name2 ]);
76c6b28e
TC
134 $art = $data->{article};
135 }
136 }
137
66acec63
TC
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
76c6b28e
TC
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
343e1a99
TC
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
bf149413
TC
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 }
d62f54f7
TC
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");
ff234bfa 376 $data or skip("no json to check", 7);
d62f54f7
TC
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");
ff234bfa 383 ok($data->{flags}, "has flags");
d62f54f7
TC
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 }
bf149413 417
78218ca8
TC
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");
0b2a3da0
TC
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
78218ca8
TC
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
bf149413
TC
494 # delete it
495 SKIP:
496 {
497 my %del_req =
498 (
499 remove => 1,
500 id => $art->{id},
7350b200 501 _context => $art->{id},
bf149413
TC
502 );
503 my $data = do_req($add_url, \%del_req, "remove test article");
7350b200 504 $data or skip("no json from req", 3);
bf149413 505 ok($data->{success}, "successfully deleted");
107c0225 506 is($data->{article_id}, $art->{id}, "check id returned");
7350b200 507 is($data->{context}, $art->{id}, "check context returned");
bf149413
TC
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
76c6b28e
TC
524SKIP:
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
bf149413
TC
538sub do_req {
539 my ($url, $req_data, $comment) = @_;
540
76c6b28e
TC
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
559EOS
560
8f88bb20
TC
561 my $req = HTTP::Request->new(POST => $add_url, \@ajax_hdr);
562
563 $req->content($content);
76c6b28e 564
8f88bb20 565 my $resp = $ua->request($req);
bf149413 566 ok($resp->is_success, "$comment successful at http level");
8f88bb20 567 my $data = eval { from_json($resp->decoded_content) };
bf149413
TC
568 ok($data, "$comment response decoded as json")
569 or print "# $@\n";
570
571 return $data;
8f88bb20 572}
78218ca8 573
343e1a99
TC
574sub 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
78218ca8
TC
592sub 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}