Don't like ads? PRO users don't see any ads ;-)
Public Pastes
Guest

Untitled

By: a guest on May 8th, 2012  |  syntax: None  |  size: 4.80 KB  |  hits: 15  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. (asdf:oos 'asdf:load-op :drakma)
  2. (asdf:oos 'asdf:load-op :cl-libxml2)
  3. (asdf:oos 'asdf:load-op :iterate)
  4.  
  5. (defpackage :fogbugz(:use :cl :iter :drakma :xtree :xpath))
  6. (in-package :fogbugz)
  7. (use-package :iterate)
  8.  
  9. (defclass Context ()
  10.   ((user :initarg :user
  11.          :accessor user)
  12.    (password :initarg :password
  13.              :accessor password)
  14.    (token :initarg :token
  15.           :accessor token)))
  16.  
  17. (defclass Fogbugz ()
  18.   ((url :initarg :url
  19.         :accessor url)
  20.    (context :initarg :context
  21.             :accessor context)))
  22.  
  23. (defun connect (&key user pass url)
  24.   (let* ((c (make-instance 'Context :user user :password pass))
  25.          (fb (make-instance 'Fogbugz :url url :context c)))
  26.     (progn (login fb)
  27.            fb)))
  28.  
  29. (defmethod login ((f Fogbugz))
  30.   (let ((params `(("cmd" . "logon")
  31.                   ("email" . ,(user (context f)))
  32.                   ("password" . ,(password (context f))))))
  33.     (multiple-value-bind (xml status headers) (http-request (url f) :parameters params)
  34.       (setf (token (context f)) (car (xtree:with-parse-document (doc xml)
  35.               (iter (for node in-xpath-result "/response/token" on doc)
  36.                     (iter:collect (xtree:text-content node)))))))))
  37.  
  38. (defmethod login-p ((f Fogbugz))
  39.   (or (token (context f)) nil))
  40.  
  41. (defmethod logout ((f Fogbugz))
  42.   (let ((params `(("cmd" . "logoff")
  43.                   ("token" . ,(token (context f))))))
  44.     (http-request (url f) :parameters params)
  45.     (setf (token (context f)) nil)))
  46.  
  47. (defmethod set-filter ((f Fogbugz) filter)
  48.   (let ((params `(("cmd" . "setCurrentFilter")
  49.                   ("sFilter" . ,(format nil "~d" filter))
  50.                   ("token" . ,(token (context f))))))
  51.     (multiple-value-bind (xml status headers) (http-request (url f) :parameters params)
  52.       (when (= status 200) t))))
  53.  
  54. (defmethod list-filters ((f Fogbugz))
  55.   (let ((params `(("cmd" . "listFilters")
  56.                    ("token" . ,(token (context f)))))
  57.          (xpath-string (format nil "~{~a~^ | ~}" '("/response/filters/filter/@sFilter"
  58.                                                    "/response/filters/filter/node()"))))
  59.     (multiple-value-bind (xml status headers) (http-request (url f) :parameters params)
  60.       (let ((plist (xtree:with-parse-document (doc xml)
  61.                      (iter (for node in-xpath-result xpath-string on doc)
  62.                            (collect (xtree:text-content node))))))
  63.         (labels ((to-alist (a lst)
  64.                    (let ((key (first lst))
  65.                           (val (second lst)))
  66.                      (if (null lst)
  67.                          a
  68.                          (to-alist (acons key val a) (cddr lst))))))
  69.           (to-alist '() plist))))))
  70.  
  71. (defmethod list-cases ((f Fogbugz))
  72.   (let ((params `(("cmd" . "search")
  73.                   ("cols" . "ixBug,fOpen,sTitle,sLatestTextSummary,sPersonAssignedTo,sStatus,ixPriority")
  74.                   ("token" . ,(token (context f)))))
  75.         (xpath-string (format nil "~{~a~^ | ~}" '("/response/cases/case/ixBug"
  76.                                                   "/response/cases/case/fOpen"
  77.                                                   "/response/cases/case/sTitle"
  78.                                                   "/response/cases/case/sLatestTextSummary"
  79.                                                   "/response/cases/case/sPersonAssignedTo"
  80.                                                   "/response/cases/case/sStatus"
  81.                                                   "/response/cases/case/ixPriority"))))
  82.     (multiple-value-bind (xml status headers) (http-request (url f) :parameters params)
  83.       (let ((lst (xtree:with-parse-document (doc xml)
  84.                    (iter (for node in-xpath-result xpath-string on doc)
  85.                          (collect (xtree:text-content node))))))
  86.         (labels ((build-tree (a lst)
  87.                    (let ((case (nth 0 lst))
  88.                          (open (nth 1 lst))
  89.                          (title (nth 2 lst))
  90.                          (summary (nth 3 lst))
  91.                          (name (nth 4 lst))
  92.                          (status (nth 5 lst))
  93.                          (priority (nth 6 lst)))
  94.                      (if (null lst)
  95.                          a
  96.                          (build-tree
  97.                           (concatenate 'list  a (list (list (cons :CASE case)
  98.                                                             (cons :OPEN open)
  99.                                                             (cons :TITLE title)
  100.                                                             (cons :SUMMARY summary)
  101.                                                             (cons :ASSIGNED name)
  102.                                                             (cons :STATUS status)
  103.                                                             (cons :PRIORITY priority))))
  104.                           (cdddr (cddddr lst)))))))
  105.           (build-tree '() lst))))))
create a new version of this paste RAW Paste Data