src/main.lisp

   1 (in-package :cl-mediawiki)
   2
   3 (defclass mediawiki ()
   4   ((url :accessor url :initarg :url :initform nil)
   5    (auth :accessor auth :initarg :auth :initform nil)
   6    (cookie-jar :accessor cookie-jar :initarg cookie-jar :initform (make-instance 'drakma:cookie-jar))))
   7
   8 (defvar *mediawiki* nil
   9   "the current instance of media wiki we are dealing with (mostly for use with with-mediawiki)")
  10
  11 (defmacro with-mediawiki ((obj) &body body)
  12   `(let ((*mediawiki* ,(typecase obj
  13                          (list obj)
  14                          (string `(make-instance 'mediawiki :url ,obj)))))
  15      ,@body
  16      ))
  17
  18 (defun make-api-request (api-params &key (basic-authorization (auth *mediawiki* )) (force-ssl T) (method :get))
  19   (let ((full-url (format nil "~a/api.php" (url *mediawiki*))))
  20     (push '("format" . "xml") api-params)
  21     (multiple-value-bind (content status headers uri stream must-close status-word)
  22         (drakma:http-request
  23          full-url
  24          :method method
  25          :basic-authorization basic-authorization
  26          :force-ssl force-ssl
  27          :parameters api-params
  28          :cookie-jar (cookie-jar *mediawiki*)
  29          )
  30       (declare (ignore headers uri stream must-close status-word))
  31       (values content status))))
  32
  33 (defun make-parameters (params)
  34   (loop for binding in params
  35         when binding
  36           collecting
  37        (destructuring-bind (key val) binding
  38          (cons (format nil "~(~a~)" key)
  39                (typecase val
  40                  (symbol (format nil "~(~a~)" val))
  41                  (string val))))))
  42
  43 (defun parse-api-response-to-sxml (content)
  44   (cxml:parse content (cxml-xmls:make-xmls-builder) :validate nil))
  45
  46 (defun attribute-value (key alist)
  47   (cadr (assoc key alist :test #'equalp)))
  48
  49 (define-condition media-wiki-error (error)
  50   ((obj :accessor obj :initarg :obj :initform nil)
  51    (code :accessor code :initarg :code :initform nil)
  52    (message :accessor message :initarg :message :initform nil)))
  53
  54 (defmethod print-object ((err media-wiki-error) stream)
  55   (format stream "MEDIA-WIKI-ERROR: ~a ~a ~%~a"
  56           (code err)
  57           (message err)
  58           (obj err)
  59           ))
  60
  61 (define-condition match-error (error)
  62   ((obj :accessor obj :initarg :obj :initform nil)
  63    (message :accessor message :initarg :message :initform nil)))
  64
  65 (defmacro match-response-with-error-reporting ((match-form object)&body body)
  66   "Attempts to unify body as (match (match-form obj) ,@body)
  67
  68    will detect wiki errors and hand them back to us as reasonable CL signals
  69    if we canot match signal a matching-error
  70   "
  71   (let ((obj-sym (gensym "obj")))
  72     `(let ((,obj-sym ,object))
  73        (unify:match-case
  74         (,obj-sym)
  75         (`("api"
  76            NIL
  77            ("error"
  78             ,#T(list &rest ?err)))
  79           (error 'media-wiki-error :obj ,obj-sym
  80                                    :code (attribute-value "code" err)
  81                                    :message (attribute-value "info" err)))
  82         (,match-form
  83          ,@body)
  84         (T
  85          (error 'match-error :message "Error matching" :obj ,obj-sym))
  86         ))))