;; Copyright (c) 2007,2009, Tony Sidaway ;; All rights reserved. ;; ;; Redistribution and use in source and binary forms, with or without ;; modification, are permitted provided that the following ;; conditions are met: ;; ;; Redistributions of source code must retain the above copyright notice, ;; this list of conditions and the following disclaimer. ;; Redistributions in binary form must reproduce the above copyright notice, ;; this list of conditions and the following disclaimer in the documentation ;; and/or other materials provided with the distribution. ;; Neither the name of the author nor the names of its contributors may ;; be used to endorse or promote products derived from this software ;; without specific prior written permission. ;; ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" ;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE ;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ;; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS ;; BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS ;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN ;; CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE ;; POSSIBILITY OF SUCH DAMAGE. ; ; This module builds on the sxml layer provided by mw-sxml and provides a more ; scheme-like interface to a number of useful everyday tasks such as listing ; page contents, revision histories, category member lists, backlinks and ; transclusions, and checking user group membership (privileges). ; (module mw-edit (export ignore-semantics login logout edit append-section remove-section watch unwatch send-email) (import chicken scheme data-structures srfi-1 srfi-13 regex) (require-extension sxpath mw-raw mw-sxml) (include "mw-macros.scm") (define ignore-semantics (make-parameter '())) (define login (let ((sxresult (sxpath "api/login/@result"))) (lambda (credentials #!rest z #!key wiki) (mw:check-arguments 'login z '(wiki)) (let* ((wiki (or wiki (default-wiki)))) ; It's advisable to check this and signal an error before messing with authentication. (or wiki (mw:error 'login "Cannot login until I know which wiki! Set (default-wiki).")) (receive (username password) (credentials wiki) (let* ((login-response (sx-call `((action . login) (lgname . ,username) (lgpassword . ,password)) wiki: wiki method: 'POST)) (result (cadar (sxresult login-response)))) (if (string=? result "Success") login-response (mw:error 'login (sprintf "Result of login: ~S" result))))))))) (define (logout #!rest z #!key wiki method) (mw:check-arguments 'logout z '(wiki method)) (let* ((wiki (or wiki (default-wiki))) (method (or method (default-method)))) (sx-call '((action . logout)) wiki: wiki method: method))) (define sxtoken (sxpath "api/query/pages/page/@edittoken")) (define sxtimestamp (sxpath "api/query/pages/page/revisions/rev/@timestamp")) (define (edit title #!rest z #!key section text appendtext prependtext summary minor notminor bot recreate createonly nocreate watchlist md5 captchaid captchaword undo undoafter wiki) (mw:check-arguments 'edit z '(section text appendtext prependtext summary minor notminor bot recreate createonly nocreate watchlist md5 captchaid captchaword undo undoafter wiki)) ; Semantics (if (not (memq 'edit (ignore-semantics))) (begin (or title (mw:error 'edit "No page title")) (or (string? title) (symbol? title) (mw:error 'edit "Page title must be a string or symbol")) (or text prependtext appendtext undo (mw:error 'edit "One of the parameters text, prependtext, appendtext and undo must be set")) (and minor notminor (mw:error 'edit "Both minor and notminor flags were set")) (and createonly nocreate (mw:error 'edit "Both creatonly and nocreate flags were set")) (and recreate nocreate (mw:error 'edit "Both recreate and nocreate flags were set")) (and undoafter (not undo) (mw:error 'edit "Undoafter set but undo not given")) (and captchaword (not captchaid) (mw:error 'edit "captchaword given but capthaid not given")))) (let* ((wiki (or wiki (default-wiki))) (response (sx-call `((action . query) (titles . ,title) (prop . ,(pipejoin '(info revisions))) (intoken . edit)) wiki: wiki method: (default-method))) (edittoken (sxtoken response)) (timestamp (sxtimestamp response)) (notrecreate (not recreate))) (and (pair? edittoken) (set! edittoken (cadar edittoken))) (and (pair? timestamp) (set! timestamp (cadar timestamp))) (sx-call (filter-true `((action . edit) (title . ,title) ,(and-. section section) ,(and-. text text) ,(and-. prependtext prependtext) ,(and-. appendtext appendtext) (token . ,edittoken) ,(and-. summary summary) ,(and-. minor (boolean minor)) ,(and-. notminor (boolean notminor)) ,(and-. bot (boolean bot)) (basetimestamp . ,timestamp) ,(and-. starttimestamp timestamp (not recreate)) ,(and-. recreate (boolean recreate)) ,(and-. createonly (boolean createonly)) ,(and-. nocreate (boolean nocreate)) ,(and-. watchlist (boolean watchlist)) ,(and-. md5 md5) ,(and-. captchaid captchaid) ,(and-. captchaword captchaword) ,(and-. undo undo) ,(and-. undoafter undoafter))) wiki: wiki method: 'POST))) (define (append-section title subject text #!rest z #!key minor notminor bot recreate createonly nocreate watchlist md5 captchaid captchaword wiki) (mw:check-arguments 'append-section z '(minor notminor bot recreate createonly nocreate watchlist md5 captchaid captchaword wiki)) (edit title section: 'new summary: subject appendtext: text minor: minor notminor: notminor bot: bot recreate: recreate createonly: createonly nocreate: nocreate watchlist: watchlist md5: md5 captchaid: captchaid captchaword: captchaword wiki: wiki)) (define (remove-section title section summary #!rest z #!key minor notminor bot watchlist md5 captchaid captchaword wiki) (mw:check-arguments 'remove-section z '(minor notminor bot watchlist md5 captchaid captchaword wiki)) (edit title section: section summary: summary text: "" minor: minor notminor: notminor bot: bot nocreate: #t watchlist: watchlist md5: md5 captchaid: captchaid captchaword: captchaword wiki: wiki)) (define (watch/unwatch unwatch page #!rest z #!key wiki method) (mw:check-arguments 'watch/unwatch z '(wiki method)) (let ((wiki (or wiki (default-wiki))) (method (or method (default-method)))) (sx-select (sx-call `((action . watch) (title . ,page) (unwatch . ,(boolean unwatch))) wiki: wiki method: method) `("api/watch/@title" ,(string-append "api/watch/@" (if unwatch "unwatched" "watched")))))) (define watch (lambda x (apply watch/unwatch #f x))) (define unwatch (lambda x (apply watch/unwatch #t x))) (define (send-email user subject text #!rest z #!key ccme wiki) (mw:check-arguments 'send-email z '(ccme wiki)) (let* ((email-token-reply (sx-call `((action . query) (titles . ,(string-append "User:" user)) (prop . info) (intoken . email)) wiki: wiki method: (default-method))) (result ((sxpath "api/query/pages/page/@emailtoken") email-token-reply)) (token (and (pair? result) (cadar result)))) (and token (sx-call `((action . emailuser) (target . ,user) (subject . ,subject) (text . ,text) (token . ,token) (ccme . ,(boolean ccme))) wiki: wiki method: 'POST)))) )