(* Collection of code snippets by Arne Vajhøj *)
(* (from articles on eksperten.dk / vajhoej.dk written sometime between 2004 and now) *)
[inherit('pxmlrpcdir:common', 'pxmlrpcdir:xmlrpc_format', 'pxmlrpcdir:phttp', 'pxmlrpcdir:xmlrpc_parse')]
program client(input,output);

type
   data = record
             ival : integer;
             sval : pstr;
          end;

procedure test(host : pstr; port : integer);

procedure test_getInt(host : pstr; port : integer);

var
   req : pstr;
   ctx : http;
   resp : pstr;
   v : integer;

begin
   pxmlrpc_request(req, 'Test.getInt');
   ctx := http_post(fix(host), port, '/', 'text/xml', 'text/xml', fix(req));
   http_recv_all(ctx, resp.body, resp.length);
   pxmlrpc_response(resp, iaddress(v));
   writeln(v:1);
end;

procedure test_getString(host : pstr; port : integer);

var
   req : pstr;
   ctx : http;
   resp : pstr;
   s : c_str_t;
   s2 : pstr;

begin
   pxmlrpc_request(req, 'Test.getString');
   ctx := http_post(fix(host), port, '/', 'text/xml', 'text/xml', fix(req));
   http_recv_all(ctx, resp.body, resp.length);
   pxmlrpc_response(resp, iaddress(s));
   s2 := pas_str(s);
   writeln(s2);
   free_c_str(s);
end;

procedure test_getData(host : pstr; port : integer);

var
   req : pstr;
   ctx : http;
   resp : pstr;
   stctx : xmlrpc_struct_t;
   d : data;

begin
   pxmlrpc_request(req, 'Test.getData');
   ctx := http_post(fix(host), port, '/', 'text/xml', 'text/xml', fix(req));
   http_recv_all(ctx, resp.body, resp.length);
   stctx := pxmlrpc_struct_init(resp, 2);
   d.ival := pxmlrpc_struct_unpack_i4(stctx, 0, 'ival');
   d.sval := pxmlrpc_struct_unpack_string(stctx, 0, 'sval');
   pxmlrpc_struct_cleanup(stctx);
   writeln('(', d.ival:1, ',', d.sval, ')');
end;

procedure test_getListOfInts(host : pstr; port : integer);

var
   req : pstr;
   ctx : http;
   resp : pstr;
   a : array [1..1000] of integer;
   n, i : integer;

begin
   pxmlrpc_request(req, 'Test.getListOfInts');
   ctx := http_post(fix(host), port, '/', 'text/xml', 'text/xml', fix(req));
   http_recv_all(ctx, resp.body, resp.length);
   n := pxmlrpc_response(resp, iaddress(a));
   write('[');
   for i := 1 to n do begin
      if i > 1 then write(',');
      write(a[i]:1);
   end;
   writeln(']');
end;

procedure test_getListOfStrings(host : pstr; port : integer);

var
   req : pstr;
   ctx : http;
   resp : pstr;
   a : array [1..1000] of c_str_t;
   a2 : array [1..1000] of pstr;
   n, i : integer;

begin
   pxmlrpc_request(req, 'Test.getListOfStrings');
   ctx := http_post(fix(host), port, '/', 'text/xml', 'text/xml', fix(req));
   http_recv_all(ctx, resp.body, resp.length);
   n := pxmlrpc_response(resp, iaddress(a));
   for i := 1 to n do begin
      a2[i] := pas_str(a[i]);
      free_c_str(a[i]);
   end;
   write('[');
   for i := 1 to n do begin
      if i > 1 then write(',');
      write(a2[i]);
   end;
   writeln(']');
end;

procedure test_getListOfData(host : pstr; port : integer);

var
   req : pstr;
   ctx : http;
   resp : pstr;
   stctx : xmlrpc_struct_t;
   da : array [1..1000] of data;
   n, i : integer;

begin
   pxmlrpc_request(req, 'Test.getListOfData');
   ctx := http_post(fix(host), port, '/', 'text/xml', 'text/xml', fix(req));
   http_recv_all(ctx, resp.body, resp.length);
   stctx := pxmlrpc_struct_init(resp, 2);
   n := pxmlrpc_struct_n(stctx);
   for i := 1 to n do begin
      da[i].ival := pxmlrpc_struct_unpack_i4(stctx, i - 1, 'ival');
      da[i].sval := pxmlrpc_struct_unpack_string(stctx, i - 1, 'sval');
   end;
   pxmlrpc_struct_cleanup(stctx);
   write('[');
   for i := 1 to n do begin
      if i > 1 then write(',');
      write('(', da[i].ival:1, ',', da[i].sval, ')');
   end;
   writeln(']');
end;

procedure test_add(host : pstr; port : integer);

var
   req : pstr;
   ctx : http;
   resp : pstr;
   v1, v2, v3 : integer;

begin
   v1 := 123;
   v2 := 456;
   pxmlrpc_request(req, 'Test.add', pxmlrpc_i4(v1), pxmlrpc_i4(v2));
   ctx := http_post(fix(host), port, '/', 'text/xml', 'text/xml', fix(req));
   http_recv_all(ctx, resp.body, resp.length);
   pxmlrpc_response(resp, iaddress(v3));
   writeln(v3:1);
end;

procedure test_concat(host : pstr; port : integer);

var
   req : pstr;
   ctx : http;
   resp : pstr;
   s : c_str_t;
   s1, s2, s3 : pstr;

begin
   s1 := 'ABC';
   s2 := 'DEF';
   pxmlrpc_request(req, 'Test.concat', pxmlrpc_string(s1), pxmlrpc_string(s2));
   ctx := http_post(fix(host), port, '/', 'text/xml', 'text/xml', fix(req));
   http_recv_all(ctx, resp.body, resp.length);
   pxmlrpc_response(resp, iaddress(s));
   s3 := pas_str(s);
   writeln(s3);
   free_c_str(s);
end;

procedure test_modify(host : pstr; port : integer);

var
   req : pstr;
   ctx : http;
   resp : pstr;
   stctx : xmlrpc_struct_t;
   d, d2 : data;

begin
   d.ival := 123;
   d.sval := 'ABC';
   pxmlrpc_request(req, 'Test.modify', pxmlrpc_struct2(
                                           pxmlrpc_member('ival', pxmlrpc_i4(d.ival)),
                                           pxmlrpc_member('sval', pxmlrpc_string(d.sval))
                                       ));
   ctx := http_post(fix(host), port, '/', 'text/xml', 'text/xml', fix(req));
   http_recv_all(ctx, resp.body, resp.length);
   stctx := pxmlrpc_struct_init(resp, 2);
   d2.ival := pxmlrpc_struct_unpack_i4(stctx, 0, 'ival');
   d2.sval := pxmlrpc_struct_unpack_string(stctx, 0, 'sval');
   pxmlrpc_struct_cleanup(stctx);
   writeln('(', d2.ival:1, ',', d2.sval, ')');
end;

begin
   writeln('http://', host, ':', port:1, '/');
   test_getInt(host, port);
   test_getString(host, port);
   test_getData(host, port);
   test_getListOfInts(host, port);
   test_getListOfStrings(host, port);
   test_getListOfData(host, port);
   test_add(host, port);
   test_concat(host, port);
   test_modify(host, port);
end;

begin
   test('localhost', 8001);
   test('localhost', 8002);
end.