;; copyright (c) 2002-2004 Franz Inc, Oakland, CA - All rights reserved.
;;
;; The software, data and information contained herein are proprietary
;; to, and comprise valuable trade secrets of, Franz, Inc.  They are
;; given in confidence by Franz, Inc. pursuant to a written license
;; agreement, and may be stored and used only in accordance with the terms
;; of such license.
;;
;; Restricted Rights Legend
;; ------------------------
;; Use, duplication, and disclosure of the software, data and information
;; contained herein by any agency, department or entity of the U.S.
;; Government are subject to restrictions of Restricted Rights for
;; Commercial Software developed at private expense as specified in
;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
;;

;;  The file bignum-server.cl.  An example file associated with
;;  the tech corner entry 'The WSDL generation facility in Allegro 
;;  CL/SOAP API (added 6/14/04)'.

(in-package :user)

(eval-when (compile load eval)

  ;; This form is needed to make the SOAP module avaialble
  (require :soap)

  ;; This form is to let us use unqualified names
  (use-package :net.xmp.soap)

  )

;; This form is to allow a short package prefix for Schema symbols
(defpackage :net.xmp.schema (:use) (:nicknames :xsd))

;; A Lisp function to translate
;;   a string to a function name symbol
;;   a second string to an arbitrarily large integer
;;   a third string to a second integer
;; The result is a string of digits representing the answer.
(defun calculate (op arg1 arg2)
  (let* ((opsym (read-from-string (format nil "~A" op)))
	 (num1 (parse-integer arg1))
	 (num2 (parse-integer arg2)))
    (case opsym
      ((+ - * ash truncate ceiling expt factorial gcd rem)
       (format nil "~A" (funcall opsym num1 num2)))
      (otherwise (error "Unknown operation"))
      )))

;; A Lisp function to translate a string of digits into a list
;;   of digits in some arbitrary base.
;; This function allows a foreign language caller to view the
;;   large integer as a vector of integers within the integer
;;   range of the foreign language.
(defun decode-num (string base)
  (let ((num (parse-integer string)) rem res)
    (loop
     (multiple-value-setq (num rem) (truncate num base))
     (push rem res)
     (when (zerop num) (return)))
    res))
	
;; A Lisp function to translate a sequence of digits into
;;   a string representing the actual number.
(defun encode-num (seq base &aux (res 0))
  (dotimes (i (length seq) (format nil "~A" res))
    (setf res (+ (* res base) (elt seq i)))))

(defun factorial (n dummy &aux (r 1))
  (declare (ignore dummy))
  (loop
   (when (< n 2) (return r))
   (setf r (* r n))
   (decf n)))


(define-soap-element nil "calculate"
  '(:complex
    (:seq 
     (:element "opname" xsd:|string|)
     (:element "num1"   xsd:|string|)
     (:element "num2"   xsd:|string|))
    :action "calculate"
    ))

(define-soap-element nil "calculateResponse"
  `(:complex
    (:seq
     (:element "calcResult" xsd:|string|))))


(define-soap-element nil "decodeNum"
  '(:complex
    (:seq
     (:element "num" xsd:|string|)
     (:element "base" xsd:|int|))
    :action "decodeNum"
    ))

(define-soap-type nil :|arrayOfBigits|
  '(:array xsd:|int|
	   :array-item (:element "item" :send-type t)
	   ))

(define-soap-element nil "decodeNumResponse"
  '(:complex
    (:seq
     (:element "decResult" :|arrayOfBigits|))))


(define-soap-element nil "encodeNum"
  `(:complex
    (:seq
     (:element "bigits" :|arrayOfBigits|)
     (:element "base"  xsd:|int|))
    :action "encodeNum"
    ))

(define-soap-element nil "encodeNumResponse"
  `(:complex
    (:seq
     (:element "encResult" xsd:|string|))))



(defvar *server* nil)
(defun start-server (&optional (port 1776) (host "localhost"))
  (let ((server (soap-message-server :start (list :port port)
				     :lisp-package :keyword
				     :message-dns *wsdl-1.1-namespaces*
				     :url (format nil "http://~A:~A/SOAP" host port)
				     :service-name "BigNumService"
				     )))
    (soap-export-method
     server "calculate" '("opname" "num1" "num2")
     :lisp-name 'calculate-method
     :return "calculateResponse"
     :action "calculate"
     )
    (soap-export-method
     server "decodeNum" '("num" "base")
     :lisp-name 'decode-num-method
     :return "decodeNumResponse"
     :action "decodeNum"
     )
    (soap-export-method
     server "encodeNum" '("bigits" "base")
     :lisp-name 'encode-num-method
     :return "encodeNumResponse"
     :action "encodeNum"
     )
    (setf *server* server)))

(defun calculate-method (&key |opname| |num1| |num2|)  
  (list "calcResult" (calculate |opname| |num1| |num2|)))

(defun decode-num-method (&key |num| |base|)
  (list "decResult" (decode-num |num| |base|)))

(defun encode-num-method (&key |bigits| |base|)
  (list "encResult" (encode-num |bigits| |base|)))





(defun try-server (&optional (port 1776) (host "localhost"))
  (let ((client (soap-message-client 
		 :url (format nil "http://~A:~A/SOAP" host port)
		 )))
    (values
     (call-soap-method client "calculate" "opname" "factorial" "num1" "17" "num2" "1")
     client)))