;; Because spaces and certain special characters may not appear in URLs, an
;; encoding scheme is used when it is necessary to generate a URL that
;; includes them:  Each space is converted to a plus sign, and each special
;; character is replaced by a triplet of characters consisting of a percent
;; sign and two hexadecimal digits, which together identify the ASCII code
;; for the character (e.g., the tilde, ASCII 126, is encoded as %7E --
;; 7 * 16 + 14).

;; The DECODE-STRING procedure takes a string that has been encoded in this
;; way and recovers the original string from it.

(define decode-string
  (lambda (str)

    ;; Test the precondition.

    (if (not (string? str))
        (error 'decode-string "The argument must be a string"))

    ;; Determine the length of the string.

    (let ((len (string-length str)))

      ;; Run through its characters, from left to right, storing the
      ;; decoded versions in a list.

      (let loop ((position 0)
                 (decoded '()))

        ;; At the right end of the string, reverse the list and assemble
        ;; the characters into the result string.

        (if (= position len)
            (apply string (reverse decoded))

            ;; Recover the next character from the string.

            (let ((ch (string-ref str position)))

              ;; If it is a plus sign, decode it as a space and proceed.

              (cond ((char=? ch #\+)
                     (loop (+ position 1) (cons #\space decoded)))

                    ;; If it is a three-character hexadecimal encoding, 
                    ;; decode it and proceed.

                    ((and (< (+ position 2) len)
                          (char=? (string-ref str position) #\%)
                          (hex-digit? (string-ref str (+ position 1)))
                          (hex-digit? (string-ref str (+ position 2))))
                     (loop (+ position 3)
                           (cons
                            (integer->char
                             (+ (* 16 (hex-val (string-ref str
                                                           (+ position 1))))
                                (hex-val (string-ref str (+ position 2)))))
                            decoded)))

                    ;; Otherwise, add the character without change and
                    ;; and proceed.

                    (else
                     (loop (+ position 1) (cons ch decoded))))))))))

;; The HEX-DIGIT? procedure determines whether its argument is a
;; hexadecimal digit -- one of the decimal digit characters 0 through 9,
;; or one of the letters A through F (either capital or lower-case).

(define hex-digit?
  (lambda (obj)
    (and (char? obj)
         (or (char<=? #\0 obj #\9)
             (char<=? #\A obj #\F)
             (char<=? #\a obj #\f)))))

;; The HEX-VAL procedure takes any hexadecimal digit as argument and
;; recovers its value as a digit -- that is, the integer in the range from
;; 0 to 15 that it stands for.

(define hex-val
  (lambda (ch)

    ;; Test the precondition.

    (if (not (hex-digit? ch))
        (error 'hex-val
               "The argument must be a hexadecimal digit character"))

    ;; Determine the distance between the character and the beginning of
    ;; the run of hexadecimal digits in which it occurs; add, if necessary,
    ;; an offset equal to the digit-value of the first character in that
    ;; run.

    (cond ((char<=? #\0 ch #\9)
           (- (char->integer ch) (char->integer #\0)))
          ((char<=? #\A ch #\F)
           (+ (- (char->integer ch) (char->integer #\A)) 10))
          ((char<=? #\a ch #\f)
           (+ (- (char->integer ch) (char->integer #\a)) 10)))))

;; In CGI programming, a query string usually consists of a sequence of
;; equations separated by ampersands, with the name of some attribute on
;; the left-hand side of each equation and the value of that attribute on
;; the right-hand side.  The EXTRACT-ATTRIBUTES procedure takes such a
;; query string as argument and returns an association list of
;; attribute-value pairs.

(define extract-attributes
  (lambda (str)

    ;; Test the precondition.

    (if (not (string? str))
        (error 'extract-attributes "The argument must be a string."))

    ;; Break the string into a list of equations by dividing at the spaces;
    ;; break each equation into an attribute-value pair by dividing at the
    ;; first equal sign.  Decode the attribute and value strings.

    (map (lambda (pair)
           (cons (decode-string (car pair)) (decode-string (cdr pair))))
         (map (break-at-first #\=) ((break-at-all #\&) str)))))

;; The BREAK-AT-ALL procedure takes a character CH as argument and returns a
;; procedure that takes a string as argument and returns a list of
;; substrings -- the substrings that in its argument were separated by
;; occurrences of CH.

(define break-at-all
  (lambda (ch)

    ;; Test the precondition.

    (if (not (char? ch))
        (error 'break-at-all "The argument must be a single character"))

    ;; Build the breaking procedure.

    (lambda (str)

      ;; Test its precondition.

      (if (not (string? str))
          (error '*break-at-all "The argument must be a string"))

      ;; Traverse the string from right to left; each time an occurrence of
      ;; CH is encountered, break off a substring and prepend it to the
      ;; result list.

      (let ((len (string-length str)))
        (let loop ((remaining len)
                   (result '())
                   (right-end len))
        (if (zero? remaining)

            ;; When the left end is reached, prepend the part of the string
            ;; that has not yet been broken off as well.

            (cons (substring str remaining right-end) result)

            ;; Get the next character, check it, and either break of a
            ;; substring or just go on.

            (let ((next (- remaining 1)))
              (if (char=? (string-ref str next) ch)
                  (loop next
                        (cons (substring str remaining right-end) result)
                        next)
                  (loop next result right-end)))))))))

;; The BREAK-AT-FIRST procedure takes a character CH as argument and
;; returns a procedure that takes a string as argument and returns a pair
;; of substrings -- the substrings that in its argument were separated by
;; the leftmost occurrence of CH.  (If CH does not occur at all in the
;; argument, the procedure should return a pair in which the car is the
;; whole string and the cdr is the empty string.)

(define break-at-first
  (lambda (ch)

    ;; Test the precondition.

    (if (not (char? ch))
        (error 'break-at-first
               "The argument must be a single character"))

    ;; Build the breaking procedure.

    (lambda (str)

      ;; Test its precondition.

      (if (not (string? str))
          (error '*break-at-first "The argument must be a string"))

      ;; Traverse the string from left when CH is encountered, separate
      ;; the substrings, assemble them into a pair, and return it.

      (let ((len (string-length str)))
        (let loop ((position 0))
          (cond ((= position len) (cons str ""))
                ((char=? (string-ref str position) ch)
                 (cons (substring str 0 position)
                       (substring str (+ position 1) len)))
                (else (loop (+ position 1)))))))))