PROGRAM myprog;
$STANDARD_LEVEL 'EXT_MODCAL' $
const
   ARRAYSIZE = 500;
type	
   ptrtype  = ^char;
   cgirec   = RECORD
		 name  : string[ARRAYSIZE];
		 value : string[ARRAYSIZE];
	      end;
   phonerec = record
		 name  : string[41];
		 phone : string[11];
	      end;

var
   i	 : integer;
mimestr	 : string[100];
ch	 : char;
envstr	 : string[100];
valstr	 : string[100];
len	 : integer;
cgiarr	 : PACKED ARRAY[1..ARRAYSIZE] OF char;
elements : ARRAY[1..16] OF cgirec;
cgistr	 : string[ARRAYSIZE];
entry	 : phonerec;
myfile	 : file of phonerec;
tmpfile	 : file of phonerec;
   str	 : string[200];
	

PROCEDURE READ;INTRINSIC;
PROCEDURE PRINT;INTRINSIC;
PROCEDURE QUIT;INTRINSIC;

FUNCTION getenv(VAR s:string) : ptrtype;EXTERNAL C;
FUNCTION atoi(VAR s: string) : integer;EXTERNAL C;

{************************************************}
{procedure extract_env                           }
{extracts the value of the requested environment }
{variable into a global called valstr            }
{************************************************}
PROCEDURE extract_env(var str : string);
var
   pac    : PACKED ARRAY[1..100] OF char;
   i      : integer;
   myptr  : ptrtype;
begin
   i:=1;
   setstrlen(valstr,0);
   myptr := getenv(str);
   if myptr <> nil then
   begin
      while (ord(myptr^) <> 0) do
         begin
            pac[i] := myptr^;
            myptr := addtopointer(myptr, sizeof(char));
            i := i + 1;
         end;
      strmove(i-1, pac, 1, valstr, 1);
   end;
end;

{********************************************************}
{procedure splitword                                     }
{extracts the first word terminated by the separator char}
{from rightstr and places it in leftstr. Also leftshifts }
{the rest of rightstr.                                   }
{********************************************************}
PROCEDURE splitword(VAR leftstr: string; VAR rightstr: string; sep : char);
var
   i,j,rlen : integer;
   tmparr1  : PACKED ARRAY[1..ARRAYSIZE] OF char;
   tmparr2  : PACKED ARRAY[1..ARRAYSIZE] OF char;
begin
   rlen := strlen(rightstr);

   i := 1;
   strmove(rlen, rightstr, 1, tmparr1, 1); { move string to PAC }

   while (i <= rlen) AND (tmparr1[i] <> sep) do
   begin
      tmparr2[i] := tmparr1[i];
      i := i + 1;
   end;
   strmove(i-1, tmparr2, 1, leftstr, 1);  { move PAC to string }

   if i < rlen then 
      begin
         i := i + 1;          { skip over the separator }
         j := 1;
         while i <= rlen do   { left shift remaining string }
            begin
               tmparr1[j] := tmparr1[i];
               i := i + 1;
               j := j + 1;
            end;
         setstrlen(rightstr,0);
         strmove(j-1, tmparr1, 1, rightstr, 1); {move PAC to string  }
      end
   else
      rightstr := '';
end; { splitword }

{****************************************************}
{procedure unescape_url                              }
{decodes the CGI encoded string from the web browser }
{****************************************************}
PROCEDURE unescape_url(VAR cgistr : string);
var
   i, j			: integer;
   len			: integer;
   tmparr		: PACKED ARRAY[1..ARRAYSIZE] OF char;
   hexstr		: string[5];
begin

   len := strlen(cgistr);
   hexstr := '';
   strmove(len, cgistr, 1, tmparr, 1);   { move string to PAC }
   i := 1;
   j := 1;
   while j <= len do
   begin
      if tmparr[j] = '%' then
      begin
	 strmove(2, tmparr, j+1, hexstr, 1);  {extract hex digits }
	 tmparr[i] := chr(hex(hexstr));       {convert hex to char}
	 j := j + 2;
      end
      else if tmparr[j] = '+' then
	 tmparr[i] := ' '
      else
	 tmparr[i] := tmparr[j];

      i := i + 1;
      j := j + 1;
   end;

   strmove(i-1, tmparr, 1, cgistr, 1);        {move PAC to string}

