source: project/release/3/svnwiki-rating/trunk/svnwiki-rating.scm @ 12533

Last change on this file since 12533 was 12533, checked in by azul, 11 years ago

Importing svnwiki extensions.

  • Property svn:keywords set to id
File size: 14.2 KB
Line 
1; $id$
2;
3; License: GPL-3
4
5(declare (export))
6(use svnwiki-extensions-support srfi-40 html-stream stream-ext format-modular orders srfi-1 svn-client svn-post-commit-hooks)
7
8(define (create-rating-helper env)
9  (let-from-environment env (path-out program)
10    (when (and path-out (string=? program "post-commit"))
11      (assert (and 'create-rating-helper (string? path-out)))
12      (unless (directory? (svnwiki-make-pathname path-out "xsvnwiki-helper"))
13        (create-directory (svnwiki-make-pathname path-out "xsvnwiki-helper")))
14      (unless (directory? (svnwiki-make-pathname (list path-out "xsvnwiki-helper") "rating"))
15        (create-directory (svnwiki-make-pathname (list path-out "xsvnwiki-helper") "rating")))
16      (write-file-with-tmp
17        (svnwiki-make-pathname (list "xsvnwiki-helper" "rating") "rating")
18        "text/javascript"
19        path-out
20        (string->stream
21          *rating-js-code*)))))
22
23(define (rating-render-bottom-span env)
24  (create-rating-helper env)
25  (let-from-environment env (path-out-real path path-in static-url)
26    (when (and (string=? (get-props-parents-first "rating:ignore" path-in path "no") "no") ; Deprecated
27               (string=? (get-props-parents-first "svnwiki:rating:ignore" path-in path "no") "no")
28               (not (svnwiki-is-special? #f path)))
29      (let ((span-id (format #f "div-rating-~A" (random 100000)))
30            (components (string-split path "/")))
31        (svnwiki-render-bottom-span
32          env
33          (html-stream
34            ; TODO: Don't get this more than once per file.
35            ((script type "text/javascript" src (format #f "~A/xsvnwiki-helper/rating/rating" static-url)))
36            ((span id span-id class "render-bottom-span render-bottom-span-rating") "Loading...")
37            ((script type "text/javascript")
38             (format #f "<!--~%rating.url = \"~A\";~%if (typeof(rating.updateStats) == 'function') { rating.loadXml('~A', function (x) { rating.updateStats(x, '~A'); }); }~%-->"
39                     (or (get-props-parents-first "rating:application-url" path-in path) ; Deprecated
40                         (get-props-parents-first "svnwiki:rating:application-url" path-in path)
41                         (get-props-parents-first "svnwiki:application-url" path-in path)
42                         (error "Wiki does not define svnwiki:application-url"))
43                     (make-link-url
44                       path-out-real
45                       (svnwiki-make-pathname
46                         (append
47                           (butlast components)
48                           (list "xsvnwiki-rating"))
49                         (last components))
50                       #f)
51                     span-id))))
52        (code-vote env 1 "up" span-id)
53        (code-vote env -1 "down" span-id)))))
54
55(define (code-vote env direction name id)
56  (let-from-environment env (path-in path path-out-real)
57    (let ((image (get-props-parents-first (format #f "svnwiki:rating:votes-image-~A" name) path-in path #f)))
58      (svnwiki-render-bottom-span
59        env
60        (html-stream
61          ((a href (format #f "javascript:rating.vote(~A, \"~A\", \"~A\");" direction path id)
62              class (format #f "render-bottom-span render-bottom-span-rating-~A" name))
63           (if image
64             (html-stream ((img src image border 0 alt (format #f "Vote ~A!" name))))
65             (format #f "Vote ~A" name))))))))
66
67(define *rating-js-code*
68#<<EOF
69if (typeof(rating) != "object") {
70var rating = new Object();
71
72// We use this to avoid the GC from collecting objects from loadXml before
73// they have actually loaded their documents and processed them:
74
75rating.requests = new Array();
76
77rating.loadXmlDone = function (xmlDoc, process)
78{
79  if (xmlDoc.readyState == 4) { // if "loaded"
80    if (xmlDoc.status == 200) { // if "OK"
81      process(xmlDoc.responseXML); // pass DOM
82    } else if (xmlDoc.status >= 400) {
83      alert("There was a problem (status = "+xmlDoc.status+")\nretrieving the XML data:\n" + xmlDoc.statusText);
84    }
85    rating.removeRequest(xmlDoc);
86  }
87}
88
89rating.loadXml = function (href, process)
90{
91  var xmlDoc;
92  var registerstatechange = true;
93
94  if (window.XMLHttpRequest && !(window.ActiveXObject)) {
95    try {
96      xmlDoc = new XMLHttpRequest();
97      xmlDoc.onreadystatechange = function () { rating.loadXmlDone(xmlDoc, process); };
98      xmlDoc.open("GET", href, true);
99      xmlDoc.send("");
100    }
101    catch(e) {
102      xmlDoc = false;
103    }
104  }
105
106  if (!xmlDoc && document.implementation && document.implementation.createDocument) {
107    xmlDoc = document.implementation.createDocument("", "", null);
108    xmlDoc.onload = function () { rating.removeRequest(xmlDoc); process(xmlDoc) };
109    xmlDoc.load(href);
110  }
111
112  if (!xmlDoc && window.ActiveXObject) {
113    try {
114      xmlDoc = new ActiveXObject("Msxml2.XMLHTTP");
115    }
116    catch(e) {
117      try {
118        xmlDoc = new ActiveXObject("Microsoft.XMLHTTP");
119      }
120      catch(e) {
121        xmlDoc = false;
122      }
123    }
124    if (xmlDoc) {
125      xmlDoc.onreadystatechange = function() { rating.loadXmlDone(xmlDoc, process); }
126      xmlDoc.load(href);
127    }
128  }
129
130  if (!xmlDoc) {
131    alert('Your browser can\'t handle this script');
132    return;
133  }
134
135  rating.requests.push(xmlDoc);
136}
137
138rating.removeRequest = function (element)
139{
140  var rd, wr;
141  for (rd = 0, wr = 0; rd < rating.requests.length; rd ++)
142    if (rating.requests[rd] != element)
143      rating.requests[wr ++] = rating.requests[rd];
144  while (wr < rating.requests.len)
145    rating.requests.pop();
146}
147
148rating.cleanContent = function (element)
149{
150  while (element.hasChildNodes())
151    element.removeChild(element.firstChild);
152}
153
154rating.makeLink = function ( target, content )
155{
156  var link = makeElement('A', content);
157  link.setAttribute('href', target);
158  return link;
159}
160
161rating.makeElement = function (type, content)
162{
163  var elem = document.createElement(type);
164  if (content)
165    elem.appendChild(content);
166  return elem;
167}
168
169rating.vote = function ( direction, file, id ) {
170  var content = document.getElementById(id);
171  rating.cleanContent(content);
172  content.appendChild(rating.makeElement('i', document.createTextNode("Updating...")));
173  rating.loadXml(rating.url + file + "?action=extension&extension=rating&vote=" + direction, function (x) { rating.updateStats(x, id); });
174}
175
176rating.updateStats = function ( xmlDoc, id ) {
177  var content = document.getElementById(id);
178  rating.cleanContent(content);
179  var data = xmlDoc.getElementsByTagName('data');
180  if (data && data[0]) {
181    content.appendChild(document.createTextNode('Rating: '));
182    content.appendChild(rating.makeElement('b', document.createTextNode(data[0].getAttribute('score') || data[0].getAttribute('rating'))));
183    votes = data[0].getAttribute('votes');
184    if (votes) {
185      content.appendChild(document.createTextNode(' ('));
186      content.appendChild(document.createTextNode(votes));
187      content.appendChild(document.createTextNode(' votes)'));
188    }
189  }
190}
191}
192EOF
193)
194
195(define (rating-list-all-files env entry)
196  (stream-remove
197    (cut entry-rating-ignore? env <>)
198    (stream-map
199      car
200      (list->stream
201        (hash-table->alist
202          (entry-subs entry))))))
203
204(define (entry-rating-ignore? env file)
205  (let-from-environment env (path-in path)
206    (let ((path (svnwiki-make-pathname path file)))
207      (or (svnwiki-is-special? #f path)
208          (directory? (svnwiki-make-pathname path-in path))
209          (string=? (get-props-parents-first "rating:ignore" path-in path "no") "yes") ; Deprecated
210          (string=? (get-props-parents-first "svnwiki:rating:ignore" path-in path "no") "yes")))))
211
212(define (make-rating-special path)
213  (let ((components (string-split path "/")))
214    (svnwiki-make-pathname
215      (butlast components)
216      (svnwiki-make-pathname
217        "xsvnwiki-rating"
218        (last components)))))
219
220(define (rating-update env)
221  (let-from-environment env (path-out path-in base path user password old-rev)
222    (let* ((entry (post-commit-changed-files
223                    (svnwiki-make-pathname path-in path)
224                    (string-append base "/" path)
225                    user
226                    password
227                    old-rev))
228           (entry-info
229             (hash-table-ref/default (entry-subs entry) "xsvnwiki-rating" #f)))
230
231      ; If they changed one of the rating files, update its corresponding XML.
232
233      (when entry-info
234        (hash-table-walk
235          (entry-subs entry-info)
236          (lambda (path-file _)
237            (rating-update-file
238              (environment env ((path (svnwiki-make-pathname (list path "xsvnwiki-rating") path-file))))))))
239
240      ; Make sure an XML exists for each and every file for which
241      ; a rating should be provided:
242
243      (stream-for-each
244        (lambda (path-file)
245          (let ((path-rating (svnwiki-make-pathname (list path "xsvnwiki-rating") path-file)))
246            (unless (file-exists? (svnwiki-make-pathname path-out path-rating))
247              (rating-update-file
248                (environment env ((path path-rating)))))))
249        (rating-list-all-files env entry))
250
251      (svnwiki-rating-generate-best env))))
252
253(define (svnwiki-rating-generate-best env)
254  (let-from-environment env (path-in path path-out)
255    (let* ((path-out-real (svnwiki-make-pathname
256                            (svnwiki-rating-dir-path env)
257                            (get-props-parents-first "svnwiki:rating:best-name" path-in path "xsvnwiki-rating-top")))
258           (env (environment-capture env (path-out-real))))
259      (write-file-with-tmp path-out-real "text/html" path-out
260        (render-template env "" (svnwiki-rating-generate-best-content env) 'view)))))
261
262(define (svnwiki-rating-dir-path env)
263  (let-from-environment env (path-in path)
264    (if (directory? (svnwiki-make-pathname path-in path))
265      path
266      (svnwiki-make-pathname (butlast (string-split path "/"))))))
267
268(define (svnwiki-rating-generate-best-content env)
269  (let-from-environment env (path-out-real path-in)
270    (stream-concatenate
271      (stream-map
272        (let ((dir-path (svnwiki-rating-dir-path env)))
273          (lambda (file)
274            (svnwiki-render-file-contents-included
275              (environment env ((path (svnwiki-make-pathname dir-path file)))))))
276        (svnwiki-rating-get-best-posts env)))))
277
278; Return the stream with the posts that should be included in the top
279
280(define (svnwiki-rating-get-best-posts env)
281  (let-from-environment env (path-in path)
282    (let ((dir-path (svnwiki-rating-dir-path env)))
283      (if (directory? (svnwiki-make-pathname (list path-in dir-path) "xsvnwiki-rating"))
284        (stream-take-safe
285          (stream-map
286            car
287            (stream-sort
288              (stream-map
289                (lambda (file)
290                  (receive (score votes)
291                           (rating-compute
292                             (environment env ((path (svnwiki-make-pathname (list dir-path "xsvnwiki-rating") file)))))
293                    (list file score votes)))
294                (list->stream (directory (svnwiki-make-pathname (list path-in dir-path) "xsvnwiki-rating"))))
295              (order (key> cadr) (key> caddr))))
296          (string->number (get-props-parents-first "svnwiki:rating:best-count" path-in path "10")))
297        stream-null))))
298
299(define (rating-update-file env)
300  (let-from-environment env (path-out path)
301    (let* ((components (string-split path "/"))
302           (dir (svnwiki-make-pathname (butlast components))))
303      (unless (directory? (svnwiki-make-pathname path-out dir))
304        (create-directory (svnwiki-make-pathname path-out dir)))
305      (write-file-with-tmp
306        path
307        "application/xml"
308        path-out
309        (rating-produce-xml (environment-capture env (path)))))))
310
311(define (rating-produce-xml env)
312  (->stream-char
313    (receive (score votes)
314             (rating-compute env)
315      (format #f "<?xml version=\"1.0\"?>~%~%<data score=\"~A\" votes=\"~A\" />" score votes))))
316
317(define (rating-compute env)
318  (let ((input (stream-lines (open-input-stream-rating env))))
319    (values
320      (stream-fold-right
321        (lambda (line sum)
322          (+ (or (stream->number
323                   (stream-take-while
324                     (complement (cut char=? #\: <>))
325                     line))
326                 0)
327             sum))
328        0
329        input)
330      (stream-length input))))
331
332(define (open-input-stream-rating env)
333  (let-from-environment env (path-in path)
334    (let ((real-path (svnwiki-make-pathname path-in path)))
335      (if (file-exists? real-path)
336        (port->stream (open-input-file real-path))
337        stream-null))))
338
339(define (rating-dynamic env)
340  (let-from-environment env (path-out path user-input path-in user password)
341    (let* ((components (string-split path "/"))
342           (dir (svnwiki-make-pathname (butlast components) "xsvnwiki-rating"))
343           (dir-path-in (svnwiki-make-pathname path-in dir))
344           (real-path (svnwiki-make-pathname dir (last components)))
345           (already-existed (file-exists? real-path))
346           (addr (getenv "REMOTE_ADDR"))
347           (env (environment env ((path real-path)))))
348      (unless (stream-any
349                (lambda (line)
350                  (stream=
351                    char=?
352                    (string->stream addr)
353                    (stream-drop-safe
354                      (stream-drop-while
355                        (complement (cut char=? <> #\:))
356                        line)
357                      1)))
358                (stream-lines (open-input-stream-rating env)))
359
360        (unless (directory? dir-path-in)
361          (create-directory dir-path-in)
362          (svn-add dir-path-in))
363
364        (write-file-with-tmp
365          real-path
366          "application/octet-stream"
367          path-in
368          (stream-append
369            (open-input-stream-rating env)
370            (string->stream
371              (format #f "~A:~A~%"
372                      (or (stream->number (user-input 'vote stream-null)) 1)
373                      addr))))
374
375        (unless already-existed
376          (svn-add (svnwiki-make-pathname path-in real-path)))
377
378        (svn-commit path-in user password (format #f "Registering vote~%")))
379
380      (->stream-char
381        "Content-type: text/xml\n\n"
382        (rating-produce-xml env)))))
383
384(svnwiki-extension-define 'render-bottom-span 'rating rating-render-bottom-span)
385(svnwiki-extension-define 'dynamic 'rating rating-dynamic)
386(svnwiki-extension-define 'update-notify 'rating rating-update)
387(svnwiki-extension-define 'start-update-notify 'rating create-rating-helper)
Note: See TracBrowser for help on using the repository browser.