#
# $Id: url.icn,v 1.7 2006-07-10 13:44:28 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 := protocol || "://" || address || ":" || port || file
      s ||:= "#" || \self.ref
      return s
   end

   #
   # Open a file based on the address and the port and return it.
   #
   method open()
      return file_handle := ::open(address || ":" || port, "n")
   end

   #
   # Close the file returned by {Open()}.
   #
   method close()
      return ::close(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, val

      cgi := ::table()
      self.file ? {
         if ::tab(::find("?")) then {
            ::move(1)
            while not ::pos(0) do {
               key := ::tab(::upto('&=') | 0)
               if ="=" then
                  val := extract_hex(::tab(::find("&") | 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(::find("?") | 0) || "?" || make_cgi_string(cgi)
   end

   #
   # Create a CGI parameter string from a table
   #
   method make_cgi_string(cgi)
      local l, s
      s := ""
      every l := !::sort(cgi) do {
         if ::string(l[2]) then
            s ||:= convert_hex(l[1]) || "=" || convert_hex(l[2]) || "&"
         else
            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)
      local res
      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)
      local res
      res := ""
      s := ::map(s, "+", " ")
      s ? repeat {
         res ||:= ::tab(::find("%") | 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(&letters)), ="://") | "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(::find("#") | 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(::find("#") | 0))
            if ="#" then {
               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(::find("/")+1)
         return ::tab(0)
         }
   end

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

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