├── .gitignore ├── LICENSE ├── README.mediawiki ├── cl-mediawiki-test.asd ├── cl-mediawiki.asd ├── src ├── edit.lisp ├── main.lisp ├── packages.lisp ├── query.lisp └── util.lisp └── tests ├── edit.lisp ├── query.lisp └── setup.lisp /.gitignore: -------------------------------------------------------------------------------- 1 | .svn 2 | build 3 | dist 4 | *~ 5 | *# 6 | *.fasl -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2008 Accelerated Data Works, Russ Tyndall 2 | 3 | Permission is hereby granted, free of charge, to any person 4 | obtaining a copy of this software and associated documentation files 5 | (the "Software"), to deal in the Software without restriction, 6 | including without limitation the rights to use, copy, modify, merge, 7 | publish, distribute, sublicense, and/or sell copies of the Software, 8 | and to permit persons to whom the Software is furnished to do so, 9 | subject to the following conditions: 10 | 11 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 12 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 13 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 14 | IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 15 | CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 16 | TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 17 | SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -------------------------------------------------------------------------------- /README.mediawiki: -------------------------------------------------------------------------------- 1 | = CL-MediaWiki = 2 | 3 | This is a project to help make the [http://www.mediawiki.org/wiki/API MediaWiki API] accessible and easy to use from Common Lisp. While this project is currently sparsely populated, what commands are there should work. Patches Welcome! 4 | 5 | == Project URL: == 6 | 7 | https://github.com/bobbysmith007/cl-mediawiki 8 | 9 | == Supported API == 10 | 11 | * Edit 12 | ** create-page - Creates a new wiki page 13 | ** add-new-page-section - adds a new section to the specified wiki page 14 | ** append-text-to-page / prepend-text-to-page - adds text at the top or bottom of the specified page 15 | ** set-page-content - sets a pages content to the specified text 16 | ** regex-replace-all - replace all instances of regex with replacement on a target-page. There is an option for passing what the page content should be if it does not exist 17 | * Query 18 | ** token-bag - an object to store action tokens with a time stamp (to prevent overriding someone else's change 19 | ** get-action-tokens - requests and returns a token-bag for an edit/move/delete 20 | ** get-page-content - returns the content of the most recent revision of a page 21 | ** get-page-info - returns the properties of a page as an alist 22 | ** get-revisions - returns revision history of a page, including contents and diffs 23 | ** get-links - returns outgoing links from a page 24 | ** pages-that-embed - returns a list of pages that embed another page/template 25 | ** recent-changes - a list of recent changes to the wiki 26 | ** user-contribs - a list of contributions from a specific user 27 | * Conditions 28 | ** Errors 29 | *** media-wiki-error - signaled when media wiki returns an error 30 | 31 | == Example == 32 | 33 |
 34 |  ;; Gets the content of page "Pigment" from wikipedia
 35 |  (with-mediawiki ("http://en.wikipedia.org/w")
 36 |     (get-page-content "Pigment"))
 37 | 
 38 |  ;; Gets the content of page "Pigment" from a private mediawiki that requires authentication
 39 |  (with-mediawiki ((make-instance 'mediawiki
 40 | 				 :url "http://wiki.yourdomain.net"
 41 | 				 :auth (list "user" "pass")))
 42 |     (get-page-content "Pigment"))
 43 | 
 44 |  ;; Sets the content of page "Pigment" to be "This is the new content"
 45 |  (with-mediawiki (...)
 46 |     (set-page-content "Pigment" "This is the new content"))
 47 | 
 48 |  ;; Get the ids, user, and size of the last 10 revisions 
 49 |  (with-mediawiki ("http://en.wikipedia.org/w")
 50 |     (get-revisions "Pigment" :rvprop "ids|user|size" :rvlimit 10))
 51 | 
 52 | 
