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

%include 't1.inc'
%include 't1json.inc'

procedure testGetOne(host : pstr; port : integer; path : pstr; f1 : integer);

var
   con : http;
   fullpath, resp : pstr;
   json : cJSON_ptr;
   o : t1;

begin
   writev(fullpath, path, '/t1/', f1:1);
   con := http_get(fix(host), port, fix(fullpath), 'application/json');
   if (http_numcode(con) div 100) <> 2 then begin
      writeln('HTTP error : ', http_numcode(con):1, ' ', http_txtcode2(con));
   end;
   http_recv_all(con, resp.body, resp.length);
   http_close(con);
   json := pJSON_parse(resp);
   o := parse_one(json);
   pJSON_Delete(json);
   dump_one(o);
end;

procedure testGetAll(host : pstr; port : integer; path : pstr);

var
   con : http;
   fullpath, resp : pstr;
   json : cJSON_ptr;
   a : t1array;

begin
   writev(fullpath, path, '/t1');
   con := http_get(fix(host), port, fix(fullpath), 'application/json');
   if (http_numcode(con) div 100) <> 2 then begin
      writeln('HTTP error : ', http_numcode(con):1, ' ', http_txtcode2(con));
   end;
   http_recv_all(con, resp.body, resp.length);
   http_close(con);
   json := pJSON_parse(resp);
   a := parse_array(json);
   pJSON_Delete(json);
   dump_array(a);
end;

procedure testGetSome(host : pstr; port : integer; path : pstr; start_f1, finish_f1 : integer);

var
   con : http;
   fullpath, resp : pstr;
   json : cJSON_ptr;
   a : t1array;

begin
   writev(fullpath, path, '/t1?start=', start_f1:1, '&finish=', finish_f1:1);
   con := http_get(fix(host), port, fix(fullpath), 'application/json');
   if (http_numcode(con) div 100) <> 2 then begin
      writeln('HTTP error : ', http_numcode(con):1, ' ', http_txtcode2(con));
   end;
   http_recv_all(con, resp.body, resp.length);
   http_close(con);
   json := pJSON_parse(resp);
   a := parse_array(json);
   pJSON_Delete(json);
   dump_array(a);
end;

procedure testPost(host : pstr; port : integer; path : pstr; o : t1);

var
   con : http;
   fullpath, resp : pstr;
   json : cJSON_ptr;
   o2 : t1;

begin
   writev(fullpath, path, '/t1');
   con := http_post(fix(host), port, fix(fullpath), 'application/json', 'application/json', format_one(o));
   if (http_numcode(con) div 100) <> 2 then begin
      writeln('HTTP error : ', http_numcode(con):1, ' ', http_txtcode2(con));
   end;
   http_recv_all(con, resp.body, resp.length);
   http_close(con);
   json := pJSON_parse(resp);
   o2 := parse_one(json);
   pJSON_Delete(json);
   dump_one(o2);
end;

procedure testPut(host : pstr; port : integer; path : pstr; o : t1);

var
   con : http;
   fullpath : pstr;

begin
   writev(fullpath, path, '/t1/', o.f1:1);
   con := http_put(fix(host), port, fix(fullpath), 'application/json', format_one(o));
   if (http_numcode(con) div 100) <> 2 then begin
      writeln('HTTP error : ', http_numcode(con):1, ' ', http_txtcode2(con));
   end;
   writeln(http_txtcode2(con));
   http_close(con);
end;

procedure testDelete(host : pstr; port : integer; path : pstr; f1 : integer);

var
   con : http;
   fullpath : pstr;

begin
   writev(fullpath, path, '/t1/', f1:1);
   con := http_delete(fix(host), port, fix(fullpath));
   if (http_numcode(con) div 100) <> 2 then begin
      writeln('HTTP error : ', http_numcode(con):1, ' ', http_txtcode2(con));
   end;
   writeln(http_txtcode2(con));
   http_close(con);
end;

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

var
   o : t1;

begin
   testGetOne(host, port, path, 123);
   testGetAll(host, port, path);
   testGetSome(host, port, path, 10, 12);
   o.f1 := 123;
   o.f2 := 'ABC';
   testPost(host, port, path, o);
   testPut(host, port, path, o);
   testDelete(host, port, path, 123);
end;

begin
   test('arnepc5', 81, '/testapi_slim.php');
end.