;;;; Copyright (C) 2006 ZOMGROFLCOPTER
;;;;
;;;; This file is part of WALT.
;;;;
;;;; WALT is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU General Public License
;;;; as published by the Free Software Foundation; either version 2
;;;; of the License, or (at your option) any later version.
;;;;
;;;; WALT is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with WALT; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.

(in-package :kira)

(defmethod render-title ((event event))
  (html
   (:string (aref *event-types* (event-type event)))
   " "
   (print-date (start-time event) *html-output*)))

(defmethod view ((event event) (view null))
  (with-standard-page ((render-title event))
    (:when (administrator-p)
      (:p "[ " (:a :href (:uri-to 'remove-event :event event) "Remove Event") " ]"))
    ((:table :cellpadding 4 :cellspacing 2 :border 0 :class "metadata")
     (:tr
      (:th :align :right "Start:")
      (:td (print-time (start-time event) *html-output*)))
     (:tr
      (:th :align :right "End:")
      (:td (print-time (end-time event) *html-output*))))
    (:h2 "Attendees")
    (:ul
     (do-collection (person (attendees event))
       (html
        (:li
         (render-link person)
         (let ((sep " ("))
           (do-collection (item (loot event))
             (when (eq (owner item) person)
               (html (:string sep) (:string (name item)))
               (setq sep ", ")))
           (when (string= sep ", ")
             (html ")")))))))))

(defun read-bracketed-token (stream &optional (want-blank-lines-p nil))
  (let (char)
    (let ((newlines 0))
      (loop do (setf char (read-char stream nil nil))
	    while char
	    until (char= char #\[)
	    when (char= char #\Newline) do (incf newlines)
	    finally (when (and want-blank-lines-p (> newlines 1))
		      (when (char= char #\[)
			(unread-char char stream))
		      (return-from read-bracketed-token :blank))))
    (when (char= char #\[)
      (string-trim
       " "
       (with-output-to-string (buf)
	 (loop for char = (read-char stream nil nil)
	       while char
	       until (char= char #\])
	       do (write-char char buf)))))))

(defmethod handle-request-response ((action (eql 'upload-event-data)) (method (eql :get)))
  (with-standard-page ("Upload Event Data")
    ((:standard-form :upload t)
     (:field file "attendance" nil :label "Attendance")
     (:field file "items" nil :label "Items")
     (:submit "Upload"))))

(defmethod handle-request-response ((action (eql 'upload-event-data)) (method (eql :post)))
  (redirect
   (with-transaction ()
     (let* ((attendance-pathname (second (request-query-value "attendance")))
	    (items-pathname (second (request-query-value "items")))
	    (stats (event-stats *guild*))
	    (event (make-instance 'event :previous-event-stats (copy-seq stats)))
	    type)
       (with-open-file (stream attendance-pathname)
	 (setf type (read-bracketed-token stream))
	 (when type
	   (setf type (position (char type 0)
				*event-types*
				:key #'(lambda (string) (char string 0))
				:test #'char-equal))
	   (when type
	     (setf (event-type event) type)))
	 (setf type (event-type event))
	 (let* ((date (read-bracketed-token stream))
		(start-time (read-bracketed-token stream))
		(end-time (read-bracketed-token stream)))
	   (when date
	     (parse-date date (setf (start-time event) (make-instance 'date-time)))	    
	     (parse-date date (setf (end-time event) (make-instance 'date-time)))
	     (when start-time
	       (parse-time start-time (start-time event)))
	     (when end-time
	       (parse-time end-time (end-time event)))))
	 (loop for name = (read-bracketed-token stream)
	       while name
	       do (setq name (uri-style-name name))
	       do (let ((person (get-value name (next-in-uri *root*))))
		    (unless person
		      (setq person (make-instance 'person :name name :guild *guild*))
		      (add-to (people *root*) person)
		      (add-kv (next-in-uri *root*) name person))
		    (add-to (events person) event)
		    (incf (aref (attendance person) type))
		    (add-to (attendees event) person))))
       (incf (aref stats type))
       (add-kv (events *guild*) (start-time event) event)
       (with-open-file (stream items-pathname)
	 (read-bracketed-token stream)
	 (read-bracketed-token stream)
	 (loop for token = (read-bracketed-token stream t)
	       while token
	       do (if (eq token :blank)
		      (read-bracketed-token stream)
		      (let ((name (read-bracketed-token stream)))
			(when name
			  (setf name (uri-style-name name))
			  (let ((person (get-value name (next-in-uri *root*))))
			    (when person
			      (let ((item (make-instance 'item :name token :owner person)))
				(add-to (loot *guild*) item)
				(add-to (loot event) item)
				(add-to (loot person) item)))))))))
       event))))

(defun find-event (date)
  (when (events *guild*)
    (with-cursor (cursor (events *guild*))
      (nth-value 2 (cursor-set-range cursor date)))))

(defmethod handle-request-response ((action (eql 'remove-event)) (method (eql :get)))
  (with-transaction ()
    (with-query ((event id))
      (do-collection (item (loot event))
	(remove-from (loot *guild*) item)
	(remove-from (loot (owner item)) item))
      (decf (aref (event-stats *guild*) (event-type event)))
      (do-collection (person (attendees event))
	(remove-from (events person) event)
	(decf (aref (attendance person) (event-type event))))
      (remove-kv (start-time event) (events *guild*))))
  (redirect :home))