From 5c1c10c0c6e104a9e38941fa007918abd5db82a0 Mon Sep 17 00:00:00 2001 From: Stephen Chang Date: Tue, 1 Oct 2013 22:38:51 +0000 Subject: [PATCH] fix image name clash, closes #4; code cleanup - add pasterack-utils.rkt --- README.md | 4 +- pasterack-utils.rkt | 7 +++ pasterack.rkt | 128 ++++++++++++++++++-------------------------- 3 files changed, 63 insertions(+), 76 deletions(-) create mode 100644 pasterack-utils.rkt diff --git a/README.md b/README.md index 88fe6b5..967aa78 100644 --- a/README.md +++ b/README.md @@ -1,4 +1,6 @@ pasterack ========= -The Racket pastebin. +The Racket evaluating [pastebin](http://www.pasterack.org). + +pkg dependencies: ring-buffer, redis diff --git a/pasterack-utils.rkt b/pasterack-utils.rkt new file mode 100644 index 0000000..2faa9f3 --- /dev/null +++ b/pasterack-utils.rkt @@ -0,0 +1,7 @@ +#lang racket/base +(provide (all-defined-out)) + +(define ++ string-append) + +(define (mk-rand-str) + (bytes->string/utf-8 (list->bytes (for/list ([n 4]) (+ 49 (random 9)))))) diff --git a/pasterack.rkt b/pasterack.rkt index aa6feb0..c8e0acd 100644 --- a/pasterack.rkt +++ b/pasterack.rkt @@ -6,35 +6,37 @@ (require racket/system racket/runtime-path) (require redis data/ring-buffer) +(require "pasterack-utils.rkt") (provide/contract (start (request? . -> . response?))) -;; (define-runtime-path tmp-html-file "test.html") -;; (define-runtime-path tmp-scrbl-file "test.scrbl") (define-runtime-path htdocs-dir "htdocs") (define-runtime-path here ".") (define-runtime-path tmp-dir "tmp") -(define ++ string-append) -(define +++ string-append) - (define pastebin-url "http://www.pasterack.org/") (define paste-url-base (++ pastebin-url "pastes/")) (define racket-docs-url "http://docs.racket-lang.org/") (define racket-lang-url "http://racket-lang.org") (define racket-logo-url "http://racket-lang.org/logo.png") -(define (mk-link url txt) - `(a ((href ,url) (onclick ,(+++ "top.location.href=\"" url "\""))) ,txt)) +(define (mk-paste-url paste-num) (++ paste-url-base paste-num)) -(define NUM-RECENT-PASTES 5) +;; the top.location breaks out of the current frame +(define (mk-link url txt) + `(a ((href ,url) (onclick ,(++ "top.location.href=\"" url "\""))) ,txt)) + +(define (fresh-str) + (let loop () (define str (mk-rand-str)) (if (EXISTS str) (loop) str))) + +(define NUM-RECENT-PASTES 10) (define recent-pastes (empty-ring-buffer NUM-RECENT-PASTES)) ;; initialize buffer with some pastes -(ring-buffer-push! recent-pastes "4363") +(ring-buffer-push! recent-pastes "9842") (ring-buffer-push! recent-pastes "4548") -(ring-buffer-push! recent-pastes "8249") (ring-buffer-push! recent-pastes "9921") -(ring-buffer-push! recent-pastes "7145") - +(ring-buffer-push! recent-pastes "9937") +(ring-buffer-push! recent-pastes "1192") +(ring-buffer-push! recent-pastes "9111") ;; returns output file name (as path), or #f on fail (define (write-codeblock-scrbl-file code) @@ -49,9 +51,11 @@ #:exists 'replace) tmp-name) (define (write-eval-scrbl-file code) + ;; parse out #lang if it's there (define lang-match (regexp-match #px"^\\#lang ([\\w/]+)\\s*(.*)" code)) - (define code-no-lang (match lang-match [(list _ _ rst) rst] [_ code])) - (define lang (match lang-match [(list _ lang _) lang] [_ "racket"])) + (define-values (code-no-lang lang) + (match lang-match [(list _ lang rst) (values rst lang)] + [_ (values code "racket")])) (define tmp-name (mk-rand-str)) (define tmp-scrbl-file (build-path tmp-dir (++ tmp-name ".scrbl"))) (with-output-to-file tmp-scrbl-file @@ -66,14 +70,7 @@ #:mode 'text #:exists 'replace) tmp-name) -#;(define (compile-scribble-file code) - (with-handlers ([exn:fail? (lambda (x) (displayln (exn-message x)) #f)]) - (write-scribble-file code) - (system (+++ "/home/stchang/pltpkg/racket/bin/scribble --html +m " -; "++xref-in setup/xref load-collections-xref " - "--redirect-main " racket-docs-url " " - "--dest " (path->string here) " " - (path->string tmp-scrbl-file))))) + (define (compile-scrbl-file/get-html name) (and (system (++ "/home/stchang/pltpkg/racket/bin/scribble --html +m " @@ -93,20 +90,18 @@ (define (generate-eval-html code) (compile-eval-scrbl-file/get-html (write-eval-scrbl-file code))) -(define (mk-paste-url paste-num) (++ paste-url-base paste-num)) - (define google-analytics-script - (+++ "var _gaq = _gaq || [];\n" - "_gaq.push(['_setAccount', 'UA-44480001-1']);\n" - "_gaq.push(['_trackPageview']);\n" - "(function() {\n" - "var ga = document.createElement('script'); " - "ga.type = 'text/javascript'; ga.async = true;\n" - "ga.src = ('https:' == document.location.protocol " - "? 'https://ssl' : 'http://www') + '.google-analytics.com/ga.js';\n" - "var s = document.getElementsByTagName('script')[0];" - "s.parentNode.insertBefore(ga, s);\n" - "})();")) + (++ "var _gaq = _gaq || [];\n" + "_gaq.push(['_setAccount', 'UA-44480001-1']);\n" + "_gaq.push(['_trackPageview']);\n" + "(function() {\n" + "var ga = document.createElement('script'); " + "ga.type = 'text/javascript'; ga.async = true;\n" + "ga.src = ('https:' == document.location.protocol " + "? 'https://ssl' : 'http://www') + '.google-analytics.com/ga.js';\n" + "var s = document.getElementsByTagName('script')[0];" + "s.parentNode.insertBefore(ga, s);\n" + "})();")) (define (serve-home request) (define (response-generator embed/url) @@ -118,30 +113,21 @@ (body (center (img ((src ,racket-logo-url))) - (h1 "PasteRack: The " + (h1 ,(mk-link pastebin-url "PasteRack") ": The " ,(mk-link racket-lang-url "Racket") " pastebin.") (form ((action ,(embed/url process-paste)) (method "post")) (textarea ((rows "20") (cols "79") (name "paste"))) (br) (input ((type "submit") (value "Submit Paste")))) - (br) (br) (br) + (br) + (h3 "Total pastes: " ,(number->string (DBSIZE))) (h3 "Recent pastes:") ,@(apply append (reverse - (for/list ([n NUM-RECENT-PASTES]) - (define paste-num (ring-buffer-ref recent-pastes n)) - (if paste-num - (list (mk-link (mk-paste-url paste-num) paste-num) '(br)) - null))))))))) + (for/list ([pnum recent-pastes] #:when pnum) + (list (mk-link (mk-paste-url pnum) pnum) '(br)))))))))) (send/suspend/dispatch response-generator)) -(define (mk-rand-str) - (bytes->string/utf-8 (list->bytes (for/list ([n 4]) (+ 49 (random 9)))))) -(define (fresh-str) - (let loop () - (define str (mk-rand-str)) - (if (EXISTS str) (loop) str))) - (define (process-paste request) (define bs (request-bindings request)) (cond @@ -151,14 +137,6 @@ (define html-res (generate-paste-html pasted-code)) (define paste-html-str (or html-res pasted-code)) (define eval-html-str (and html-res (generate-eval-html pasted-code))) - ;; (if (compile-scribble-file pasted-code) - ;; (with-input-from-file tmp-html-file port->bytes) - ;; code)) - ;; ;; (car (filter - ;; ;; (lambda (d) (equal? "main" (se-path* '(div #:class) d))) - ;; ;; (se-path*/list '(div) - ;; ;; (xml->xexpr (document-element - ;; ;; (with-input-from-file tmp-html-file read-xml))))))) (define paste-url (mk-paste-url paste-num)) (ring-buffer-push! recent-pastes paste-num) (SET/list paste-num (list paste-html-str (or eval-html-str ""))) @@ -208,10 +186,9 @@ (link ((href "/scribble-style.css") (rel "stylesheet") (title "default") (type "text/css"))) (script ((src "/scribble-common.js") (type "text/javascript")))) - (body - ((id "scribble-racket-lang-org")) - ,(mk-link pastebin-url "PasteRack") - " Paste # " (a ((href ,paste-url)) ,pastenum) + (body () + ,(mk-link pastebin-url "PasteRack") (br) + " Paste # " (a ((href ,paste-url)) ,pastenum) (br) (div ((class "maincolumn")) ,(match code-main-div [`(div ((class "main")) ,ver ,body) @@ -244,26 +221,27 @@ [`(tr () (td () (p () (img ((alt "image") ,height (src ,filename) ,width))))) + ;; rename file to avoid future clashes + (define rxmatch + (regexp-match #px"^(pict|\\d+)\\_*(\\d+)*\\.png" + filename)) + (unless rxmatch + (error "scribble made non-pict.png ~a" filename)) + (match-define (list _ base offset) rxmatch) + (define new-file + (++ pastenum (if offset (++ "_" offset) "") ".png")) + (define curr-file-path (build-path tmp-dir filename)) + (define new-file-path (build-path tmp-dir new-file)) + (unless (file-exists? new-file-path) + (copy-file curr-file-path new-file-path) + (delete-file curr-file-path)) `(tr () (td () (p () (img ((alt "image") ,height - (src ,(++ "/" filename)) ,width)))))] + (src ,(++ "/" new-file)) ,width)))))] [x x])) results))))] [_ `(div ,eval-main-div)]))] - ;; ;; filter void outputs - ;; ,(filter - ;; (lambda (x) - ;; (match x - ;; ['(p () (span ((class "RktRes")) "#" "<" "void" ">")) #f] - ;; [_ #t])) - ;; results))] [_ `(div ,code-main-div)])))))])) - ;; [`(div ((class "main")) ,ver (p () ,code ,res)) - ;; `(div ((class "main")) (p () ,code (div "=>") ,res))])))))])) - ;; ,(cons (car main-div) (cons (cadr main-div) (cdddr main-div)))))))])) - ;; (div ((class "main")) - ;; (blockquote ((class "SCodeFlow")) - ;; ,(se-path* '(blockquote) doc-xexpr)))))))])) (define-values (do-dispatch mk-url) (dispatch-rules