@@ -3,19 +3,51 @@

 ; curl -u user:password https://atomampd.atlassian.net/rest/api/2/issue/ATOMOS-212 | jq .

 (defparameter *hostname* "https://atomampd.atlassian.net")

 (defparameter *endpoint* (princ-to-string (puri:merge-uris *hostname* "/rest/api/2/")))

+(defparameter *agile-endpoint* (princ-to-string (puri:merge-uris *hostname* "/rest/agile/1.0/")))

-(defun update-hostname (new-subdomain)

-  (setf *hostname* (format nil "https://~a.atlassian.net" new-subdomain))

-  (setf *endpoint* (princ-to-string (puri:merge-uris "/rest/api/2/" *hostname*))))

+(defun update-hostname ()

+  (setf *hostname* "https://jira.cnvrmedia.net")

+  (setf *endpoint* (princ-to-string (puri:merge-uris "/rest/api/2/" *hostname*)))

+  (setf *agile-endpoint* (princ-to-string (puri:merge-uris *hostname* "/rest/agile/1.0/"))))

+

+(define-condition jira-error ()

+  ())

+

+(define-condition auth-call-unauthorized (jira-error)

+  ())

+

+(define-condition server-error ()

+  ())

 (defun api-get-call (auth method &rest parameters)

   "Connect to a GET REST endpoint specified by method and return a stream from

    which the response can be read."

   (let ((drakma:*text-content-types* (acons "application" "json" drakma:*text-content-types*)))

-    (drakma:http-request (puri:merge-uris method *endpoint*)

-                         :parameters (alexandria:plist-alist parameters)

-                         :basic-authorization auth

-                         :want-stream t)))

+    (format t "~&~a ~s~%" (puri:merge-uris method *endpoint*) (alexandria:plist-alist parameters))

