; (c) 2008 Dmitri Hrapof <hrapof@common-lisp.ru>
; This file is distributed under the terms of the LLGPL.

(defpackage oci-pest
   (:use common-lisp ACL-COMPAT.EXCL NET.HTML.GENERATOR NET.ASERVE)) 
(in-package oci-pest)

(defvar *lock* (ccl:make-lock))

;(publish :path "/pm"
;	 :content-type "text/html"; charset=utf-8"
;	 :timeout 4000
;	 :function
;	 #'(lambda (req ent)
;	     (with-http-response (req ent)
;	       (with-http-body (req ent)
;		 (html (:head "JPG")
;		       (:body
;			((:form :enctype "multipart/form-data"
;				:method "post"
;				:action "rec")
;			 :br
;			 ((:input :type "file" 
;				  :name "thefile"
;				  :value "*.jpg"))
;			 :br
;			 ((:input :type "submit")))))))))

(publish :path "/pm1"
	 :content-type "text/html"; charset=utf-8"
	 :timeout 4000
	 :function
	 #'(lambda (req ent)
	     (with-http-response (req ent)
	       (with-http-body (req ent)
		 (html (:head "JPG")
		       (:body
			((:form :enctype "multipart/form-data"
				:method "post"
				:action "rec")
			 :br
			 ((:input :type "text" 
				  :name "scale"
				  :value "1"))
			 :br
			 ((:input :type "file" 
				  :name "thefile"
				  :value "*.jpg"))
			 :br
			 ((:input :type "submit")))))))))

(publish :path "/rec"
	 :content-type "text/html" ; charset=utf-8"
	 :timeout 4000
	 :function
	 #'(lambda (req ent)
	     (with-http-response (req ent)
	       (if (null (ccl:try-lock *lock*))
		   (with-http-body (req ent :external-format :utf8-base)
		     (html (:html "Operation in progress; please try in 5 minutes.")))
		   (unwind-protect
		   (let (files-written
                     text-strings
		     (start (get-universal-time)))
		 (loop for h = (get-multipart-header req)
                       while h
                       ;; we can get the filename from the header if 
                       ;; it was an <input type="file"> item.  If there is
                       ;; no filename, we just create one.
                       do (let ((cd (assoc :content-disposition h :test #'eq))
                                (filename)
                                (sep))
                            (when (and cd (consp (cadr cd)))
                              (setq filename (cdr (assoc "filename" 
                                                         (cddr (cadr cd))
                                                         :test #'equalp)))
                              (when filename
                                ;; locate the part of the filename after
                                ;; the last directory separator.  the
                                ;; common lisp pathname functions are no
                                ;; help since the filename syntax may be
                                ;; foreign to the OS on which the server
                                ;; is running.
                                (setq sep
                                      (max (or (position #\/ filename
                                                         :from-end t) -1)
                                           (or (position #\\ filename
                                                         :from-end t) -1)))
                                (setq filename
                                      (subseq filename (1+ sep)
                                              (length filename)))))
                            (if filename
                                (progn
                                  (push filename files-written)
                                  (with-open-file (pp filename :direction :output
                                                      :if-exists :supersede
                                                      :element-type '(unsigned-byte 8))
                                    (format t "writing file ~s~%" filename)
                                    (let ((buffer (make-array 4096
                                                              :element-type 
                                                              '(unsigned-byte 8))))
                                      ;; note: we could also use
                                      ;; get-all-multipart-data here
                                      (loop for count = (get-multipart-sequence
                                                         req buffer)
                                            while count
                                            do (write-sequence buffer pp :end count)))))
                                ;; no filename, just grab as a text string
                                (let ((buffer (make-string 1024)))
                                  (loop for count = (get-multipart-sequence
                                                     req buffer
                                                     :external-format :utf8-base)
                                        while count
                                        do (push (subseq buffer 0 count) text-strings))))))
		 ;; now send back a response for the browser
		 (with-http-body (req ent :external-format :utf8-base)
		   (html (:html (:head (:title ""))
				(:body
				 (let ((w (if (car text-strings) (read-from-string (car text-strings) nil nil))))
				 (dolist (file (nreverse files-written))
				   (let ((nn (oci-rest::decipher-numbers 
					      file w)))
				     (html 
				      (:prin1-safe 
				       (- (get-universal-time) start)) 
				      " seconds")
				     (dolist (n nn)
				       (html :br (:prin1-safe n)))))))))))
		     (ccl:release-lock *lock*))))))


(defun start-server (&rest args &key (port 2001) &allow-other-keys)             
  (apply #'net.aserve:start :port port args))                                   
                                                                                
(defun stop-server ()                                                           
  (net.aserve:shutdown))                  

(defun start-pm ()
;  (oci-rest::commit-adultery)
  (oci-rest::slurp-numbers!)
  (start-server :port 2001))