(in-package :cs325-user)

;;; Change Log
;;; 10-15-2011 CKR removed ad hoc file loading in favor of QuickLisp
;;; 11-06-2009 CKR changed REQUIRE to use GET-CODE-FILE
;;; 11-04-2009 CKR moved IMPORT into EVAL-WHEN, fixed REQUIRE calls
;;;    to compile in Allegro and Lispworks

;;; Some utilities handy for xml-rpc code.


;;; MACROS

;;; WITH-XML-SERVER

;;; (WITH-XML-SERVER (&key host port url) . body) => value
;;;   Evaluate body with the default XML-RPC values for
;;;   host, port and url rebound to the given values.
;;;   The default values are:
;;;     host = "localhost"
;;;     port = 80
;;;     url = "/RPC2"
;;;
;;; (WITH-XML-SERVER (:HOST "betty.userland.com")
;;;   (XML-RPC-CALL
;;;     (ENCODE-XML-RPC-CALL "examples.getStateName" 41)))

(defmacro with-xml-server 
    ((&key (host '*xml-rpc-host*) 
           (port '*xml-rpc-port*)
           (url '*xml-rpc-url*))
     &body body)
  `(let ((*xml-rpc-host* ,host)
         (*xml-rpc-port* ,port)
         (*xml-rpc-url* ,url))
     ,@body))


;;; WITH-TEMP-PACKAGE

;;; (WITH-TEMP-PACKAGE (name . make-package-args) . body)
;;;    => value of body
;;;  Binds name to a newly created empty package, evaluates
;;;  body, then deletes the package. 
;;;  The package name is gensym'ed to avoid conflict with
;;;  any existing package.

(defmacro with-temp-package ((name &rest args) &body body)
  (let ((pkg-name (gensym)))
    `(unwind-protect
         (let ((,name (make-package ',pkg-name ,@args)))
           ,@body)
       (delete-package ',pkg-name))))

;;; xml-rpc passes numbers, lists and strings. Client
;;; and server code has to decide which strings go to symbols
;;; and in what package.
;;;
;;; Use INTERN-STRINGS in both client and server code
;;; to replace all strings with symbols in the appropriate
;;; arguments and return values.
;;;
;;; Use the macro WITH-TEMP-PACKAGE on the server side to
;;; construct a package for client symbols that can be
;;; thrown away after a request is handled.


;;; (INTERN-STRINGS form &key package) => interned-form
;;;   package defaults to *package*
;;;
;;; Return a copy of form with all strings replaced by
;;; symbols interned in the package

(defun intern-strings (l &optional (package *package*))
  (cond ((stringp l) (values (intern (string-upcase l) package)))
        ((atom l) l)
        (t (cons (intern-strings (car l) package)
                 (intern-strings (cdr l) package)))))


(provide :xml-rpc-utils)