+    (multiple-value-bind (stream retcode)

+        (drakma:http-request (puri:merge-uris method *endpoint*)

+                             :parameters (alexandria:plist-alist parameters)

+                             :basic-authorization auth

+                             :want-stream t)

+      (case retcode

+        (401 (error 'auth-call-unauthorized))

+        (500 (error 'server-error))

+        (t stream)))))

+

+(defun agile-get-call (auth method &rest parameters)

+  "Connect to a GET REST endpoint specified by method and return a stream from

+   which the response can be read."

+  (let ((drakma:*text-content-types* (acons "application" "json" drakma:*text-content-types*)))

+    (format t "~&~a ~s~%" (puri:merge-uris method *agile-endpoint*) (alexandria:plist-alist parameters))

+    (multiple-value-bind (stream retcode)

+        (drakma:http-request (puri:merge-uris method *agile-endpoint*)

+                             :parameters (alexandria:plist-alist parameters)

+                             :basic-authorization auth

+                             :want-stream t)

+      (case retcode

+        (401 (error 'auth-call-unauthorized))

+        (500 (error 'server-error))

+        (t stream)))))

 (defun api-post-call (auth method post-data)

   "Connect to a GET REST endpoint specified by method and return a stream from

@@ -4,7 +4,7 @@

   :description "Describe jira-api here"

   :author "Your Name <your.name@example.com>"

   :license "Specify license here"

-  :depends-on (#:fwoar.lisputils

+  :depends-on (#:fwoar-lisputils

                #:alexandria

                #:serapeum

                #:drakma

@@ -1,13 +1,31 @@

 ;;;; jira-api.lisp

 (in-package #:jira-api)

-(defun get-issues (auth)

-  (api-get-call auth "search"))

+(defun get-filter (auth filter &rest r &key (expand "subscriptions[:-5]"))

+  (declare (ignore expand))

+  (apply 'api-get-call auth (format nil "filter/~d" filter) r))

+

+(defun get-issues (auth &key jql)

+  (if jql

+      (api-get-call auth "search" "jql" jql)

+      (api-get-call auth "search")))

+

+(defmacro jql (auth &body jql)

+  `(api-get-call ,auth "search" "jql"

+                 ,(apply #'serapeum:concat jql)))

+

+(defun run-filter (auth filter)

+  (let ((jql (gethash "jql" (yason:parse (get-filter auth filter)))))

+    (get-issues auth :jql jql)))

 (defun get-issue (auth key &rest params &key expand)

   (declare (ignore expand))

   (apply 'api-get-call auth (format nil "issue/~a" key) params))

+(defun get-board-issues (auth key &rest params &key expand)

+  (declare (ignore expand))

+  (apply 'api-get-call auth (format nil "board/~a/issue" key) params))

+

 (defun get-projects (auth)

   (api-get-call auth "issue/createmeta"))

@@ -71,20 +89,41 @@

                    finally (push issue (gethash thing classes)))

           finally (return classes))))

-(defun show-issue-short (issue)

+(defun status-to-num (status)

+  (string-case (string-downcase status)

+    ("open" 0)

+    ("in progress" 1)

+    ("needs qr" 2)

+    ("needs demo" 3)

+    ("closed" 4)

+    (t 5)))

+

+(defun sort-issues-by-status (sheeple-issues)

+  (prog1 sheeple-issues

+    (sheeple:with-properties (issues) sheeple-issues

+      (setf issues

+            (sort issues #'< :key (op (status-to-num (name (status (fields _))))))))))

+

+(defun show-issue-short (issue &optional (stream t))

   (sheeple:with-properties (key self) issue

     (let* ((fields (fields issue))

            (status (name (status fields)))

            (summary (summary fields)))

-      (format t "~&~a (~a) <~a>~%"

+      (format stream "~&~a (~a) <~a>~%"

               key

               status 

               (puri:merge-uris (format nil "/browse/~a" (key issue))

                                *hostname*))

-      (show-summary summary)

-      (fresh-line))))

+      (show-summary summary stream)

+      (fresh-line stream))))

+

+(defun map-issues (fun sheeple-issues)

+  (sheeple:with-properties (issues) sheeple-issues

+    (loop for issue across issues

+          do (ensure-parent issue =issue=)

+          collect (funcall fun issue))))

 (defun show-issues (sheeple-issues)

   (sheeple:with-properties (issues) sheeple-issues

@@ -100,3 +139,17 @@

     (loop for project across projects

           do (ensure-parent project =project=)

           do (print-on-own-line (show project)))))

+

+(defun get-points-for-issues (count start)

+  (loop with end = (+ count start)

+     for batch-start from start to end by 50

+     for batch-count = (min (- end batch-start)

+                            50)

+     append (map 'list #'points

+                 (issues

+                  (json2sheeple

+                   (get-issues *auth* :jql

+                               (format nil "issueKey in (~{CJPM-~a~^, ~})"

+                                       (alexandria:iota batch-count

+                                                        :start batch-start)))

+                   =issues=)))))

@@ -1,13 +1,19 @@

 ;;;; package.lisp

 (defpackage #:jira-api.cli

-  (:use :cl :anaphora :alexandria :serapeum :fw.lu)

-  (:export #:prompt-for-lines

+  (:use :cl #:anaphora #:alexandria #:serapeum #:fw.lu)

+  (:export #:optional-prompt

+           #:prompt

            #:prompt-for-line

-           #:optional-prompt

-           #:prompt))

+           #:prompt-for-lines))

 (defpackage #:jira-api

   (:shadow #:comment)

-  (:use #:cl #:serapeum #:alexandria #:fw.lu #:jira-api.cli))

+  (:use #:cl #:jira-api.cli #:alexandria #:fw.lu #:serapeum)

+  (:export #:auth-call-unauthorized

+           #:classify-issues

+           #:get-issues

+           #:jql

+           #:jira-error

+           #:server-error))

@@ -6,7 +6,7 @@

   (apply #'format stream prompt args)

   (force-output stream)

   (read-line stream nil :done))

-;(trace prompt-for-line)

+;;(trace prompt-for-line)

 (defun prompt-for-lines (stream initial-prompt continuation-prompt &rest args)

   "Not finished ... see :description below"

@@ -13,6 +13,7 @@

 (sheeple:defproto =person= () (displayname emailaddress))

 (sheeple:defproto =issue= () (fields key id self))

 (sheeple:defproto =fields= () (summary description reporter creator assignee status comment))

+(sheeple:defproto =issues= () (issues))

 (sheeple:defmessage show (object &rest args))

 (sheeple:defmessage fields-labels (fields))

 (sheeple:defreply fields-labels ((fields =fields=))

@@ -21,6 +22,15 @@

 (sheeple:defproto =comment= () (self id author body))

+(sheeple:defmessage points (issue))

+(sheeple:defreply points ((issue =issue=))

+  (sheeple:property-value (fields issue)

+                          'customfield_10002))

+

+(sheeple:defreply sheeple:shared-init ((issues =issues=) &key)

+  (map nil (op (ensure-parent _ =issue=))

+       (issues issues)))

+

 (sheeple:defreply sheeple:shared-init :after ((comment =comment=) &key)

   (with-accessors ((author author)) comment

       (ensure-parent author =person= :err-if-nil nil)))

@@ -30,13 +40,14 @@

     (when fields

       (ensure-parent fields =fields=)

       (ensure-parent (status fields) =status=)

-      (ensure-parent (reporter fields) =person=)

-      (ensure-parent (creator fields) =person=)

+      (ensure-parent (reporter fields) =person= :err-if-nil nil)

+      (ensure-parent (creator fields) =person= :err-if-nil nil)

       (ensure-parent (assignee fields) =person= :err-if-nil nil)

       (sheeple:with-properties (comment) fields

-        (sheeple:with-properties (comments) comment

-          (map 'nil (lambda (comment) (ensure-parent comment =comment=))

-               comments))))))

+        (when comment

+          (sheeple:with-properties (comments) comment

+            (map 'nil (lambda (comment) (ensure-parent comment =comment=))

+                 comments)))))))

 (sheeple:defreply show ((person =person=) &rest args)

   (declare (ignore args))

@@ -63,16 +74,16 @@

             (pprint-newline :fill *standard-output*)))

         (pprint-newline :mandatory *standard-output*)))))

-(defun show-summary (summary)

-  (pprint-logical-block (*standard-output* (funcall (compose 'tokens 'trim-whitespace) summary))

+(defun show-summary (summary &optional (stream *standard-output*))

+  (pprint-logical-block (stream (funcall (compose 'tokens 'trim-whitespace) summary))

     (pprint-indent :block 8 *standard-output*)

     (pprint-exit-if-list-exhausted)

-    (format *standard-output* "~4tSummary: ")

+    (format stream "~4tSummary: ")

     (loop

-      (princ (pprint-pop))

+      (princ (pprint-pop) stream)

       (pprint-exit-if-list-exhausted)

-      (pprint-newline :fill *standard-output*)

-      (princ #\space))))

+      (pprint-newline :fill stream)

+      (princ #\space stream))))

 (sheeple:defreply show ((issue =issue=) &rest args)

   (declare (ignorable args))

@@ -149,20 +160,20 @@

 (defun json2sheeple (json &optional parent)

   (labels

-    ((handle-parsed (parsed-json)

-       (typecase parsed-json

-         (vector-of-objects (map 'vector #'handle-parsed parsed-json))

-         (hash-table

-           (let ((result (sheeple:object)))

-             (loop for json-prop being the hash-keys of parsed-json using (hash-value json-value)

-                   do (setf (sheeple:property-value result

-                                                    (intern (string-upcase json-prop) :jira-api))

-                            (typecase json-value

-                              (hash-table (handle-parsed json-value))

-                              (vector-of-objects (map 'vector #'handle-parsed json-value))

-                              (t json-value)))

-                   finally (return result))))

-         (t parsed-json))))

+      ((handle-parsed (parsed-json)

+         (typecase parsed-json

+           (vector-of-objects (map 'vector #'handle-parsed parsed-json))

+           (hash-table

+            (let ((result (sheeple:object)))

+              (loop for json-prop being the hash-keys of parsed-json using (hash-value json-value)

+                 do (setf (sheeple:property-value result

+                                                  (intern (string-upcase json-prop) :jira-api))

+                          (typecase json-value

+                            (hash-table (handle-parsed json-value))

+                            (vector-of-objects (map 'vector #'handle-parsed json-value))

+                            (t json-value)))

+                 finally (return result))))

+           (t parsed-json))))

     (let* ((yason:*parse-json-arrays-as-vectors* t)

            (result (handle-parsed (yason:parse json))))

       (when parent