1 | ;; |
---|
2 | ;; qwiki-svn - Subversion implementation of revisioning system for qwiki |
---|
3 | ;; |
---|
4 | ;; Copyright (c) 2009 Peter Bex |
---|
5 | ;; |
---|
6 | ;; Redistribution and use in source and binary forms, with or without |
---|
7 | ;; modification, are permitted provided that the following conditions |
---|
8 | ;; are met: |
---|
9 | ;; |
---|
10 | ;; - Redistributions of source code must retain the above copyright |
---|
11 | ;; notice, this list of conditions and the following disclaimer. |
---|
12 | ;; |
---|
13 | ;; - Redistributions in binary form must reproduce the above |
---|
14 | ;; copyright notice, this list of conditions and the following |
---|
15 | ;; disclaimer in the documentation and/or other materials provided |
---|
16 | ;; with the distribution. |
---|
17 | ;; |
---|
18 | ;; - Neither name of the copyright holders nor the names of its |
---|
19 | ;; contributors may be used to endorse or promote products derived |
---|
20 | ;; from this software without specific prior written permission. |
---|
21 | ;; |
---|
22 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND THE |
---|
23 | ;; CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, |
---|
24 | ;; INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF |
---|
25 | ;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE |
---|
26 | ;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR THE |
---|
27 | ;; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, |
---|
28 | ;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT |
---|
29 | ;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF |
---|
30 | ;; USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED |
---|
31 | ;; AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
---|
32 | ;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN |
---|
33 | ;; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE |
---|
34 | ;; POSSIBILITY OF SUCH DAMAGE. |
---|
35 | |
---|
36 | (provide 'qwiki-svn) |
---|
37 | |
---|
38 | (module qwiki-svn |
---|
39 | (qwiki-repos-uri qwiki-repos-username qwiki-repos-password |
---|
40 | get-history call-with-input-revision checkout-sources! update-sources!) |
---|
41 | |
---|
42 | (import chicken scheme) |
---|
43 | (use regex posix files srfi-18 svn-client) |
---|
44 | |
---|
45 | ;; The version control system's repos uri, username and password |
---|
46 | (define qwiki-repos-uri (make-parameter #f)) ; string, not uri-reference! |
---|
47 | (define qwiki-repos-username (make-parameter "anonymous")) |
---|
48 | (define qwiki-repos-password (make-parameter "")) |
---|
49 | |
---|
50 | ;; Get the history for a given file starting at rev, going back in |
---|
51 | ;; time. If rev is #f, start at the latest revision. If limit is not |
---|
52 | ;; specified or #f, the full history is returned. Otherwise, a |
---|
53 | ;; maximum of that many items is returned. |
---|
54 | (define (get-history file rev #!optional limit) |
---|
55 | (let ((history '())) |
---|
56 | (svn-client-log2 |
---|
57 | file (if rev (make-svn-opt-revision-number rev) svn-opt-revision-head) |
---|
58 | (make-svn-opt-revision-number 0) (or limit 0) #f #f |
---|
59 | (qwiki-repos-username) (qwiki-repos-password) |
---|
60 | (lambda (files rev author date msg) |
---|
61 | ;; What about the timezone? Is it always GMT? POSIX strptime |
---|
62 | ;; doesn't know about this so we may need to use srfi-19... |
---|
63 | (let* ((seconds-date (string-substitute "\\.[0-9]+.*" "" date)) |
---|
64 | (date (string->time date "%Y-%m-%dT%H:%M"))) |
---|
65 | (set! history (cons (list rev author date msg) history))))) |
---|
66 | (reverse history))) |
---|
67 | |
---|
68 | (define (call-with-input-revision file rev proc) |
---|
69 | (let ((filename (svn-client-cat |
---|
70 | file (make-svn-opt-revision-number rev) |
---|
71 | (qwiki-repos-username) (qwiki-repos-password)))) |
---|
72 | (handle-exceptions exn |
---|
73 | (begin |
---|
74 | (delete-file* filename) |
---|
75 | (raise exn)) |
---|
76 | (let ((result (call-with-input-file filename proc))) |
---|
77 | (delete-file* filename) |
---|
78 | result)))) |
---|
79 | |
---|
80 | (define (checkout-sources! source-path) |
---|
81 | (svn-update (qwiki-repos-uri) source-path svn-opt-revision-head |
---|
82 | (qwiki-repos-username) (qwiki-repos-password))) |
---|
83 | |
---|
84 | (define (update-sources! source-path) |
---|
85 | (svn-update (qwiki-repos-uri) source-path svn-opt-revision-head |
---|
86 | (qwiki-repos-username) (qwiki-repos-password))) |
---|
87 | |
---|
88 | ) |
---|