53 | 54 | == Dependencies == 55 | 56 | * [http://common-lisp.net/project/cxml/ Closure-XML] 57 | * [http://weitz.de/drakma/ Drakma] 58 | 59 | === Optional Dependencies === 60 | 61 | * [http://weitz.de/cl-ppcre/ CL-PPCRE] - If you have this installed, there will be a couple more functions available 62 | 63 | == News == 64 | 65 | * [http://russ.unwashedmeme.com/blog/?p=135 Hosting Move Announcement] 66 | * [http://russ.unwashedmeme.com/blog/?p=52 Blagging about my first in system usage of CL-MediaWiki] 67 | * [http://russ.unwashedmeme.com/blog/?p=43 Introductory Blog Post] 68 | 69 | == Authors == 70 | * [http://www.acceleration.net/ Acceleration.net] [http://www.acceleration.net/programming/donate-to-acceleration-net/ Donate] 71 | ** [http://russ.unwashedmeme.com/blog Russ Tyndall] 72 | ** [http://the.unwashedmeme.com/blog Nathan Bird] 73 | ** [http://ryepup.unwashedmeme.com/blog Ryan Davis] 74 | * [https://github.com/algal Alexis Gallagher] 75 | 76 |
 77 | ;; Copyright (c) 2011 Russ Tyndall , Acceleration.net http://www.acceleration.net
 78 | ;; All rights reserved.
 79 | ;;
 80 | ;; Redistribution and use in source and binary forms, with or without
 81 | ;; modification, are permitted provided that the following conditions are
 82 | ;; met:
 83 | ;;
 84 | ;;  - Redistributions of source code must retain the above copyright
 85 | ;;    notice, this list of conditions and the following disclaimer.
 86 | ;;
 87 | ;;  - Redistributions in binary form must reproduce the above copyright
 88 | ;;    notice, this list of conditions and the following disclaimer in the
 89 | ;;    documentation and/or other materials provided with the distribution.
 90 | ;;
 91 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 92 | ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 93 | ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 94 | ;; A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT
 95 | ;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 96 | ;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 97 | ;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 98 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 99 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
100 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
101 | ;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
102 | 
k 103 | -------------------------------------------------------------------------------- /cl-mediawiki-test.asd: -------------------------------------------------------------------------------- 1 | (in-package #:asdf-user) 2 | 3 | (defsystem :cl-mediawiki-test 4 | :description "The test suite for the cl-mediawiki system." 5 | :components ((:module :tests 6 | :serial T 7 | :components ((:file "setup") 8 | (:file "query" ) 9 | (:file "edit")))) 10 | ;; Additional Functionality will be loaded if cl-ppcre is in 11 | ;; the features list during compilation 12 | :depends-on (:cl-mediawiki :lisp-unit2)) 13 | -------------------------------------------------------------------------------- /cl-mediawiki.asd: -------------------------------------------------------------------------------- 1 | ;; -*- lisp -*- 2 | 3 | (eval-when (:compile-toplevel :load-toplevel :execute) 4 | (unless (find-package :net.acceleration.cl-mediawiki.system) 5 | (defpackage :net.acceleration.cl-mediawiki.system 6 | (:use :common-lisp :asdf)))) 7 | 8 | (in-package :net.acceleration.cl-mediawiki.system) 9 | 10 | (defsystem :cl-mediawiki 11 | :description "A tool to help talk to mediawiki's api." 12 | :components ((:module :src 13 | :serial T 14 | :components ((:file "packages") 15 | (:file "util" ) 16 | (:file "main" ) 17 | (:file "query" ) 18 | (:file "edit")))) 19 | ;; Additional Functionality will be loaded if cl-ppcre is in 20 | ;; the features list during compilation 21 | :depends-on (:cxml :drakma :alexandria) 22 | :in-order-to ((test-op (asdf:load-op :cl-mediawiki-test))) 23 | :perform (test-op (o c) 24 | (uiop:symbol-call :cl-mediawiki-test 'run-tests))) 25 | -------------------------------------------------------------------------------- /src/edit.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-mediawiki) 2 | 3 | (defun check-api-response (xml name datum) 4 | " Checks for the expected 'success' message in the node matching the 5 | name parameter 6 | 7 | signals match-errors assertion-errors and media-wiki-errors, printing 8 | datum in error messages. 9 | 10 | returns values: 11 | 1. the xml response 12 | 2. the alist of node attributes for the node we checked for success 13 | " 14 | 15 | (check-sxml-for-error xml) 16 | (let* ((matches (find-nodes-by-name name xml)) 17 | ;; if we have more than match, then odds are we're getting warnings. 18 | (kid (if (eq 1 (length matches)) (first matches) 19 | (second matches))) 20 | (alist (second kid))) 21 | (unless alist 22 | (error 'media-wiki-error 23 | :obj xml 24 | :message (format nil "Couldnt find ~a results" 25 | name))) 26 | (unless (string-equal "success" (sxml-attribute-value "result" alist)) 27 | (error 'media-wiki-error 28 | :message (format nil "Failed to ~A ~A : ~A " 29 | name datum alist) 30 | :code nil 31 | :obj xml)) 32 | (values xml alist))) 33 | 34 | (defun check-edit-response (datum xml) 35 | "Checks for the expected 'success' message 36 | 37 | signals match-errors assertion-errors and media-wiki-errors, 38 | printing datum in error messages. 39 | " 40 | (check-api-response xml "edit" datum )) 41 | 42 | (defun create-page 43 | (title text &key 44 | (summary "cl-mediawiki:create-page") 45 | (override nil)) 46 | "Creates a new wiki page 47 | If override is true, replace the existing page with the text passed in (if the page already exists) 48 | " 49 | (let* ((tokens (get-action-tokens title)) 50 | (parameters 51 | (make-parameters 52 | `((action edit) 53 | (token ,(edit-token tokens)) 54 | (title ,title) 55 | (basetimestamp ,(timestamp tokens)) 56 | ,(when (not override) 57 | '(createonly true)) 58 | (summary ,summary) 59 | (text ,text))) 60 | )) 61 | (check-edit-response 62 | title 63 | (parse-api-response-to-sxml (make-api-request parameters :method :post))))) 64 | 65 | (defun add-new-page-section (title section-title section-text &key no-create) 66 | "Creates a new == section-title == at the bottom of the page. followed by the specified text" 67 | (let* ((tokens (get-action-tokens title)) 68 | (parameters 69 | (make-parameters 70 | `((action edit) 71 | (token ,(edit-token tokens)) 72 | (title ,title) 73 | (section new) 74 | (summary ,section-title) 75 | (basetimestamp ,(timestamp tokens)) 76 | ,(when no-create 77 | '(nocreate T)) 78 | (text ,section-text))) 79 | )) 80 | (check-edit-response 81 | title 82 | (parse-api-response-to-sxml 83 | (make-api-request parameters :method :post))) 84 | )) 85 | 86 | (defun append-text-to-page 87 | (title text &key 88 | no-create 89 | (summary "cl-mediawiki:append-text-to-page")) 90 | "appends the text the the end of the page (will create the page if neccessary, unless no-create is passed)" 91 | (let* ((tokens (get-action-tokens title)) 92 | (parameters 93 | (make-parameters 94 | `((action edit) 95 | (token ,(edit-token tokens)) 96 | (title ,title) 97 | (summary ,summary) 98 | (basetimestamp ,(timestamp tokens)) 99 | ,(when no-create 100 | '(nocreate T)) 101 | (appendtext ,text))) 102 | )) 103 | (check-edit-response 104 | title 105 | (parse-api-response-to-sxml 106 | (make-api-request parameters :method :post))) 107 | )) 108 | 109 | (defun prepend-text-to-page 110 | (title text &key 111 | (summary "cl-mediawiki:prepend-text-to-page") 112 | no-create) 113 | "Adds the text to the beginning of the page named title 114 | (will create the page if neccessary unless no-create is true)" 115 | (let* ((tokens (get-action-tokens title)) 116 | (parameters 117 | (make-parameters 118 | `((action edit) 119 | (token ,(edit-token tokens)) 120 | (title ,title) 121 | (summary ,summary) 122 | (basetimestamp ,(timestamp tokens)) 123 | ,(when no-create 124 | '(nocreate T)) 125 | (prependtext ,text))) 126 | )) 127 | (check-edit-response 128 | title 129 | (parse-api-response-to-sxml 130 | (make-api-request parameters :method :post))) 131 | )) 132 | 133 | (defun set-page-content 134 | (title text &key no-create 135 | (summary "cl-mediawiki:set-page-content")) 136 | "sets the text of a wiki page 'title' to the specified 'text', 137 | 138 | title: The wiki page to set the content of 139 | text: The new content that the wiki page should have 140 | no-create:, do not create the wiki page if it does not exist 141 | summary: The comment associated with changing the page content 142 | " 143 | (let* ((tokens (get-action-tokens title)) 144 | (parameters 145 | (make-parameters 146 | `((action edit) 147 | (token ,(edit-token tokens)) 148 | (title ,title) 149 | (summary ,summary) 150 | (basetimestamp ,(timestamp tokens)) 151 | ,(when no-create 152 | '(nocreate T)) 153 | (text ,text))) 154 | )) 155 | (check-edit-response 156 | title 157 | (parse-api-response-to-sxml 158 | (make-api-request parameters :method :post))) 159 | )) 160 | 161 | (defun set-section-content (title rvsection text 162 | &key (summary "cl-mediawiki:set-section-content")) 163 | "Sets the text of section 'rvsection' on page 'title' to 'text'. 'text' MUST contain the section title markup!" 164 | ;; see http://lists.wikimedia.org/pipermail/mediawiki-api/2008-March/000390.html for 165 | ;; a description of rvsection 166 | (check-type rvsection (integer 1) "an index of what section to set, use list-page-sections to identify the right number. Increments sequentially down the page.") 167 | (unless (string-equal "==" (subseq text 0 2)) 168 | (error "Cannot set content of ~a section ~a, no section title detect in new content: ~a " rvsection title text)) 169 | (let* ((tokens (get-action-tokens title)) 170 | (parameters 171 | (make-parameters 172 | `((action edit) 173 | (token ,(edit-token tokens)) 174 | (title ,title) 175 | (section ,rvsection) 176 | (summary ,summary) 177 | (basetimestamp ,(timestamp tokens)) 178 | (text ,text))))) 179 | (check-edit-response 180 | title 181 | (parse-api-response-to-sxml 182 | (make-api-request parameters :method :post))))) 183 | 184 | #+cl-ppcre 185 | (defun regex-replace-all (regex target-page replacement &key default-content (summary "cl-mediawiki:regex-replace-all")) 186 | "Does a regex find/replace on the target page. If the page is empty, will set to default content if provided 187 | Works by calling get-content then regex-replacing on the content, then calling set-content " 188 | (let ((content (get-page-content target-page))) 189 | (set-page-content target-page 190 | (if content 191 | (cl-ppcre:regex-replace-all regex content replacement) 192 | default-content) 193 | :no-create (null default-content) 194 | :summary summary))) 195 | 196 | (defun upload (path &key 197 | (filename (file-namestring path)) 198 | (comment "uploaded via cl-mediawiki") 199 | (text "") 200 | watch 201 | ignorewarnings 202 | &aux (path (truename path))) 203 | "uploads a file from a local path. 204 | 205 | returns 2 values: 206 | 1. string for the filename according to mediawiki (eg: Foo.png) 207 | 2. string for the wikimarkup to link to the file (eg: [[File:Foo.png]])" 208 | (check-type path pathname) 209 | (let ((parameters 210 | (make-parameters 211 | `((action upload) 212 | (token ,(edit-token (get-action-tokens "cl-mediawiki"))) 213 | (filename ,filename) 214 | (file ,(truename path)) 215 | (comment ,comment) 216 | (text ,text) 217 | (watch ,(if watch 1 0)) 218 | (ignorewarnings ,(if ignorewarnings 1 0)) 219 | )))) 220 | (multiple-value-bind (xml node-attrs) 221 | ;; TODO: throw better error about disallowed mime types 222 | ;; eg: uploading a .asd file is not allowed 223 | (check-api-response 224 | (parse-api-response-to-sxml 225 | (make-api-request parameters :method :post)) 226 | "upload" filename) 227 | (declare (ignore xml)) 228 | (let ((filename (sxml-attribute-value "filename" node-attrs))) 229 | (values filename (format nil "[[File:~a]]" filename)))))) 230 | 231 | 232 | ;; Copyright (c) 2008 Accelerated Data Works, Russ Tyndall 233 | 234 | ;; Permission is hereby granted, free of charge, to any person 235 | ;; obtaining a copy of this software and associated documentation files 236 | ;; (the "Software"), to deal in the Software without restriction, 237 | ;; including without limitation the rights to use, copy, modify, merge, 238 | ;; publish, distribute, sublicense, and/or sell copies of the Software, 239 | ;; and to permit persons to whom the Software is furnished to do so, 240 | ;; subject to the following conditions: 241 | 242 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 243 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 244 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 245 | ;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 246 | ;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 247 | ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 248 | ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 249 | -------------------------------------------------------------------------------- /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*) 8 | (setf (documentation '*mediawiki* 'variable) 9 | "the current instance of media wiki we are dealing with (mostly for use with with-mediawiki)") 10 | 11 | (defun ensure-mediawiki (obj) 12 | (etypecase obj 13 | (string (make-instance 'mediawiki :url obj)) 14 | (mediawiki obj))) 15 | 16 | (defmacro with-mediawiki ((obj) &body body) 17 | `(let ((*mediawiki* (ensure-mediawiki ,obj))) 18 | ,@body)) 19 | 20 | (defvar *default-external-format* :utf-8 21 | "sets as the drakma default coding system") 22 | 23 | (defun make-api-request (api-params &key (basic-authorization (auth *mediawiki* )) (force-ssl nil force-ssl-p) (method :get)) 24 | "Calls the media wiki api providing the specified parameters" 25 | ;; force-ssl should either be whats passed in, or if nothing is passed in 26 | ;; check to see what protocol we used to connect to the server 27 | (let ((force-ssl (if force-ssl-p 28 | force-ssl 29 | (eq 0 (search "https://" (url *mediawiki*) :test #'char-equal )) 30 | )) 31 | (full-url (format nil "~a/api.php" (url *mediawiki*)))) 32 | ;; (format *debug-io* "~&api-params == ~S" api-params) ; debugging 33 | (push '("format" . "xml") api-params) 34 | (multiple-value-bind (content status headers uri stream must-close status-word) 35 | (let ((drakma:*drakma-default-external-format* *default-external-format*)) 36 | (drakma:http-request 37 | full-url 38 | :method method 39 | :basic-authorization basic-authorization 40 | :force-ssl force-ssl 41 | :parameters api-params 42 | :cookie-jar (cookie-jar *mediawiki*) 43 | )) 44 | ;; (format *debug-io* "~&uri == ~S" uri) ; debugging 45 | (declare (ignore headers uri stream must-close status-word)) 46 | (values content status)))) 47 | 48 | (defun make-parameters (params) 49 | "Takes a list of bindings (:key :val) and prepares them for transit 50 | by converting them to strings 51 | (if either the pair is nil or the value is nil, we drop that param) 52 | " 53 | (flet ((format-list-element (el) 54 | (typecase el 55 | (symbol (string-downcase (princ-to-string el))) 56 | (T (princ-to-string el))))) 57 | (loop for binding in params 58 | ;; only collect when we have a key and value 59 | when (and binding (cadr binding)) 60 | collecting 61 | (destructuring-bind (key val) binding 62 | ;; grabs a downcased key and its value (downcased if symbol) 63 | ;; as a pair of strings 64 | (cons (format nil "~(~a~)" key) 65 | (typecase val 66 | ;;lists should be pipe delimited 67 | (list (format nil "~{~a~^|~}" (mapcar #'format-list-element val))) 68 | (symbol (format nil "~(~a~)" val)) 69 | (pathname val) 70 | (T (princ-to-string val)))))))) 71 | 72 | (defun parse-api-response-to-sxml (content) 73 | (cxml:parse content (cxml-xmls:make-xmls-builder) :validate nil)) 74 | 75 | (defun sxml-attribute-value (key alist) 76 | (cadr (assoc key alist :test #'equalp))) 77 | 78 | (defun convert-sxml-attribs-to-alist (sxml-attribs) 79 | (loop for ((key val) . rest) = sxml-attribs then rest 80 | collecting (cons (symbolize-string key) val) 81 | while rest)) 82 | 83 | (define-condition media-wiki-error (error) 84 | ((obj :accessor obj :initarg :obj :initform nil) 85 | (code :accessor code :initarg :code :initform nil) 86 | (message :accessor message :initarg :message :initform nil))) 87 | 88 | (defmethod print-object ((err media-wiki-error) stream) 89 | (format stream "MEDIA-WIKI-ERROR: ~s ~a ~%~s" 90 | (code err) 91 | (message err) 92 | (obj err) 93 | )) 94 | 95 | (defun check-sxml-for-error (xml) 96 | "search the response for " 97 | (let* ((kid (find-nodes-by-name "error" xml)) 98 | (err (second kid))) 99 | (when err 100 | (error 'media-wiki-error 101 | :obj xml 102 | :code (sxml-attribute-value "code" err) 103 | :message (sxml-attribute-value "info" err))))) 104 | 105 | ;; Copyright (c) 2008 Accelerated Data Works, Russ Tyndall 106 | 107 | ;; Permission is hereby granted, free of charge, to any person 108 | ;; obtaining a copy of this software and associated documentation files 109 | ;; (the "Software"), to deal in the Software without restriction, 110 | ;; including without limitation the rights to use, copy, modify, merge, 111 | ;; publish, distribute, sublicense, and/or sell copies of the Software, 112 | ;; and to permit persons to whom the Software is furnished to do so, 113 | ;; subject to the following conditions: 114 | 115 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 116 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 117 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 118 | ;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 119 | ;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 120 | ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 121 | ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 122 | -------------------------------------------------------------------------------- /src/packages.lisp: -------------------------------------------------------------------------------- 1 | ;; -*- lisp -*- 2 | 3 | (defpackage :net.acceleration.cl-mediawiki 4 | (:use :common-lisp ) 5 | (:nicknames :cl-mediawiki) 6 | (:export 7 | ;; main 8 | #:mediawiki 9 | #:*mediawiki* 10 | #:*default-external-format* 11 | #:with-mediawiki 12 | ;; query 13 | #:login 14 | #:get-page-content 15 | #:get-action-tokens 16 | #:recent-changes 17 | #:user-contribs 18 | #:get-links 19 | #:get-revisions 20 | #:get-revisions-result 21 | #:list-page-sections 22 | #:find-page-section 23 | ;; query/query-result 24 | #:query-result 25 | #:has-more-results-p 26 | #:get-more-results 27 | #:results 28 | ;; EDIT 29 | #:set-page-content 30 | #:set-section-content 31 | #:append-text-to-page 32 | #:prepend-text-to-page 33 | #:add-new-page-section 34 | #:create-page 35 | #:regex-replace-all 36 | #:get-page-info 37 | #:get-image-info 38 | #:pages-that-embed 39 | #:upload 40 | #:list-all-pages 41 | #:list-all-users 42 | #:site-info) 43 | (:documentation 44 | "This package provides a client to the mediawiki API, which is used 45 | by Wikipedia among others. 46 | 47 | Exported functions fairly closely mirror the command structure of the 48 | API, which is summarized here: http://en.wikipedia.org/w/api.php 49 | 50 | Usage example: 51 | ;; setup to use only Wikipedia 52 | CL-USER> (setf cl-mediawiki:*mediawiki* 53 | (cl-mediawiki:with-mediawiki (\"http://en.wikipedia.org/w\") 54 | cl-mediawiki:*mediawiki*)) 55 | 56 | ;; get content of article titled Pigment 57 | CL-USER> (cl-mediawiki:get-page-content \"Pigment\") 58 | 59 | ;; get the revids and sizes of its last 10 revisions 60 | CL-USER> (cl-mediawiki:get-revisions \"Pigment\" :rvprop \"ids|user|size\" :rvlimit 10) 61 | 62 | Further documentation is in README.mediawiki.")) 63 | -------------------------------------------------------------------------------- /src/query.lisp: -------------------------------------------------------------------------------- 1 | ;; See ../LICENSE for info 2 | (in-package :cl-mediawiki) 3 | 4 | (eval-when (:compile-toplevel :load-toplevel :execute) 5 | (defparameter +default-query-params+ 6 | '(titles pageids revids prop list meta generator redirects indexpageids export exportnowrap ) 7 | "The parameters that are available for any action=query api call")) 8 | 9 | (defmacro define-proxy (name &key core req based-on props doc (processor 'identity) (method :GET)) 10 | "Defines a function with NAME with REQ required parameters. The 11 | symbols in the BASED-ON and PROPS lists are concatenated with pairs 12 | from the CORE list and passed to the MAKE-PARAMETERS function." 13 | ;; get the args that are not in req and are found in either based-on or props 14 | ;; Also add default params if necessary 15 | (let* ((kw-params (set-difference 16 | (union props 17 | (if (eq 'query (cadr (assoc 'action core))) 18 | (union based-on +default-query-params+) 19 | based-on)) 20 | req))) 21 | (let ((par-sym (gensym))) 22 | `(defun ,name (,@req &key ,@kw-params) ,(if doc doc "no documentation given") 23 | (let ((,par-sym (make-parameters 24 | (list ,@(mapcar #'(lambda (x) (if (listp x) 25 | `(list ',(car x) ',(cadr x)))) 26 | core) 27 | ,@(mapcar #'(lambda (x) (if (listp x) 28 | `(list ',(car x) ,(car x)) 29 | `(list ',x ,x))) 30 | (concatenate 'list req kw-params )))))) 31 | ;(print ,par-sym) 32 | (funcall #',processor 33 | (parse-api-response-to-sxml (make-api-request ,par-sym :method ,method)))))))) 34 | 35 | (defun login (lgname lgpassword &key lgdomain) 36 | ;;login is a 2 step process. http://www.mediawiki.org/wiki/API:Login 37 | (let* ((sxml (%login lgname lgpassword :lgdomain lgdomain)) 38 | (login-attrs (cadar (find-nodes-by-name "login" sxml))) 39 | (result (cadr (find "result" login-attrs 40 | :test #'string= :key #'car)))) 41 | (if (string= result "NeedToken") 42 | (%login lgname lgpassword :lgdomain lgdomain 43 | :lgtoken (cadr (find "token" login-attrs 44 | :test #'string= :key #'car))) 45 | sxml))) 46 | 47 | (define-proxy %login 48 | :core ((action login)) 49 | :req (lgname lgpassword) 50 | :props (lgdomain lgtoken) 51 | :method :POST 52 | :doc 53 | " 54 | This module is used to login and get the authentication tokens. 55 | In the event of a successful log-in, a cookie will be attached 56 | to your session. In the event of a failed log-in, you will not 57 | be able to attempt another log-in through this method for 5 seconds. 58 | This is to prevent password guessing by automated password crackers. 59 | 60 | This module only accepts POST requests. 61 | Parameters: 62 | lgname - User Name 63 | lgpassword - Password 64 | lgdomain - Domain (optional) 65 | lgtoken - Login token obtained in first request 66 | Example: 67 | api.php?action=login&lgname=user&lgpassword=password ") 68 | 69 | (define-proxy list-category-members 70 | :core ((action query) 71 | (list categorymembers)) 72 | :req (cmtitle) 73 | :based-on (version maxlag smaxage maxage requestid titles pageids revids prop 74 | meta generator redirects indexpageids) 75 | :props (cmprop cmnamespace cmcontinue cmlimit cmsort cmdir cmstart cmend cmstartsortkey cmendsortkey) 76 | :processor 77 | (lambda (sxml) 78 | (let ((rows (find-nodes-by-name "cm" sxml))) 79 | (loop for row in rows 80 | collecting (loop for (attr val) in (second row) 81 | collecting (list (symbolize-string attr) val) ))) ) 82 | :doc 83 | "List all pages in a given category. 84 | 85 | Parameters: 86 | cmtitle - Which category to enumerate (required). Must include Category: prefix 87 | cmprop - What pieces of information to include 88 | Values (separate with '|'): ids, title, sortkey, timestamp 89 | Default: ids|title 90 | cmnamespace - Only include pages in these namespaces 91 | Values (separate with '|'): 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 100, 101 92 | cmcontinue - For large categories, give the value retured from previous query 93 | cmlimit - The maximum number of pages to return. 94 | No more than 500 (5000 for bots) allowed. 95 | Default: 10 96 | cmsort - Property to sort by. One value: sortkey, timestamp,Default: sortkey 97 | cmdir - In which direction to sort. One value: asc, desc Default: asc 98 | cmstart - Timestamp to start listing from. Can only be used with cmsort=timestamp 99 | cmend - Timestamp to end listing at. Can only be used with cmsort=timestamp 100 | cmstartsortkey - Sortkey to start listing from. Can only be used with cmsort=sortkey 101 | cmendsortkey - Sortkey to end listing at. Can only be used with cmsort=sortkey 102 | 103 | Examples: 104 | Get first 10 pages in [[Category:Physics]]: 105 | (list-category-members \"Category:Physics\") 106 | 107 | Get page info about first 10 pages in [[Category:Physics]]: 108 | (list-category-members \"Category:Physics\" :prop 'info) 109 | 110 | Returns a list of alists, each representing a CategoryMember 111 | alist keys are: :title :ns :pageid 112 | " 113 | ) 114 | 115 | #| Some experimenting indicates that, at least for queries 116 | where ((action query) (prop revisions) (rvprop content)), the 117 | parameters titles and revids are mutually exclusive. 118 | 119 | The following implementation is therefore broken. By requiring titles, 120 | it prevents you from doing queries that specified a particular 121 | revision id, for instance. |# 122 | 123 | (define-proxy get-page-content 124 | :core ((action query) 125 | (prop revisions) 126 | (rvprop content)) 127 | :req (titles) 128 | :props (rvsection) 129 | :processor 130 | (lambda (sxml) 131 | (let ((rows (find-nodes-by-name "rev" sxml))) 132 | (third (first rows)))) 133 | :doc 134 | "Get the content for a given page. 135 | 136 | Does not accept revid. To get the content of older pages, use 137 | get-revisions with the rvprop content tag. 138 | 139 | Parameters: 140 | titles - the title of the page 141 | 142 | rvsection - only retrieve the content of this section 143 | (a number indicating which section, not the section name) 144 | 145 | Examples: (get-page-content \"Physics\") 146 | 147 | Returns: a string with the given page content 148 | ") 149 | 150 | (define-proxy get-page-content-by-revid 151 | :core ((action query) 152 | (prop revisions) 153 | (rvprop content)) 154 | :req (revids) 155 | :props (rvsection) 156 | :processor 157 | (lambda (sxml) 158 | (let ((rows (find-nodes-by-name "rev" sxml))) 159 | (third (first rows)))) 160 | :doc 161 | "Get the content for a given revid 162 | 163 | Parameters: 164 | revids - the revision id of the page 165 | 166 | rvsection - only retrieve the content of this section 167 | (a number indicating which section, not the section name) 168 | 169 | Examples: (get-page-content 446445813) 170 | 171 | Returns: a string with the given page content 172 | ") 173 | 174 | (define-proxy %parse-text-sections 175 | :core ((action parse) 176 | (prop sections)) 177 | :req (text) 178 | :processor 179 | (lambda (sxml &aux (rvsection 0)) 180 | (mapcar 181 | #'(lambda (s &aux (attrs (second s))) 182 | ;; s looks like: 183 | ;; ("s" 184 | ;; (("anchor" "HREF_ANCHOR") ("byteoffset" "") 185 | ;; ("fromtitle" "PAGE TITLE") ("index" "T-2") ("number" "1.1") 186 | ;; ("line" "SECTION TITLE") ("level" "3") ("toclevel" "2"))) 187 | 188 | (flet ((find-attr (name) 189 | (second 190 | (find name attrs :key #'first :test #'string-equal)))) 191 | (list 192 | (find-attr "number") 193 | (find-attr "line") 194 | (find-attr "anchor") 195 | (incf rvsection)))) 196 | (find-nodes-by-name "s" sxml))) 197 | :doc "parses the given text and lists sections in that content. 198 | returns list of (number name anchor rvsection)") 199 | 200 | (defun list-page-sections (page-title) 201 | "lists sections in a page, returns list of (number name anchor rvsection) 202 | 203 | rvsection is suitable to for the :rvsection param of get-page-content 204 | " 205 | ;; ask wiki to parse some markup and show the text sections, 206 | ;; crafting the markup to return the desired page 207 | ;; see http://lists.wikimedia.org/pipermail/mediawiki-api/2008-March/000392.html 208 | (%parse-text-sections (format nil "{{:~a}}__TOC__" page-title))) 209 | 210 | (defun find-page-section (page-title section-name) 211 | "searches the the given page for the given section name. returns nil or (number name anchor rvsection)" 212 | (find section-name (list-page-sections page-title) 213 | :key #'second 214 | :test #'string-equal)) 215 | 216 | (define-proxy pages-that-embed 217 | :core ((action query) 218 | (list embeddedin)) 219 | :req (eititle) 220 | :props (eicontinue einamespace eifilterredir eilimit) 221 | :processor 222 | (lambda (sxml) 223 | (let* ((rows (find-nodes-by-name "ei" sxml)) 224 | (c-blob (first (find-nodes-by-name 225 | "embeddedin" 226 | (first (find-nodes-by-name "query-continue" sxml))))) 227 | (continuation (when c-blob 228 | (destructuring-bind (_1 ((_2 continuation))) c-blob 229 | (declare (ignore _1 _2)) 230 | continuation))) 231 | titles) 232 | (loop for row in rows 233 | do (destructuring-bind (_1 ((_2 title) &rest _3)) row 234 | (declare (ignore _1 _2 _3)) 235 | (push title titles))) 236 | (values (nreverse titles) continuation))) 237 | :doc 238 | "List pages that embed a given template or other page 239 | 240 | Parameters: 241 | eititle - Title to search. If null, titles= parameter will be used instead, but will be obsolete soon. 242 | eicontinue - When more results are available, use this to continue. 243 | einamespace - The namespace to enumerate. 244 | Values (separate with '|'): 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 100, 101, 102, 103 245 | eifilterredir - How to filter for redirects 246 | One value: all, redirects, nonredirects 247 | Default: all 248 | eilimit - How many total pages to return. 249 | No more than 500 (5000 for bots) allowed. 250 | Default: 10 251 | 252 | Examples: (pages-that-embed \"Template:Client\") 253 | 254 | Returns: a list of pagetitles and a continuation (if there is one) 255 | ") 256 | 257 | (defclass token-bag () 258 | ((page-attributes :accessor page-attributes :initarg :page-attributes :initform nil 259 | :documentation "An alist of page attributes returned by the api") 260 | (timestamp :accessor timestamp :initarg :timestamp :initform nil) 261 | (tokens :accessor tokens :initarg :tokens :initform nil 262 | :documentation "either a single token, or an 263 | alist mapping type to value" ))) 264 | 265 | (defmethod print-object ((token-bag token-bag) stream) 266 | (with-accessors ((timestamp timestamp) 267 | (tokens tokens)) token-bag 268 | (format stream "#" timestamp tokens))) 269 | 270 | (defmethod edit-token ((token-bag token-bag)) 271 | (cdr (assoc :edit (tokens token-bag)))) 272 | 273 | (defmethod move-token ((token-bag token-bag)) 274 | (cdr (assoc :move (tokens token-bag)))) 275 | 276 | (defmethod delete-token ((token-bag token-bag)) 277 | (cdr (assoc :delete (tokens token-bag) ))) 278 | 279 | (define-proxy get-action-tokens 280 | :core ((action query) 281 | (rvprop timestamp) 282 | (prop "info|revisions")) 283 | :req (titles) 284 | :props ((intoken :edit)) 285 | :processor 286 | (lambda (sxml) 287 | (let ((pages (find-nodes-by-name "page" sxml))) 288 | (let ((result (loop for (page alist . children) in pages 289 | collecting 290 | (make-instance 291 | 'token-bag 292 | :page-attributes (convert-sxml-attribs-to-alist alist) 293 | :tokens 294 | (loop for token in (ensure-list intoken) 295 | collecting 296 | (cons token 297 | (sxml-attribute-value (format nil "~atoken" token) alist))) 298 | ;; The timestamp on the tokens bag may be incorrect, its better to 299 | ;; look at the revision history for the correct one 300 | :timestamp (let ((rev (first (loop for child in children 301 | for res = (find-nodes-by-name "rev" child) 302 | until res 303 | finally (return res))))) 304 | (if rev 305 | (sxml-attribute-value "timestamp" (second rev)) 306 | (sxml-attribute-value "touched" alist))))))) 307 | (if (eq 1 (length result)) (car result) result)))) 308 | :doc 309 | "Gets the tokens necessary for perform edits. 310 | 311 | Parameters: 312 | titles - the title of the page we wish to edit 313 | intoken - which tokens do we want (out of :edit :move :delete :block :unblock or a list of those) 314 | 315 | Examples: (get-action-tokens \"Physics\") 316 | (get-action-tokens \"Physics\" :intoken '(:edit :move :delete)) 317 | (get-action-tokens '(\"Main Page\" \"User:Russ\") :intoken '(:move :edit :delete :protect)) 318 | 319 | Returns: a token bag (or list of them if you asked for multiple pages) 320 | ") 321 | 322 | (define-proxy get-page-info 323 | :core ((action query) 324 | (prop info)) 325 | :req (titles) 326 | :processor 327 | (lambda (sxml) 328 | (convert-sxml-attribs-to-alist 329 | (second (first (find-nodes-by-name "page" sxml)) 330 | ))) 331 | :doc 332 | "Gets the info for a given page as an alist 333 | 334 | Parameters: 335 | titles - the title of the page we wish to retrieve the info of 336 | 337 | Returns: an alist of attributes about the page 338 | ") 339 | 340 | (define-proxy get-image-info 341 | :core ((action query) 342 | (prop imageinfo)) 343 | :req (titles) 344 | :props ((iiprop "timestamp|user|comment|url|size|sha1|mime|metadata|archivename") 345 | iilimit iistart iiend iiurlwidth iiurlheight) 346 | :processor 347 | (lambda (sxml) 348 | (flet ((extract-info (ii) 349 | "Gets the image info from the tag II, from its property list and its child if present." 350 | (let* ((props (convert-sxml-attribs-to-alist (second ii))) 351 | (metadata-prop (assoc :metadata props)) 352 | (metadata (find-nodes-by-name "metadata" ii))) 353 | (cond 354 | (metadata 355 | (cons (cons :metadata 356 | (loop for (nil attrs) in (rest metadata) 357 | collecting 358 | (cons (symbolize-string 359 | (second (assoc "name" attrs 360 | :test #'equal))) 361 | (second (assoc "value" attrs 362 | :test #'equal))))) 363 | props)) 364 | ;; it appears that when metadata was requested and the file has 365 | ;; no metadata, there is no metadata child (i.e. METADATA is 366 | ;; nil) and the has an empty "metadata" attribute 367 | (metadata-prop 368 | (setf (cdr metadata-prop) nil) 369 | props) 370 | (t 371 | props))))) 372 | (let* ((imageinfo (first (find-nodes-by-name "imageinfo" sxml))) 373 | ;; one per revision 374 | (revisions (mapcar #'extract-info (find-nodes-by-name "ii" imageinfo))) 375 | (c-blob (first (find-nodes-by-name 376 | "imageinfo" 377 | (first (find-nodes-by-name "query-continue" sxml))))) 378 | (continuation (when c-blob 379 | (destructuring-bind (_ ((__ continuation))) c-blob 380 | (declare (ignore _ __)) 381 | continuation)))) 382 | (values revisions continuation)))) 383 | :doc 384 | "Gets the info for a given image (or file) as an alist 385 | 386 | Parameters: 387 | titles - the title of the image we wish to retrieve the info of 388 | iiprop - Which properties to get 389 | Possible values (separate with '|'): timestamp, user, comment, url, 390 | size, sha1, mime, metadata, archivename. Default is all. 391 | iilimit - How many image revisions to return (1 by default) 392 | iistart - Timestamp to start listing from. Use this to continue a previous 393 | query. 394 | iiend - Timestamp to stop listing at 395 | iiurlwidth - If iiprop=url is set, a URL to an image scaled to this width will 396 | be returned as well. Old versions of images can't be scaled 397 | iiurlheight - Similar to iiurlwidth 398 | 399 | Example: (get-image-info \"Image:Albert Einstein Head.jpg\" :iiprop \"user|comment\") 400 | 401 | Returns: a list of alists of attributes about the requested revisions of the 402 | image, and a continuation if there is one. 403 | ") 404 | 405 | (define-proxy get-revisions 406 | :core ((action query) 407 | (prop revisions)) 408 | :req (titles) 409 | :props ((rvprop "ids|flags|timestamp|user|comment|size") 410 | (rvlimit 550) rvstartid rvendid rvstart rvend rvdir rvuser 411 | rvexcludeuser rvcontinue rvdiffto) 412 | :processor 413 | (lambda (sxml) 414 | ;; (format *debug-io* "~&get-revisions processing sxml== ~S" sxml) ; debug 415 | (flet ((parse-rawrev (rawrev) 416 | "Parses a rev tag, to handle possible tag contents. 417 | Adds text from rvprop content or parameter rvdiffto as an attrib. 418 | Possible rev structures: 419 | | #normal rvprops 420 | | CONTENT #rvprop content 421 | | DIFFCONTENT #rvdiffto 422 | 423 | Content is introduced by a xml:space attribute, which we dump. 424 | 425 | This ad-hoc parsing makes me sad." 426 | (destructuring-bind (revstr attribs &optional revcontent) rawrev 427 | (declare (ignore revstr)) 428 | (let* ((attribs-filtered 429 | (remove-if-not ;removes any xml:space attrib 430 | #'(lambda (attrib) (stringp (car attrib))) 431 | attribs)) 432 | (attribs-with-content 433 | (cond ; 434 | ((null revcontent) 435 | attribs-filtered) 436 | ; content 437 | ((stringp revcontent) 438 | (cons (list "content" revcontent) attribs-filtered)) 439 | ; DIFFCONTENT 440 | ((and (listp revcontent) (equal (first revcontent) "diff")) 441 | (cons (list "diffcontent" (elt revcontent 2)) attribs-filtered)) 442 | (t ; error. no match. drop the contents 443 | attribs-filtered)))) 444 | (convert-sxml-attribs-to-alist attribs-with-content))))) 445 | (let* ((rawrevs (find-nodes-by-name "rev" sxml)) 446 | (revs (mapcar #'parse-rawrev rawrevs)) 447 | (c-blob (first (find-nodes-by-name "query-continue" sxml)))) 448 | (values revs (when c-blob 449 | (destructuring-bind (_1 _2 (_3 ((_4 continuation)))) c-blob 450 | (declare (ignore _1 _2 _3 _4)) 451 | continuation)))))) 452 | :doc 453 | "Gets the revisions of a page. 454 | 455 | Parameters: 456 | titles - the title of the page we wish to retrieve the info of 457 | rvprop: - Which properties to get for each revision 458 | Possible values (separate with '|'): ids, flags, timestamp, 459 | user, comment, size, content. Default is all except content. 460 | rvcontinue: - When more results are available, use this to continue 461 | (This is different from the returned continuation.) 462 | rvlimit: - The maximum number of revisions to return (enum) 463 | rvstartid: - Revision ID to start listing from. (enum) 464 | rvendid: - Revision ID to stop listing at. (enum) 465 | rvstart: - Timestamp to start listing from. (enum) 466 | rvend: - Timestamp to end listing at. (enum) 467 | rvdir: - Direction to list in. (enum) 468 | Possible values: older, newer. 469 | Default: older 470 | rvuser: - Only list revisions made by this user 471 | rvexcludeuser: - Do not list revisions made by this user 472 | rvdiffto: - Revision ID to diff each revision to. 473 | Possible values (an id, \"prev\", \"next\" or \"cur\"). 474 | 475 | Examples: (get-revisions \"Pigment\" :rvprop \"ids|user|size\" :rvlimit 10) 476 | (get-revisions \"Physics\" :rvlimit 10) 477 | 478 | Returns: list of revisions as alists and (if there is one) a continuation, 479 | which is the rvstart id to pass in the next call to get more results. 480 | ") 481 | 482 | (define-proxy get-links 483 | :core ((action query) 484 | (prop links)) 485 | :req (titles) 486 | :props ((pllimit 5000) 487 | (plnamespace nil) 488 | plcontinue) 489 | :processor 490 | (lambda (sxml) 491 | (let ((links (mapcar #'(lambda (n) (convert-sxml-attribs-to-alist (second n))) 492 | (find-nodes-by-name "pl" sxml))) 493 | (c-blob (first (find-nodes-by-name "query-continue" sxml)))) 494 | (values links (when c-blob 495 | (destructuring-bind (_1 _2 (_3 ((_4 continuation)))) c-blob 496 | (declare (ignore _1 _2 _3 _4)) 497 | continuation))))) 498 | :doc 499 | "Gets a list of all links on the provided pages. 500 | 501 | Parameters: 502 | titles - the title of the page we wish to retrieve the info of 503 | pllimit - How many links to return. Default: 10. No more than 500 (5000 for bots) allowed. 504 | plcontinue - When more results are available, use this to continue. 505 | plnamespace - Only list links to pages in these namespaces. 506 | (For example, set plnamespace to 0 to get only article links in Wikipedia.) 507 | 508 | Examples: 509 | ; gets 10 results 510 | (get-links \"Pigment\" :pllimit 10) 511 | 512 | ; gets 10 results, then gets 10 more using a continuation token 513 | (multiple-value-bind (firstresults continuation-token) 514 | (get-links \"Pigment\" :pllimit 10) 515 | (let ((secondresults (get-links \"Pigment\" :pllimit 10 :plcontinue continuation-token))) 516 | (list firstresults secondresults))) 517 | ") 518 | 519 | (define-proxy recent-changes 520 | :core ((action query) 521 | (list recentchanges)) 522 | :req () 523 | :props (rcstart rcend rcdir rcnamespace (rcprop "user|comment|title|timestamp|ids") rcshow rclimit rctype) 524 | :processor 525 | (lambda (sxml) 526 | (mapcar #'(lambda (n) 527 | (convert-sxml-attribs-to-alist 528 | (cadr n))) 529 | (cddr (first (cddr (find "query" (cddr sxml) 530 | :key #'first 531 | :test #'string-equal))))) 532 | ;sxml 533 | ) 534 | :doc 535 | "Enumerates the recent changes 536 | 537 | Parameters: 538 | rcstart - The timestamp to start enumerating from. 539 | rcend - The timestamp to end enumerating. 540 | rcdir - In which direction to enumerate. 541 | One value: newer, older 542 | Default: older 543 | rcnamespace - Filter log entries to only this namespace(s) 544 | Values (separate with '|'): 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 100, 101, 102, 103 545 | rctitles - Filter log entries to only these page titles 546 | rcprop - Include additional pieces of information 547 | Values (separate with '|'): user, comment, flags, timestamp, title, ids, sizes, redirect, patrolled 548 | Default: title|timestamp|ids 549 | rcshow - Show only items that meet this criteria. 550 | For example, to see only minor edits done by logged-in users, set show=minor|!anon 551 | Values (separate with '|'): minor, !minor, bot, !bot, anon, !anon, redirect, !redirect, patrolled, !patrolled 552 | rclimit - How many total changes to return. 553 | No more than 500 (5000 for bots) allowed. 554 | Default: 10 555 | rctype - Which types of changes to show. 556 | Values (separate with '|'): edit, new, log 557 | 558 | Returns: 559 | ") 560 | 561 | (define-proxy user-contribs 562 | :core ((action query) 563 | (list usercontribs)) 564 | :req (ucuser) 565 | :props (uclimit ucstart ucend ucuserprefix ucdir ucnamespace (ucprop "comment|title|timestamp|ids") ucshow) 566 | :processor 567 | (lambda (sxml) 568 | (mapcar #'(lambda (n) 569 | (convert-sxml-attribs-to-alist 570 | (cadr n))) 571 | (cddr (first (cddr (find "query" (cddr sxml) 572 | :key #'first 573 | :test #'string-equal))))) 574 | ;sxml 575 | ) 576 | :doc 577 | " Get all edits by a user 578 | Parameters: 579 | uclimit - The maximum number of contributions to return. 580 | No more than 500 (5000 for bots) allowed. 581 | Default: 10 582 | ucstart - The start timestamp to return from. 583 | ucend - The end timestamp to return to. 584 | ucuser - The user to retrieve contributions for. 585 | ucuserprefix - Retrieve contibutions for all users whose names begin with this value. Overrides ucuser. 586 | ucdir - The direction to search (older or newer). 587 | One value: newer, older 588 | Default: older 589 | ucnamespace - Only list contributions in these namespaces 590 | Values (separate with '|'): 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 100, 101, 102, 103 591 | ucprop - Include additional pieces of information 592 | Values (separate with '|'): ids, title, timestamp, comment, flags 593 | Default: ids|title|timestamp|flags|comment 594 | ucshow - Show only items that meet this criteria, e.g. non minor edits only: show=!minor 595 | Values (separate with '|'): minor, !minor 596 | 597 | ") 598 | 599 | (define-proxy list-all-pages 600 | :core ((action query) 601 | (list allpages)) 602 | ; :req (ucuser) 603 | :props (aplimit apfrom) 604 | :processor 605 | (lambda (sxml) 606 | (mapcar #'(lambda (n) 607 | (convert-sxml-attribs-to-alist 608 | (cadr n))) 609 | (cddr (first (cddr (find "query" (cddr sxml) 610 | :key #'first 611 | :test #'string-equal))))) 612 | ;sxml 613 | ) 614 | :doc 615 | " List all pages. 616 | Parameters: 617 | aplimit - The maximum number of contributions to return. 618 | No more than 500 (5000 for bots) allowed. 619 | Default: 10 620 | apfrom - Start listing at this title. The title need not exist 621 | ") 622 | 623 | (define-proxy list-all-users 624 | :core ((action query) 625 | (list allusers)) 626 | :props (aulimit aufrom) 627 | :processor 628 | (lambda (sxml) 629 | (mapcar #'(lambda (n) 630 | (convert-sxml-attribs-to-alist 631 | (cadr n))) 632 | (cddr (first (cddr (find "query" (cddr sxml) 633 | :key #'first 634 | :test #'string-equal))))) 635 | ;sxml 636 | ) 637 | :doc 638 | " List all users. 639 | Parameters: 640 | aulimit - The maximum number of contributions to return. 641 | No more than 500 (5000 for bots) allowed. 642 | Default: 10 643 | aufrom - Start listing at this user. 644 | ") 645 | 646 | (define-proxy site-info 647 | :core ((action query) 648 | (meta siteinfo)) 649 | :props () 650 | :processor 651 | (lambda (sxml) 652 | (car (mapcar #'(lambda (n) 653 | (convert-sxml-attribs-to-alist 654 | (cadr n))) 655 | (cddr (find "query" (cddr sxml) 656 | :key #'first 657 | :test #'string-equal))))) 658 | :doc 659 | " Returns overall site information. 660 | Parameters: none 661 | ") 662 | 663 | ;;;; query-result and friends 664 | ;; a query-result eStart listing at this title. The title need not ncapsulates the response to a query, and allows 665 | ;; for repeated follow-up queries 666 | 667 | (define-modify-macro 668 | appendf (&rest lists) append 669 | "Modify-macro for APPEND. Appends LISTS to the place designated by the first argument.") 670 | 671 | (defclass query-result () 672 | ((results :accessor results :initarg :results :initform '()) ; a sequence of revisions retrieved so far 673 | (closure :initarg :closure :initform nil)) 674 | (:documentation "Accumulating result to a get-revisions-result query. 675 | 676 | Use has-more-results-p to check if there are more results available. 677 | Use get-more-results to get them through one or more queries.")) 678 | 679 | (defmethod has-more-results-p ((qr query-result)) 680 | "Returns nil, or the closure used for a single follow-up query" 681 | (slot-value qr 'closure)) 682 | 683 | (defmethod get-more-results-once ((qr query-result)) 684 | "Fetches more results with one follow-up query. 685 | 686 | Updates the query-result object with these new results. 687 | Returns the object, and the number of new items fetched." 688 | (multiple-value-bind (newrevs c-token new-closure) 689 | (funcall (slot-value qr 'closure)) 690 | (declare (ignore c-token)) 691 | (appendf (slot-value qr 'results) newrevs) 692 | (setf (slot-value qr 'closure) new-closure) 693 | (values qr (length newrevs)))) 694 | 695 | (defmethod get-more-results ((qr query-result) &key (at-least 0) (pause 1)) 696 | "Fetches AT-LEAST more results, re-querying every PAUSE seconds if necessary. 697 | 698 | If AT-LEAST is nil, repeats until it gets all results. 699 | Updates the query-result object with these new results. 700 | Returns the object, and the number of new items fetched." 701 | (loop with fetched = 0 702 | while (and (has-more-results-p qr) 703 | (if (numberp at-least) (< fetched at-least) 't)) 704 | do (incf fetched (second (multiple-value-list (get-more-results-once qr)))) 705 | do (sleep pause) 706 | finally (return (values qr fetched)))) 707 | 708 | ;;;; get-revisions-result and friends 709 | ;; query functions for doing get-revisions queries that 710 | ;; return their results as query-result objects 711 | 712 | (defun get-revisions-and-closure (&rest args) 713 | "Like get-revisions, but also returns a closure for a follow-up query. 714 | 715 | This closure can be called outside of a with-mediawiki form. 716 | 717 | Example: 718 | (multiple-value-list (with-mediawiki (\"http://en.wikipedia.org/w\") 719 | (get-revisions-and-closure \"Pigment\" :rvlimit 3))) 720 | (multiple-value-list (funcall (elt * 2))) 721 | (multiple-value-list (funcall (elt * 2))) 722 | etc.." 723 | (let ((mediawiki *mediawiki*)) ; capture *mediawiki* into lexical scope 724 | (multiple-value-bind (revs c-token) (apply #'get-revisions args) 725 | (values revs (when c-token c-token) 726 | (when c-token 727 | (setf (getf (cdr args) :rvstartid) c-token) ;set next rvstartid 728 | (lambda () 729 | (with-mediawiki (mediawiki) ; use captured *mediawiki* 730 | (apply #'get-revisions-and-closure args)))))))) 731 | 732 | (defun get-revisions-result (&rest args) 733 | "Like get-revisions, but returns a query-result object" 734 | (multiple-value-bind (revs c-token closure) 735 | (apply #'get-revisions-and-closure args) 736 | (declare (ignore c-token)) 737 | (make-instance 'query-result :results revs :closure closure))) 738 | 739 | ;; Copyright (c) 2008 Accelerated Data Works, Russ Tyndall 740 | 741 | ;; Permission is hereby granted, free of charge, to any person 742 | ;; obtaining a copy of this software and associated documentation files 743 | ;; (the "Software"), to deal in the Software without restriction, 744 | ;; including without limitation the rights to use, copy, modify, merge, 745 | ;; publish, distribute, sublicense, and/or sell copies of the Software, 746 | ;; and to permit persons to whom the Software is furnished to do so, 747 | ;; subject to the following conditions: 748 | 749 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 750 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 751 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 752 | ;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 753 | ;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 754 | ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 755 | ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 756 | -------------------------------------------------------------------------------- /src/util.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-mediawiki) 2 | ;; This file has a few necessary random utility functions 3 | 4 | (defun ensure-list (x) 5 | "just ensure that you have alist" 6 | (if (listp x) x (list x))) 7 | 8 | (defun symbolize-string (str &optional (package :keyword)) 9 | "Turns a string into a happy symbol 10 | 11 | ex: ''foo bar_bast'' -> FOO-BAR-BAST 12 | " 13 | (etypecase str 14 | (string (intern (nsubstitute 15 | #\- #\_ 16 | (nsubstitute #\- #\space (string-upcase str) :test #'char=) 17 | :test #'char=) 18 | package)) 19 | (symbol str))) 20 | 21 | (defun map-sxml-tree (fn tree) 22 | "Do a depth first traversal of some set of trees calling fn on every non-nil element. " 23 | (when tree 24 | (labels ((rec (tree) 25 | (funcall fn tree) 26 | (dolist (n (cddr tree)) 27 | (when (listp n) 28 | (rec n))))) 29 | (rec tree)))) 30 | 31 | (defun find-tree (pred tree) 32 | "find a tree based on a predicate" 33 | (let ((results)) 34 | (flet ((handler (node) 35 | (when (funcall pred node) 36 | (push node results)))) 37 | (map-sxml-tree #'handler tree) 38 | (nreverse results)))) 39 | 40 | (defun find-nodes-by-name (name tree) 41 | "find all sxml nodes with a given name " 42 | (find-tree (lambda (n) 43 | (string-equal 44 | (when (and (listp n) (stringp (car n))) 45 | (car n)) name)) tree)) 46 | 47 | -------------------------------------------------------------------------------- /tests/edit.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-mediawiki-test) 2 | -------------------------------------------------------------------------------- /tests/query.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-mediawiki-test) 2 | 3 | (define-wikipedia-test get-content-test () 4 | (lisp-unit2:assert-true 5 | (cl-mediawiki:get-page-content "Pigment"))) 6 | 7 | (define-wikipedia-test get-action-tokens-test () 8 | (lisp-unit2:assert-true 9 | (cl-mediawiki:get-action-tokens "Pigment"))) 10 | 11 | (define-wikipedia-test pages-that-embed-test () 12 | (lisp-unit2:assert-false 13 | (cl-mediawiki:pages-that-embed "Pigment")) 14 | (lisp-unit2:assert-true 15 | (cl-mediawiki:pages-that-embed "Template:Grateful_Dead" ))) 16 | 17 | (define-wikipedia-test get-page-info-test () 18 | (lisp-unit2:assert-true 19 | (cl-mediawiki:get-page-info "Pigment" ))) 20 | 21 | (define-wikipedia-test recent-changes-test () 22 | (lisp-unit2:assert-true 23 | (cl-mediawiki:recent-changes))) 24 | 25 | (define-wikipedia-test user-contribs-test () 26 | (lisp-unit2:assert-true 27 | (cl-mediawiki:user-contribs "bobbysmith007"))) 28 | 29 | (define-wikipedia-test get-revisions-test () 30 | (lisp-unit2:assert-true 31 | (cl-mediawiki:get-revisions "Pigment" :rvlimit 10))) 32 | -------------------------------------------------------------------------------- /tests/setup.lisp: -------------------------------------------------------------------------------- 1 | (defpackage :net.acceleration.cl-mediawiki-test 2 | (:nicknames #:cl-mediawiki-test) 3 | (:use :common-lisp )) 4 | 5 | (in-package :cl-mediawiki-test) 6 | 7 | (defmacro define-wikipedia-test (name () &body body) 8 | `(lisp-unit2:define-test ,name () 9 | (cl-mediawiki:with-mediawiki ("http://en.wikipedia.org/w") 10 | ,@body))) 11 | 12 | (defun run-tests () 13 | (lisp-unit2:with-summary () 14 | (lisp-unit2:run-tests :package :cl-mediawiki-test))) 15 | --------------------------------------------------------------------------------