action-item.lisp 11.5 KB
;;; pr0nage :: PR0ject maNAGEment
;;; Copyright (C) 2016 Aaron E Krohn
;;;
;;; This program 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.
;;;
;;; This program 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 this program; if not, write to the Free Software
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; The purpose of the controller is to abstract away the web server
;;; and user request data. The models and views should never have to
;;; interact with sessions or URIs or any of that.
;;;
;;; Function naming convention
;;; class-action-[page|data]
;;;
;;; The class for this controller will be 'action-item'.
;;; Action is create/update/view/etc
;;; A 'page' results in a call to a view and outputs a client response,
;;; while a 'data' strictly handles form data and then redirects
;;; Specify 'redirect' instead of page/data for redirect

(in-package :pr0nage)

(defun action-item-view-redirect ()
  "Allow for the usage of /objective/1 to resolve to /objective/1/view"
  (redirect (concatenate 'string (request-uri* *REQUEST*) "/view")))

(defun action-item-view-page ()
  (let ((uri-params)
        (item-id)
        (item-obj)
        (parent-obj)
        (parent-name))

    (no-cache)
    (setf uri-params (parse-uri-params (request-uri* *REQUEST*)))

    ;; Ensure our 2nd URI param is a valid integer
    (handler-case (setf item-id (parse-integer (nth 1 uri-params)))
      (error () (redirect "/objectives")))

    ;; Ensure that our item ID is a valid action-item
    (handler-case (setf item-obj (action-item-get-by-id item-id))
      (error () (redirect "/objectives")))

    ;; Check if objective has a valid parent item
    (setf parent-obj (action-item-get-by-id (parent-id item-obj)))
    (if (eq nil parent-obj)
      (setf parent-name "")
      (setf parent-name (name parent-obj)))

    (action-item-view-view
      (id        item-obj)
      (name      item-obj)
      (priority  item-obj)
      (parent-id item-obj)
      (details   item-obj)
      parent-name
      (action-items-list-tree-by-root item-id)
      (action-item-status-types-list-all)
      (human-text (action-item-status-type-get-by-id (status-id item-obj))))))

(defun action-item-update-page ()
  (let ((uri-params)
        (item-id)
        (item-obj))
    (setf uri-params (parse-uri-params (request-uri* *REQUEST*)))

    ;; Check parse integer
    (handler-case (setf item-id (parse-integer (nth 1 uri-params)))
      (error () (redirect "/objectives")))

    ;; Is valid objective
    (handler-case (setf item-obj (action-item-get-by-id item-id))
      (error () (redirect "/objectives")))

    (action-item-update-view
      item-id
      (name item-obj)
      (priority item-obj)
      (parent-id item-obj)
      (status-id item-obj)
      (details item-obj)
      (action-items-list-all)
      (action-item-status-types-list-all))))

(defun action-item-create-page ()
  (let ((uri-params)
        (c-item-id)
        (item-list))

    (setf uri-params (parse-uri-params (request-uri* *REQUEST*)))

    (handler-case (setf c-item-id (parse-integer (nth 2 uri-params)))
      (error () (setf c-item-id nil)))

    (setf item-list (action-items-list-all))
    (action-item-create-view item-list c-item-id)))

(defun action-item-set-priority-data ()
  (let ((uri-params)
        (item-id)
        (old-priority)
        (new-priority)
        (item-obj))

    (setf uri-params (parse-uri-params (request-uri* *REQUEST*)))

    ;; Ensure argument ID is an integer
    (handler-case (setf item-id (parse-integer (nth 1 uri-params)))
      (error () (smart-redirect (referer *REQUEST*) "/objectives")))

    ;; Ensure that new priority is an integer
    (handler-case (setf new-priority (parse-integer (nth 3 uri-params)))
      (error () (smart-redirect (referer *REQUEST*) "/objectives")))

    ;; Ensure the provided objective ID is valid
    (handler-case (setf item-obj (action-item-get-by-id item-id))
      (error () (smart-redirect (referer *REQUEST*) "/objectives")))

    ;; 0 < new-priority < max-priority
    (if (or 
        (< new-priority 1) 
        (> new-priority (get-max-priority (parent-id item-obj))))
      (smart-redirect (referer *REQUEST*) "/objectives"))

    (setf old-priority (priority item-obj))

    ;; Do nothing if old-priority == new-priority
    (if (equal new-priority old-priority)
      (smart-redirect (referer *REQUEST*) "/objectives"))

    ;; I don't know why this is a handler-case
    (handler-case (setf (priority item-obj) new-priority)
      (error () (smart-redirect (referer *REQUEST*) "/objectives")))

    ;; TODO: Set session message for successs/failure
    (action-item-set-priority item-obj old-priority)
    (smart-redirect (referer *REQUEST*) "/objectives")))

(defun action-items-list-filter-page ()
"Param 0: objectives
Param 1+: Any parameter that is an integer will be selected as
          a root objective and displayed as such.
          Any status-type in the param list will be used to filter
          the list. A '!' prefix explicitly excludes the status-type"
  (let ((uri-params)
        (item-list)
        (item-ids '())
        (status-types)
        (status-types-text '())
        (in-status-types '())
        (ex-status-types '())
        (h-title "Filtered Objectives List"))

    (no-cache)

    (setf uri-params (parse-uri-params (request-uri* *REQUEST*)))
    (setf status-types (action-item-status-types-list-all))
    (dolist (sti status-types)
      (push (name sti) status-types-text))

    (pop uri-params)
    (dolist (param uri-params)
      (if (not (eq nil (handler-case (parse-integer param) (error () nil))))
        (push param item-ids)
        (if (position (remove #\! param) status-types-text :test #'equal)
          (if (char= (char param 0) #\!)
            (push (remove #\! param) ex-status-types))
            (push param in-status-types))))

    (cond 
      ((and (eq nil item-ids)
            (eq nil in-status-types)
            (eq nil ex-status-types))
        (setf h-title "All Objectives")
        (setf item-list
          (action-items-list-tree-by-root 0)))

      ((or (> (length item-ids) 0)
           (> (length in-status-types) 0)
           (> (length ex-status-types) 0))
        (setf item-list 
          (action-items-build-select 
            item-ids 
            in-status-types 
            ex-status-types))))

    (action-items-list-view
      "List Objectives :: pr0nage"
      :custom
      h-title
      item-list
      status-types)))

(defun action-item-create-data ()
  (let ((new-item-obj)
        (new-item-name)
        (new-item-date)
        (new-item-details)
        (new-item-status)
        (parent-id))
    (setf new-item-name (escape-string (post-parameter "obj-name" *REQUEST*)))
    (handler-case (setf parent-id (parse-integer (post-parameter "parent-id")))
      (error () (setf parent-id nil)))
    (setf new-item-date (escape-string (post-parameter "target-date" *REQUEST*)))
    (setf new-item-details (escape-string (post-parameter "obj-details" *REQUEST*)))
    (setf new-item-status (action-item-status-type-get-id-by-name "incomplete"))
    (unless (or (null new-item-name) (zerop (length new-item-name)))
      (setf new-item-obj 
        (action-item-create 
          new-item-name 
          parent-id
          new-item-date
          new-item-status
          new-item-details))
      (redirect (format nil "/objective/~A/view" (id new-item-obj))))
    (redirect "/objectives")))

(defun action-item-update-data ()
  (let ((item-id)
        (old-item-obj)
        (priority)
        (item-name)
        (item-details)
        (status-id)
        (parent-id)
        (max-pri))

    ;; Parse action-item id integer
    (setf item-id
      (handler-case (parse-integer (post-parameter "item-id"))
        (error () (redirect "/objectives"))))

    ;; Escape item details from post
    (setf item-details (escape-string (post-parameter "item-details")))

    ;; Check valid action-item id
    (handler-case (setf old-item-obj (action-item-get-by-id item-id))
      (error () (redirect "/objectives")))

    ;; Parse priority integer
    (setf priority
      (handler-case (parse-integer (post-parameter "item-pri"))
        (error () (redirect "/objectives"))))

    ;; Parse status-id from post param
    (setf status-id
      (handler-case (parse-integer (post-parameter "item-status"))
        (error () (redirect "/objectives"))))

    ;; Check for valid status-id
    (if (eq nil
        (handler-case (action-item-status-type-get-by-id status-id)
          (error () nil)))
      (redirect "/objectives"))

    ;; Parse parent id from post
    (setf parent-id
      (handler-case (parse-integer (post-parameter "parent-id"))
        (error () (redirect "/objectives"))))

    ;; Check for attempted infinite loop
    (if (position parent-id (action-item-list-child-ids item-id))
      (redirect "/objectives"))

    ;; Check valid parent-id
    (if (and 
          (not (zerop parent-id))
          (eq nil
            (handler-case (action-item-get-by-id parent-id)
              (error () (redirect "/objectives")))))
      (redirect "/objectives"))

    ;; Set item name from post
    (setf item-name (escape-string (post-parameter "item-name")))

    ;; Handle the case when reparenting to a leaf node which won't
    ;; have any priority values, thus get-max-priority returns 0.
    ;; Otherwise, check for valid priority value.
    (setf max-pri (get-max-priority parent-id))
    (if (zerop max-pri)
      (setf priority 1)
      (if (or (< priority 1) (> priority max-pri))
        (redirect "/objectives")))

    (if (or (null item-name) (zerop (length item-name)))
      (redirect "/objectives"))

    ;; Do session messaging update here for update success status
    (handler-case
      (action-item-update
        item-id
        item-name
        item-details
        priority
        parent-id
        status-id)
      (error () (redirect "/objectives")))

    (redirect (format nil "/objective/~A/view" item-id))))

(defun action-items-text-summary-page ()
  (let ((item-list))
    (setf item-list (action-items-list-tree-by-root 0))
    (action-items-list-text-view item-list)))

(defun action-item-set-status-data ()
  (let ((uri-params)
        (set-marked)
        (status-id)
        (status-type nil)
        (item-id)
        (item-obj))

    (setf uri-params (parse-uri-params (request-uri* *REQUEST*)))
    (setf set-marked (nth 3 uri-params))

    (setf item-id
      (handler-case (parse-integer (nth 1 uri-params))
        (error () (redirect "/objectives"))))

    (setf item-obj (action-item-get-by-id item-id))
    (if (eq nil item-obj)
      (redirect "/objectives"))

    (dolist (s-type (action-item-status-types-list-all))
      (if (equalp set-marked (name s-type))
        (setf status-type s-type)))

    (if (eq nil status-type)
      (redirect "/objectives"))

    (setf status-id (id status-type))
    (setf (status-id item-obj) status-id)

    (action-item-update 
      (id        item-obj)
      (name      item-obj)
      (details   item-obj)
      (priority  item-obj)
      (parent-id item-obj)
      (status-id item-obj)))

    (redirect "/objectives"))