end; { unescape_url }


{****************************************************}
{procedure phonebook_add                             }
{Adds an entry to the phonebook.                     }
{****************************************************}
PROCEDURE phonebook_add;
begin
   append(myfile,'./pasphone.dat');
   myfile^.name := elements[1].value;
   myfile^.phone := elements[2].value;
   put(myfile);
   close(myfile, 'SAVE');
   str := 'Entry added successfully!';
   print(str, -strlen(str), 0);
end; { phonebook_add }

{****************************************************}
{procedure phonebook_delete                          }
{deletes an entry from the phonebook.                }
{****************************************************}
PROCEDURE phonebook_delete;
var
   name	 : string[41];
   found : boolean;
begin	
   found := false;
   name := elements[1].value;

   rewrite(tmpfile);
   reset(myfile, './pasphone.dat');
   while not eof(myfile) do
   begin
      if myfile^.name = name then
	 found := true
      else
      begin
	 tmpfile^ := myfile^;
	 put(tmpfile);
      end;
      get(myfile);
   end;


   close(myfile);

   if found then
   begin
      rewrite(myfile, './pasphone.dat');
      reset(tmpfile);

      while not eof(tmpfile) do
      begin
	 myfile^ := tmpfile^;
	 put(myfile);
	 get(tmpfile);
      end;
      close(myfile);
      close(tmpfile);
      str := 'Entry successfully deleted!';
      print(str, -strlen(str), 0);
   end
   else
   begin
      str := 'Entry not found!';
      print(str, -strlen(str), 0);
      {return;}
   end;

end; { phonebook_delete }

{****************************************************}
{procedure phonebook_search                          }
{finds an an entry in the phonebook.                 }
{****************************************************}
PROCEDURE phonebook_search;
var
   found     : boolean;
   name	     : string[41];
   thename   : string[41];
   thenumber : string[41];
begin	
   found := false;
   name := elements[1].value;
   reset(myfile, './pasphone.dat');
   while not eof(myfile) do
   begin
      if  myfile^.name = name then
      begin
	 found := true;
	 thename:=myfile^.name;
	 thenumber:=myfile^.phone;
      end;
      get(myfile);
   end;
   close(myfile);
   if found then
   begin
      str := 'Name = ';
      print(str, -strlen(str), 0);
      print(thename, -strlen(thename), 0);
      str[1] := chr(10);    {newline}
      print(str, -1, 0);
      str := 'Number = ';
      print(str, -strlen(str), 0);
      print(thenumber, -strlen(thenumber), 0);
   end
   else
   begin
      str := 'Entry not found in the phonebook.';
      print(str, -strlen(str), 0);
   end;

end; { phonebook_search }



BEGIN
   {print the MIME header}
   mimestr := 'Content-type: text/plain';
   print(mimestr, -strlen(mimestr),0);
   if ccode <> 2 then quit(1);
   str := ' ';
   str[1] := chr(10);
   print(str,-1,0);
   print(str,-1,0);

   {extract the length of the incoming data}
   envstr := 'CONTENT_LENGTH';
   extract_env(envstr);
   if strlen(valstr) > 0 then
      len := atoi(valstr)
   else
      len :=0;

   if len = 0 then
      begin
      str := 'content_length is zero!';
      print(str, -strlen(str), 0);
      quit(200);
      end;

   {read the data}
   read(cgiarr,-len);
   if ccode <>2 then quit(300);

   strmove(len, cgiarr, 1, cgistr, 1);

   {process the received input string}
   i := 1;
   while strlen(cgistr) > 0 do
   begin
      {first, split the cgistr with '&' as separator }
      splitword(elements[i].value, cgistr, '&');

      {decode the string}
      unescape_url(elements[i].value);

      {split the extracted string into name and value}
      {using '=' as separator.                       }
      splitword(elements[i].name, elements[i].value, '=');

      i := i + 1;
   end;

   {call appropriate procedures depending on ACTION}
   if elements[3].value = 'ADD' then
      phonebook_add
   else if elements[3].value = 'DELETE' then
      phonebook_delete
   else
      phonebook_search;
END.