source: project/stream-wiki/trunk/extensions/rating.scm @ 6550

Last change on this file since 6550 was 6550, checked in by azul, 12 years ago

Improving the AJAXey code, based on suggestions by SebastiAn? GonzAlez?

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