├── .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 |
--------------------------------------------------------------------------------