path: root/rt-liberation.el

;;; rt-liberation.el --- Emacs interface to RT  -*- lexical-binding: t; -*-

;; Copyright (C) 2008-2020 Free Software Foundation, Inc.

;; Author: Yoni Rabkin <yrk@gnu.org>
;; Authors: Aaron S. Hawley <aaron.s.hawley@gmail.com>, John Sullivan <johnsu01@wjsullivan.net>
;; Maintainer: Yoni Rabkin <yrk@gnu.org>
;; Version: 1.31
;; Keywords: rt, tickets
;; Package-Type: multi
;; url: http://www.nongnu.org/rtliber/

;; This file is a part of rt-liberation.

;; 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 3 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., 59 Temple Place - Suite 330, Boston,
;; MA 02111-1307, USA.

;;; Installation and Use:
;;
;; Detailed instructions for installation and use can be found in the
;; rt-liberation manual, in the doc/ directory of the distribution.

;;; History:
;;
;; Started near the end of 2008.


;;; Code:

(require 'browse-url)
(require 'time-date)
(require 'cl-lib)

(require 'rt-liberation-rest)
(require 'rt-liberation-browser)
(require 'rt-liberation-viewer)


(defvar rt-liber-created-string "Created"
  "String representation of \"created\" query tag.")

(defvar rt-liber-resolved-string "Resolved"
  "String representation of \"resolved\" query tag.")

(defvar rt-liber-lastupdated-string "LastUpdated"
  "String representation of \"lastupdated\" query tag.")

(defvar rt-liber-resolved-string "Resolved"
  "String representation of \"resolved\" query tag.")

(defvar rt-liber-content-string "Content LIKE"
  "String representation of \"content\" query tag.")

(defvar rt-liber-subject-string "Subject LIKE"
  "String representation of \"subject\" query tag.")

(defvar rt-liber-email-address-string "Requestor.EmailAddress LIKE"
  "String representation of \"Requestor.EmailAddress\" query tag.")

(defvar rt-liber-content-not-string "Content NOT LIKE"
  "String representation of \"content\" query tag.")

(defvar rt-liber-subject-not-string "Subject NOT LIKE"
  "String representation of \"subject\" query tag.")

(defvar rt-liber-email-address-not-string "Requestor.EmailAddress NOT LIKE"
  "String representation of \"Requestor.EmailAddress\" query tag.")

(defvar rt-liber-content-regexp "^Content:.*$"
  "Regular expression for section headers.")

(defvar rt-liber-username nil
  "Username for assigning ownership on the RT server.")

(defvar rt-liber-ticket-old-threshold 30
  "Age in days before a ticket is considered old.")

(defvar rt-liber-command-dictionary
  '((comment . "comment")
    (edit    . "edit"))
  "Mapping between command symbols and command strings.
The command symbols provide the programmer with a consistent way
of referring to certain commands. The command strings are the
specific strings which would produce the desired effect in the
server.")

(defvar rt-liber-status-dictionary
  '((deleted  . "deleted")
    (resolved . "resolved")
    (open     . "open")
    (new      . "new"))
  "Mapping between status symbols and status strings.

The status symbols provide the programmer with a consistent way
of referring to certain statuses. The status strings are the
server specific strings.")




;;; --------------------------------------------------------
;;; TicketSQL compiler
;;; --------------------------------------------------------

(defun rt-liber-bool-p (sym)
  "Return t if SYM is a boolean operator, otherwise nil."
  (member sym '(and or)))
(defun rt-liber-attrib-p (sym)
  "Return t if SYM is a ticket attribute, otherwise nil."
  (member sym '(id owner status subject content queue lastupdatedby
		   email-address)))
(defun rt-liber-time-p (sym)
  "Return t if SYM is a temporal attribute, otherwise nil."
  (member sym '(created lastupdated resolved)))
(defun rt-liber-negation-p (sym)
  (member sym '(not)))

(defun rt-liber-reduce (op seq)
  "Reduce-OP with SEQ to a string of \"s0 op s1 op s2..\"."
  (if seq
      (cl-reduce
       #'(lambda (a b)
	   (format "%s %s %s" a op b))
       seq)
    ""))

(defun rt-liber-make-interval (pred before after)
  "Return a formatted TicketSQL interval.
PRED   temporal attribute predicate.
BEFORE date before predicate.
AFTER  date after predicate."
  (when (string= before "") (setq before nil))
  (when (string= after "") (setq after nil))
  (concat
   (if before (format "%s < '%s'" pred before) "")
   (if (and before after) (format " AND ") "")
   (if after (format "%s > '%s'" pred after) "")))

(defmacro rt-liber-compile-query (query &optional n)
  "Compile sexp-based QUERY into TicketSQL."
  (cond ((null query) `"")
	((stringp query) `,query)
	((rt-liber-bool-p query) `,(upcase (format "%s" query)))
	;; attribute (positive)
	((and (rt-liber-attrib-p query)
	      (not n))
	 `,(cond ((equal query 'content) rt-liber-content-string)
		 ((equal query 'subject) rt-liber-subject-string)
		 ((equal query 'email-address) rt-liber-email-address-string)
		 (t (capitalize (format "%s =" query)))))
	;; attribute (negation)
	((and (rt-liber-attrib-p query)
	      n)
	 `,(cond ((equal query 'content) rt-liber-content-not-string)
		 ((equal query 'subject) rt-liber-subject-not-string)
		 ((equal query 'email-address) rt-liber-email-address-not-string)
		 (t (capitalize (format "%s !=" query)))))
	;; time
	((rt-liber-time-p query)
	 `,(cond ((equal query 'created) rt-liber-created-string)
		 ((equal query 'lastupdated) rt-liber-lastupdated-string)
		 ((equal query 'resolved) rt-liber-resolved-string)))
	((and (listp query)
	      (rt-liber-time-p (car query)))
	 `(rt-liber-make-interval
	   (rt-liber-compile-query ,(car query))
	   (rt-liber-compile-query ,(cadr query))
	   (rt-liber-compile-query ,(caddr query))))
	;; function (known at compile time?)
	((and query
	      (listp query)
	      (not (rt-liber-bool-p (car query)))
	      (not (rt-liber-negation-p (car query)))
	      (functionp (car query)))
	 `(format "%s" ,query))
	;; negation attribute pairs
	((and (listp query)
	      (rt-liber-negation-p (car query))
	      (rt-liber-attrib-p (caadr query)))
	 `(format "%s '%s'"
		  (rt-liber-compile-query ,(caadr query) t) ; negate
		  (rt-liber-compile-query ,(cadadr query))))
	;; attribute pairs
	((and (listp query)
	      (rt-liber-attrib-p (car query)))
	 `(format "%s '%s'"
		  (rt-liber-compile-query ,(car query))
		  (rt-liber-compile-query ,(cadr query))))
	;; splice boolean operators
	((and (listp query)
	      (rt-liber-bool-p (car query)))
	 `(rt-liber-reduce (rt-liber-compile-query ,(car query))
			   (rt-liber-compile-query ,(cdr query))))
	;; compound statements
	((and (listp query)
	      (not (cdr query)))
	 `(list (rt-liber-compile-query ,(car query))))
	((listp query)
	 `(append
	   (list (rt-liber-compile-query ,(car query)))
	   (rt-liber-compile-query ,(cdr query))))
	;; free variable
	((and query
	      (symbolp query))
	 `(format "%s" ,query))
	(t (error "cannot compile query %s" query))))


;;; --------------------------------------------------------
;;; Parse Answer
;;; --------------------------------------------------------




;;; --------------------------------------------------------
;;; Ticket list retriever
;;; --------------------------------------------------------

(put 'rt-liber-no-result-from-query-error
     'error-conditions
     '(error rt-liber-errors rt-liber-no-result-from-query-error))

(put 'rt-liber-no-result-from-query-error
     'error-message
     "No results from query")




;;; --------------------------------------------------------
;;; Ticket utilities
;;; --------------------------------------------------------

(defun rt-liber-ticket-days-old (ticket-alist)
  "Return the age of the ticket in positive days."
  (days-between (format-time-string "%Y-%m-%dT%T%z" (current-time))
		(cdr (assoc "Created" ticket-alist))))

(defun rt-liber-ticket-old-p (ticket-alist)
  (<= rt-liber-ticket-old-threshold
      (rt-liber-ticket-days-old ticket-alist)))


;;; --------------------------------------------------------
;;; Entry points
;;; --------------------------------------------------------
(defun rt-liber-print-query (query &optional ticket-redraw-f)
  "Run QUERY against the server and return a string.

The optional function TICKET-REDRAW-F will be bound to
`rt-liber-custom-ticket-redraw-function' for the duration of the
query output. Note that unlike the browser output, the string
returned as no associated text properties."
  (let ((rt-liber-custom-ticket-redraw-function
	 (or ticket-redraw-f
	     rt-liber-custom-ticket-redraw-function))
	(out ""))
    (condition-case nil
	(with-temp-buffer
	  (rt-liber-ticketlist-browser-redraw
	   (rt-liber-rest-run-show-base-query
	    (rt-liber-rest-run-ls-query query))
	   query)
	  (setq out (buffer-substring-no-properties 1 (- (point-max) 1))))
      (rt-liber-no-result-from-query-error
       (rt-liber-browser-with-message "no results from query"
				      query)))
    out))

;;; --------------------------------------------------------
;;; Command module
;;; --------------------------------------------------------

(defun rt-liber-command-get-dictionary-value (sym dic)
  "Utility function for retrieving alist values."
  (let ((value (cdr (assoc sym dic))))
    (if value
	value
      (error "%s not a key in dictionary %s" sym dic))))

(defun rt-liber-command-get-command-string (command-symbol)
  "Return value associated with key COMMAND-SYMBOL."
  (rt-liber-command-get-dictionary-value
   command-symbol
   rt-liber-command-dictionary))

(defun rt-liber-command-get-status-string (status-symbol)
  "Return value associated with key STATUS-SYMBOL."
  (rt-liber-command-get-dictionary-value
   status-symbol
   rt-liber-status-dictionary))

(defun rt-liber-command-runner-parser-f ()
  "Display command return status from the server to the user."
  (message (buffer-string)))

(defun rt-liber-command-set-status-deleted (id)
  "Set the status of ticket ID to `deleted'."
  (rt-liber-rest-command-set
   id
   (rt-liber-get-field-string 'status)
   (rt-liber-command-get-status-string 'deleted)))

(defun rt-liber-command-set-status-new (id)
  "Set the status of ticket ID to `new'."
  (rt-liber-rest-command-set
   id
   (rt-liber-get-field-string 'status)
   (rt-liber-command-get-status-string 'new)))

(defun rt-liber-command-set-status-resolved (id)
  "Set the status of ticket ID to `resolved'."
  (rt-liber-rest-command-set
   id
   (rt-liber-get-field-string 'status)
   (rt-liber-command-get-status-string 'resolved)))

(defun rt-liber-command-set-status-open (id)
  "Set the status of ticket ID to `open'."
  (rt-liber-rest-command-set
   id
   (rt-liber-get-field-string 'status)
   (rt-liber-command-get-status-string 'open)))

(defun rt-liber-command-set-owner (id new-owner)
  "Set the owner of ticket in TICKET-ALIST to NEW-OWNER."
  (rt-liber-rest-command-set
   id
   (rt-liber-get-field-string 'owner)
   new-owner))

(defun rt-liber-browser-prioritize (n)
  "Assigng current ticket priority N."
  (interactive "nPriority (number): ")
  (rt-liber-rest-command-set
   (rt-liber-browser-ticket-id-at-point)
   (rt-liber-get-field-string 'priority)
   ;; Work around the strangeness of RT. RT doesn't accept "0" as
   ;; string to set priority to 0, but does accept "00".
   (if (< 0 n)
       (format "%s" n)
     "00"))
  (rt-liber-browser-refresh-and-return))

(defun rt-liber-browser-assign (name)
  "Assign current ticket to a user NAME."
  (interactive "sAssign to: ")
  (let ((taken-p (rt-liber-ticket-taken-p
		  (get-text-property (point) 'rt-ticket))))
    (when (or (not taken-p)
	      (and taken-p
		   (y-or-n-p "Ticket already assigned! Are you sure?")))
      (rt-liber-command-set-owner
       (rt-liber-browser-ticket-id-at-point)
       name)
      (rt-liber-browser-refresh-and-return))))

(defun rt-liber-browser-resolve ()
  "Resolve the current ticket."
  (interactive)
  (rt-liber-command-set-status-resolved
   (rt-liber-browser-ticket-id-at-point))
  (rt-liber-browser-refresh-and-return))

(defun rt-liber-browser-open ()
  "Open the current ticket."
  (interactive)
  (rt-liber-command-set-status-open
   (rt-liber-browser-ticket-id-at-point))
  (rt-liber-browser-refresh-and-return))

(defun rt-liber-browser-new ()
  "Change the current ticket's status to `new'."
  (interactive)
  (rt-liber-command-set-status-new
   (rt-liber-browser-ticket-id-at-point))
  (rt-liber-browser-refresh-and-return))

(defun rt-liber-browser-take-ticket-at-point ()
  "Assign the ticket under point to `rt-liber-username'."
  (interactive)
  (when (not rt-liber-username)
    (error "`rt-liber-username' is nil"))
  (rt-liber-browser-assign rt-liber-username))


(provide 'rt-liberation)

;;; rt-liberation.el ends here.