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

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

procedure get_one(f1 : integer);

var
   o : t1;

begin
   o.f1 := f1;
   o.f2 := 'getOne';
   writeln('status: 200 OK');
   writeln('content-type: application/json');
   writeln;
   writeln(format_one(o));
end;

procedure get_all;

var
   a : t1array;

begin
   a.nelm := 3;
   a.elm[1].f1 := 1;
   a.elm[1].f2 := 'getAll #1';
   a.elm[2].f1 := 2;
   a.elm[2].f2 := 'getAll #2';
   a.elm[3].f1 := 3;
   a.elm[3].f2 := 'getAll #3';
   writeln('status: 200 OK');
   writeln('content-type: application/json');
   writeln;
   writeln(format_array(a));
end;

procedure get_some(start_f1, finish_f1 : integer);

var
   a : t1array;
   i : integer;

begin
   a.nelm := finish_f1 - start_f1 + 1;
   for i := 1 to a.nelm do begin
      a.elm[i].f1 := start_f1 + i - 1;
      writev(a.elm[i].f2, 'getSome #', (start_f1 + i - 1):1);
   end;
   writeln('status: 200 OK');
   writeln('content-type: application/json');
   writeln;
   writeln(format_array(a));
end;

procedure post(o : t1);

begin
   writeln('status: 200 OK');
   writeln('content-type: application/json');
   writeln;
   writeln(format_one(o));
end;

procedure put(o : t1);

begin
   writeln('status: 204 No Content');
   writeln;
   writeln('There really is no content here!');
end;

procedure delete(f1 : integer);

begin
   writeln('status: 204 No Content');
   writeln;
   writeln('There really is no content here!');
end;

var
   meth, path, qstr, line : pstr;
   f1, start_f1, finish_f1, ix : integer;
   f : text;
   json : cJSON_ptr;
   o : t1;

begin
   lib$get_symbol('REQUEST_METHOD', meth.body, meth.length);
   lib$get_symbol('PATH_INFO', path.body, path.length);
   lib$get_symbol('QUERY_STRING', qstr.body, qstr.length);
   if meth = 'GET' then begin
      if index(path, '/t1/') = 1 then begin
         readv(substr(path, 5, length(path) - 4), f1);
         get_one(f1);
      end else if path = '/t1' then begin
         if qstr = '' then begin
             get_all;
         end else if index(qstr, 'start=') = 1 then begin
            ix := index(qstr, '&finish=');
            readv(substr(qstr, 7, ix - 7), start_f1);
            readv(substr(qstr, ix + 8, length(qstr) - ix - 7), finish_f1);
            get_some(start_f1, finish_f1);
         end;
      end else begin
         halt;
      end;
   end else if meth = 'POST' then begin
      open(f, 'apache$input', old);
      reset(f);
      readln(f, line);
      close(f);
      json := pJSON_Parse(line);
      o := parse_one(json);
      pJSON_Delete(json);
      post(o);
   end else if meth = 'PUT' then begin
      open(f, 'apache$input', old);
      reset(f);
      readln(f, line);
      close(f);
      json := pJSON_Parse(line);
      o := parse_one(json);
      pJSON_Delete(json);
      put(o);
   end else if meth = 'DELETE' then begin
      readv(substr(path, 5, length(path) - 4), f1);
      delete(f1);
   end else begin
      halt;
   end;
end.