#
# $Id: url.icn,v 1.4 2004/10/02 17:25:24 rparlett Exp $
#
# This file is in the public domain.
#
# Author: Robert Parlett (parlett@dial.pipex.com)
#

package net

import util
import lang

$include "posix.icn"

#
# This class encapsulates a URL
#
class URL : Error : Object : SelectiveClassCoding(protocol, address, file, ref, port, file_handle, header)
   method get_template()
      return ["protocol", "address", "file", "ref", "port", "header"]
   end

   #
   # Set the protocol field.
   #
   method set_protocol(x)
      return self.protocol := x
   end

   #
   # Get the protocol field.
   #
   method get_protocol()
      return self.protocol
   end

   #
   # Set the port field.
   #
   method set_port(x)
      return self.port := x
   end

   #
   # Get the port field.
   #
   method get_port()
      return self.port
   end

   #
   # Set the file field.
   #
   method set_file(x)
      return self.file := x
   end

   #
   # Get the file field.
   #
   method get_file()
      return self.file
   end

   #
   # Set the ref field.
   #
   method set_ref(x)
      return self.ref := x
   end

   #
   # Get the ref field.  This is {&null} if no ref is set.
   #
   method get_ref()
      return self.ref
   end

   #
   # Set the address (host) field.
   #
   method set_address(x)
      return self.address := x
   end

   #
   # Get the address field.
   #
   method get_address()
      return self.address
   end

   #
   # Return a string representation of the URL.
   #
   method to_string()
      local s
      s := self.protocol || "://" || self.address || ":" || self.port || self.file
      s ||:= "#" || \self.ref
      return s
   end
   
   #
   # Open a file based on the address and the port and return it.
   #
   method open()
      return self.file_handle := ::open(self.address || ":" || self.port, "n")
   end

   #
   # Close the file returned by {Open()}.
   #
   method close()
      return ::close(self.file_handle)
   end

   #
   # Extract the cgi parameters from the {file} field.
   # @return   A table, representing the keys and values of the fields.
   #
   method extract_cgi_parameters()
      local cgi, s, key, data

      cgi := table()
      self.file ? {
         if tab(upto('?')) then {
            move(1)
            while not pos(0) do {
               key := tab(upto('&=') | 0)
               if ="=" then
                  val := extract_hex(tab(upto('&') | 0))
               else
                  val := ""
               ="&"
               /cgi[key] := []
               put(cgi[key], val)
            }
         }
      }
      return cgi
   end

   #
   # Amend the file field given a table of CGI parameters.  The old parameter
   # portion (if any) is discarded.
   # @param cgi   The table of keys/values.
   #
   method set_cgi_parameters(cgi)
      self.file ?:= tab(upto('?') | 0) || "?" || make_cgi_string(cgi)
   end

   #
   # Create a CGI parameter string from a table
   #
   method make_cgi_string(cgi)
      s := ""
      every l := !sort(cgi) do
         every s ||:= convert_hex(l[1]) || "=" || convert_hex(!l[2]) || "&"
      s[-1] := ""
      return s
   end

   #
   # Convert a CGI parameter string by extracting any encoded characters.
   #
   method convert_hex(s)
      static convert_chars
      initial 
         convert_chars := &lcase ++ &ucase ++ &digits ++ '_*.-'

      res := ""
      s ? repeat {
         res ||:= tab(many(convert_chars))
         if pos(0) then
            break
         res ||:= "%" || format_int_to_string(ord(move(1)),,2)
      }
      res := map(res, " ", "+")
      return res
   end

   #
   # Create a CGI parameter string by adding any encoding necessary.
   #
   method extract_hex(s)
      res := ""
      s := map(s, "+", " ") 
      s ? repeat {
         res ||:= tab(upto('%') | 0)
         if pos(0) then
            break
         move(1)
         res ||:= char(format_string_to_int(move(2)))
      }
      return res
   end

   #
   # Parse the fields of the {URL} object given the string s.
   #
   method parse(s)
      s ? {
         set_protocol(1(tab(many(&lcase ++ &ucase)), ="://") | "http")
         set_address(tab(upto(':/') | 0))

         if =":" then {
            set_port(integer(tab(many(&digits)))) | return error("Bad port")
         } else
            set_port(getserv(get_protocol() | "www").port) | return error("Unknown protocol")

         if pos(0) then
            set_file("/")
         else {
            any('/') | fail
            set_file(tab(upto('#') | 0))
            if any('#') then {
               move(1)
               set_ref(tab(0))
            }
         }
      }
      return
   end

   #
   # Amend the filename/reference given a relative URL, treating the current instance as a
   # base URL.
   # @param s  The relative URL.
   #
   method set_relative(s)
      if s[1] == "#" then
         #
         # Just reference, filename doesn't change.
         # 
         set_ref(s[2:0])
      else {
         #
         # File name and possibly reference.  First check whether relative to current directory.
         #
         if s[1] ~== "/" then
            s := get_file_dir() || s

         s ? {
            set_file(tab(upto('#') | 0))
            if any('#') then {
               move(1)
               set_ref(tab(0))
            } else
               set_ref()
         }
      }
   end

   #
   # Get the last portion of the file name, ie that past the last "/"
   #
   method get_file_last()
      file ? {
         while(tab(upto('/'))) do
            move(1)
         return tab(0)
      }
   end

   #
   # Get the portion of the file name upto and including the last "/"
   #
   method get_file_dir()
      file ? {
         while(tab(upto('/'))) do
            move(1)
         return tab(1)
      }
   end

   initially(a[])
      if *a = 1 then
         parse(a[1]) | fail
end