src/main.lisp

   1 (in-package :cl-mediawiki)
   2 (defclass mediawiki ()
   3   ((url :accessor url :initarg :url :initform nil)
   4    (auth :accessor auth :initarg :auth :initform nil)
   5    (cookie-jar :accessor cookie-jar :initarg cookie-jar :initform (make-instance 'drakma:cookie-jar))))
   6
   7 (defvar *mediawiki* nil
   8   "the current instance of media wiki we are dealing with (mostly for use with with-mediawiki)")
   9
  10 (defmacro with-mediawiki ((obj) &body body)
  11   `(let ((*mediawiki* ,(typecase obj
  12                          (string `(make-instance 'mediawiki :url ,obj))
  13                          (T obj))))
  14      ,@body
  15      ))
  16
  17 (defun make-api-request (api-params &key (basic-authorization (auth *mediawiki* )) (force-ssl nil force-ssl-p) (method :get))
  18   "Calls the media wiki api providing the specified parameters"
  19   ;; force-ssl should either be whats passed in, or if nothing is passed in
  20   ;; check to see what protocol we used to connect to the server
  21   (let ((force-ssl (if force-ssl-p
  22                        force-ssl
  23                        (eq 0 (search "https://" (url *mediawiki*) :test #'char-equal ))
  24                        ))
  25         (full-url (format nil "~a/api.php" (url *mediawiki*))))
  26     (push '("format" . "xml") api-params)
  27     (multiple-value-bind (content status headers uri stream must-close status-word)
  28         (let ((drakma:*drakma-default-external-format* *default-external-format*))
  29           (drakma:http-request
  30            full-url
  31            :method method
  32            :basic-authorization basic-authorization
  33            :force-ssl force-ssl
  34            :parameters api-params
  35            :cookie-jar (cookie-jar *mediawiki*)
  36            ))
  37       (declare (ignore headers uri stream must-close status-word))
  38       (values content status))))
  39
  40 (defvar *default-external-format* :utf-8
  41   "sets as the drakma default coding system")
  42
  43 (defun make-parameters (params)
  44   "Takes a list of bindings (:key :val) and prepares them for transit
  45    by converting them to strings
  46    (if either the pair is nil or the value is nil, we drop that param)
  47   "
  48   (flet ((format-list-element (el)
  49            (typecase el
  50              (symbol (string-downcase (princ-to-string el)))
  51              (T (princ-to-string el)))))
  52     (loop for binding in params
  53           ;; only collect when we have a key and value
  54           when (and binding (cadr binding))
  55             collecting
  56          (destructuring-bind (key val) binding
  57            ;; grabs a downcased key and its value (downcased if symbol)
  58            ;; as a pair of strings
  59            (cons (format nil "~(~a~)" key)
  60                  (typecase val
  61                    ;;lists should be pipe delimited
  62                    (list (format nil "~{~a~^|~}" (mapcar #'format-list-element val)))
  63                    (symbol (format nil "~(~a~)" val))
  64                    (T (princ-to-string val))))))))
  65
  66 (defun parse-api-response-to-sxml (content)
  67   (cxml:parse content (cxml-xmls:make-xmls-builder) :validate nil))
  68
  69 (defun sxml-attribute-value (key alist)
  70   (cadr (assoc key alist :test #'equalp)))
  71
  72 (defun convert-sxml-attribs-to-alist (sxml-attribs)
  73   (loop for ((key val) . rest) = sxml-attribs then rest
  74         collecting (cons (symbolize-string key)  val)
  75         while rest))
  76
  77 (define-condition media-wiki-error (error)
  78   ((obj :accessor obj :initarg :obj :initform nil)
  79    (code :accessor code :initarg :code :initform nil)
  80    (message :accessor message :initarg :message :initform nil)))
  81
  82 (defmethod print-object ((err media-wiki-error) stream)
  83   (format stream "MEDIA-WIKI-ERROR: ~s ~a ~%~s"
  84           (code err)
  85           (message err)
  86           (obj err)
  87           ))
  88
  89 (define-condition match-error (error)
  90   ((obj :accessor obj :initarg :obj :initform nil)
  91    (match-against :accessor match-against :initarg :match-against :initform nil)
  92    (message :accessor message :initarg :message :initform nil)))
  93
  94 (defun check-for-xml-for-error (xml)
  95   "search the response for <api><error attribs></api>"
  96   (loop for kid in (cddr xml) ;; first node is api
  97         do (when (string-equal "error" (first kid))
  98              (let ((err (second kid)))
  99                (error 'media-wiki-error
 100                       :obj xml
 101                       :code (sxml-attribute-value "code" err)
 102                       :message (sxml-attribute-value "info" err))))))
 103
 104 ;; Copyright (c) 2008 Accelerated Data Works, Russ Tyndall
 105
 106 ;; Permission is hereby granted, free of charge, to any person
 107 ;; obtaining a copy of this software and associated documentation files
 108 ;; (the "Software"), to deal in the Software without restriction,
 109 ;; including without limitation the rights to use, copy, modify, merge,
 110 ;; publish, distribute, sublicense, and/or sell copies of the Software,
 111 ;; and to permit persons to whom the Software is furnished to do so,
 112 ;; subject to the following conditions:
 113
 114 ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
 115 ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
 116 ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
 117 ;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
 118 ;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
 119 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 120 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.