1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
|
#!/usr/bin/perl -w
# Copyright 1999-2019, Paul Johnson (paul@pjcj.net)
# This software is free. It is licensed under the same terms as Perl itself.
# The latest version of this software should be available from my homepage:
# http://www.pjcj.net
# Version 1.22 - 15th November 2019
use strict;
use lib -d "t" ? "t" : "..";
BEGIN {
unless ($ENV{WEBSERVICES_TESTING}) {
eval "use Test::More skip_all => " .
"q[\$WEBSERVICES_TESTING is not set]";
}
eval q[
use 5.006;
use Apache::Test ":withtestmore";
use Apache::TestUtil;
use LWP::Simple;
use Test::JSON;
];
if (my $e = $@) {
eval "use Test::More skip_all => " .
"q[mod_perl or Test::JSON not fully installed]";
# "q[mod_perl or Test::JSON not fully installed [$e]]";
}
}
use Test::More;
Apache::TestRequest::module("default");
my $config = Apache::Test::config();
my $hostport = Apache::TestRequest::hostport($config) || "";
my $ws = "/ws/json/royal";
my $root = "http://$hostport$ws";
sub ws { join "", map "$ws/$_\n", @_ }
sub rs { my $r = join "", map {chomp(my $t = $_); "$t\n" } @_; chomp $r; $r }
my @tests = (
[ "?search=Elizabeth_II", ws "I9" ],
[ "/i9/name", rs <<'EOR' ],
{"name":"Elizabeth_II Alexandra Mary /Windsor/"}
EOR
[ "/i9/children", ws qw( I11 I15 I19 I23 ) ],
[ "/i9/birth/date", rs <<'EOR' ],
{"date":"Wednesday, 21st April 1926"}
EOR
[ "/i9/birth", rs <<'EOR' ],
{"level":1,"tag":"BIRT","items":[{"level":2,"pointer":"","value":"Wednesday, 21st April 1926","tag":"DATE","items":[]},{"level":2,"pointer":"","value":"17 Bruton St.,London,W1,England","tag":"PLAC","items":[]}]}
EOR
[ "/i9", rs <<'EOR' ],
{"rec":{"xref":"I9","level":0,"tag":"INDI","items":[{"level":1,"pointer":"","value":"Elizabeth_II Alexandra Mary/Windsor/","tag":"NAME","items":[]},{"level":1,"pointer":"","value":"Queen of England","tag":"TITL","items":[]},{"level":1,"pointer":"","value":"F","tag":"SEX","items":[]},{"level":1,"tag":"BIRT","items":[{"level":2,"pointer":"","value":"Wednesday, 21st April 1926","tag":"DATE","items":[]},{"level":2,"pointer":"","value":"17 Bruton St.,London,W1,England","tag":"PLAC","items":[]}]},{"level":1,"pointer":1,"value":"F6","tag":"FAMS","items":[]},{"level":1,"pointer":1,"value":"F4","tag":"FAMC","items":[]},{"level":1,"pointer":"","value":10,"tag":"RIN","items":[]}]}}
EOR
[ "/i0", "Can't get record [i0]\n" ],
[ "/I9/__error__", "Invalid action [__error__]\n" ],
[ "", "No xref or parameters specified\n" ],
);
plan tests => scalar @tests + 2 + grep substr($_->[1], 0, 1) eq "{", @tests;
for (@tests) {
my $q = $root . $_->[0];
# t_debug("-- $q");
# t_debug("++ ", get($q));
my $result = get($q);
my $match = $_->[1];
my $json = substr($match, 0, 1) eq "{";
# print "match [$json][$match]\n";
is_valid_json $result, "$q well formed" if $json;
$json ? is_json $result, $match, "$q json matches" : is $result, $match, $q;
}
is get("http://$hostport/ws/json/"),
"No GEDCOM file specified\n",
"No GEDCOM file specified";
like get("http://$hostport/ws/json/__error__"),
qr!Can't open file .*/__error__.ged: No such file or directory!,
"GEDCOM file does not exist";
|
