;;;===========================================================================
;;;
;;; weblog-master.lisp
;;;
;;; Eduardo Muņoz
;;; Time-stamp: "Sunday, 09 May 2004 - 20:54:52"
;;;
;;;===========================================================================
;;;
;;; This file has to be loaded after weblog.lisp
;;; 
;;;===========================================================================

(in-package :weblisp)

(use-package '(:htout))

(defparameter *blog-master-address* "/test/weblog-master")

(with-apache-address (*blog-master-address*)
  (standard-page
   "Weblog Master"
   (clsql:with-default-database (*blog-db*)
     (let* ((method (cdr (assoc "method" command :test #'string=)))
            (query (get-url-query command))
            (story-id (get-query-item "Story" query)))
       (when (stringp story-id)
         (setf story-id (parse-integer story-id)))
       (cond ((not query)
              (htm (:h2 "Weblog Index")
                   (str (view-index *blog-master-address*))))
             ((string= "Post" (get-query-item "Action" query))
              (htm (:h3 "Post a comment")
                   (str (edit-post (make-post story-id)))
                   (:p (str (story-link story-id *blog-master-address*)))))
             ((string= "Edit" (get-query-item "Action" query))
              (let* ((post-id (parse-integer (get-query-item "Post" query))))
                (htm (str (edit-post-as-master (select-post post-id)))
                     (:p (str (story-link story-id *blog-master-address*))))))
             (t
              (cond ((equal method "POST")
                     (htm (str (view-post-as-master
                                (update-post (get-http-query command))
                                *blog-master-address*))
                          (:p (str (story-link story-id
                                               *blog-master-address*)))))
                    (t
                     (htm (:h2 (str (story-title (select-story story-id))))
                          ((:a :name "0") "")
                          (str (view-blog (select-posts story-id)
                                          #'view-post-as-master
                                          *blog-master-address*
                                          :filter nil))
                          (str (blog-footer story-id
                                            *blog-master-address*)))))))))))

(defun view-post-as-master (post base-address)
  (let ((table-width "600"))
    (html
     ((:a :name (format nil "~D" (post-id post))) "")
     ((:table :bgcolor "#FFFFFF" :width table-width)
      ((:tr :bgcolor (if (post-valid post) "#99CC99" "#CC9999"))
       (:td
        ((:table :width table-width)
         (:tr (:td (:b (str (post-title post))))
              ((:td :align "right")
               (if (string/= "" (post-email post))
                   (lnk (str (post-author post)) "mailto:" (post-email post))
                   (str (post-author post)))))
         (:tr ((:td :align "left")
               ((:font :size "-1")
                (lnk "Reply to this"
                      (format nil 
                              "~A?Story=~D&Action=Reply&Post=~D"
                              *blog-address*
                              (story-id (post-story post)) 
                              (post-id post)))
                " | "
                (lnk "Edit post"
                      (format nil
                              "~A?Story=~D&Action=Edit&Post=~D"
                              base-address
                              (story-id (post-story post)) 
                              (post-id post)))))
              ((:td :align "right")
               ((:font :size "-1")
                (str (shorten-time-string (post-date post)))))))))
      ((:tr :bgcolor "#FFFFFF")
       (:td (str (post-body post)))))
     :br)))

(defun edit-post-as-master (post)
  (html
   (:h3 "Modify comment")
   ((:form :name "Post" :method "POST"
           :action (format nil "/test/weblog-master?Story=~D"
                           (story-id (post-story post))))
    ((:input :type "hidden" :name "Post" :value (post-id post)))
    ((:input :type "hidden" :name "Story"
             :value (story-id (post-story post))))
    (:table
     (:tr
      (:td (:b "Author: "))
      (:td ((:input :type "text" :name "Author"
                    :size "30" :value (post-author post)))))
     (:tr
      (:td (:b "Email: "))
      (:td ((:input :type "text" :name "Email"
                    :size "30" :value (post-email post)))))
     (:tr
      (:td (:b "Title: "))
      (:td ((:input :type "text" :name "Title"
                    :size "50" :value (post-title post)))))
     (:tr
      ((:td :valign "top") (:b "Body: "))
      (:td ((:textarea  :name "Body" :rows "10" :cols "38")
            (str (post-body post)))))
     (:tr
      (:td (:b "Parent: "))
      (:td ((:input :type "text" :name "Parent"
                    :value (post-parent post)))))
     (:tr
      (:td (:b "Rating: "))
      (:td ((:input :type "text" :name "Rating"
                    :value (post-rating post)))))
     (:tr
      (:td (:b "Valid: "))
      (:td ((:input :type "checkbox" :name "Valid"
                    (if (post-valid post) "CHECKED" "")))))
     (:tr (:td)
          (:td
           :br
           ((:input :type "submit" :name "Button" :value "Submit"))))))))

(defun update-post (query)
  (let* ((post-id (parse-integer (get-query-item "Post" query)))
         (post (select-post post-id)))
    (with-slots (author email title body parent valid rating)
        post
      (setf author (get-query-item "Author" query)
            email (get-query-item "Email" query)
            title (get-query-item "Title" query)
            body (get-query-item "Body" query)
            parent (parse-integer (get-query-item "Parent" query))
            valid (string-equal "ON" (get-query-item "Valid" query))
            rating (parse-integer (get-query-item "Rating" query))))
    (clsql:update-records-from-instance post)
    post))

(with-apache-address ((format nil "~A/new-story" *blog-master-address*))
  (standard-page
   "New Story"
   (clsql:with-default-database (*blog-db*)
     (let* ((method (cdr (assoc "method" command :test #'string=))))
       (cond ((equal method "POST")
              (let ((title (get-query-item "Title" (get-http-query command))))
                (clsql:update-records-from-instance
                 (make-instance 'story :title title))
                (htm (:h2 "Weblog Index")
                     (str (view-index *blog-master-address*)))))
             (t
              (htm (:h2 "New Story")
                   ((:form :name "New Story"
                           :method "POST"
                           :action (format nil "~A/new-story"
                                           *blog-master-address*))
                    (:b "Story title: ")
                    ((:input :type "text" :name "Title" :size "25" :value ""))
                    ((:input :type "submit" :name "Button" :value "Submit")))
                   ((:form :name "Disable Story"
                           :method "POST"
                           :action (format nil "~A/new-story"
                                           *blog-master-address*))
                    (:b "Disable Story Id: ")
                    ((:input :type "text" :name "StoryId"
                             :size "25" :value ""))
                    ((:input :type "submit" :name "Button"
                             :value "Submit"))))))))))