pull/9/head
Matthew Butterick 11 years ago
parent 7caab48bba
commit 1135abad7e

@ -17,6 +17,16 @@
; debug utilities ; debug utilities
(define months (list "Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")) (define months (list "Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"))
(define last-message-time #f)
(define (seconds-since-last-message)
(define now (current-seconds))
(define then last-message-time)
(set! last-message-time now)
(if then
(- now then)
"--"))
(define (message . items) (define (message . items)
(define (zero-fill str count) (define (zero-fill str count)
(set! str (~a str)) (set! str (~a str))
@ -28,16 +38,17 @@
(define date (current-date)) (define date (current-date))
(define date-fields (map (λ(x) (zero-fill x 2)) (define date-fields (map (λ(x) (zero-fill x 2))
(list (list
(date-day date) ; (date-day date)
(list-ref months (sub1 (date-month date))) ; (list-ref months (sub1 (date-month date)))
(if (<= (date-hour date) 12) (if (<= (date-hour date) 12)
(date-hour date) ; am hours + noon hour (date-hour date) ; am hours + noon hour
(modulo (date-hour date) 12)) ; pm hours after noon hour (modulo (date-hour date) 12)) ; pm hours after noon hour
(date-minute date) (date-minute date)
(date-second date) (date-second date)
; (if (< (date-hour date) 12) "am" "pm") ; (if (< (date-hour date) 12) "am" "pm")
(seconds-since-last-message)
))) )))
(apply format "[~a-~a ~a:~a:~a]" date-fields)) (apply format "[~a:~a:~a ~as]" date-fields))
(displayln (string-join `(,(make-date-string) ,@(map (λ(x)(if (string? x) x (~v x))) items))) (current-error-port))) (displayln (string-join `(,(make-date-string) ,@(map (λ(x)(if (string? x) x (~v x))) items))) (current-error-port)))

@ -7,6 +7,11 @@
(provide render render-with-session) (provide render render-with-session)
;; for shared use by eval & system
(define nowhere-port (open-output-nowhere))
;; mod-dates is a hash that takes lists of paths as keys, ;; mod-dates is a hash that takes lists of paths as keys,
;; and lists of modification times as values. ;; and lists of modification times as values.
;; Reason: a templated page is a combination of two source files. ;; Reason: a templated page is a combination of two source files.
@ -105,6 +110,7 @@
(() (#:force boolean?) #:rest (listof pathish?) . ->* . void?) (() (#:force boolean?) #:rest (listof pathish?) . ->* . void?)
(define (&render x) (define (&render x)
(let ([path (->complete-path (->path x))]) (let ([path (->complete-path (->path x))])
; (message "Dispatching render for" (->string (file-name-from-path path)))
(cond (cond
;; this will catch preprocessor files ;; this will catch preprocessor files
[(needs-preproc? path) (render-with-preproc path #:force force)] [(needs-preproc? path) (render-with-preproc path #:force force)]
@ -116,7 +122,7 @@
(render-ptree-files ptree #:force force))] (render-ptree-files ptree #:force force))]
[(equal? FALLBACK_TEMPLATE_NAME (->string (file-name-from-path path))) [(equal? FALLBACK_TEMPLATE_NAME (->string (file-name-from-path path)))
(message "Render: using fallback template")] (message "Render: using fallback template")]
[(file-exists? path) 'pass-through] [(file-exists? path) (message "Serving static file" (->string (file-name-from-path path)))]
[else (error "Render couldn't find" (->string (file-name-from-path path)))]))) [else (error "Render couldn't find" (->string (file-name-from-path path)))])))
(for-each &render xs)) (for-each &render xs))
@ -135,7 +141,7 @@
(define/contract (up-to-date-message path) (define/contract (up-to-date-message path)
(any/c . -> . void?) (any/c . -> . void?)
(message "File is up to date:" (->string (file-name-from-path path)))) (message (->string (file-name-from-path path)) "is up to date, using cached copy"))
(define/contract (render-with-preproc x #:force [force #f]) (define/contract (render-with-preproc x #:force [force #f])
@ -166,7 +172,7 @@
(store-refresh-in-mod-dates source-path) (store-refresh-in-mod-dates source-path)
;; discard output using open-output-nowhere ;; discard output using open-output-nowhere
(parameterize ([current-directory source-dir] (parameterize ([current-directory source-dir]
[current-output-port (open-output-nowhere)]) [current-output-port nowhere-port])
(system command)) (system command))
(rendered-message output-path)) (rendered-message output-path))
;; otherwise, skip file because there's no trigger for refresh ;; otherwise, skip file because there's no trigger for refresh
@ -241,10 +247,10 @@
;; path using default template name = ;; path using default template name =
;; "-main" + extension from output path (e.g. foo.xml.p -> -main.xml) ;; "-main" + extension from output path (e.g. foo.xml.p -> -main.xml)
(build-path source-dir (add-ext DEFAULT_TEMPLATE_PREFIX (get-ext (->output-path source-path))))))) (build-path source-dir (add-ext DEFAULT_TEMPLATE_PREFIX (get-ext (->output-path source-path)))))))
;; if none of these work, make temporary template file ;; if none of these work, make fallback template file
(let ([tp (build-path source-dir FALLBACK_TEMPLATE_NAME)]) (let ([ft-path (build-path source-dir FALLBACK_TEMPLATE_NAME)])
(display-to-file #:exists 'replace fallback-template-data tp) (display-to-file #:exists 'replace fallback-template-data ft-path)
tp))) ft-path)))
;; refresh template (it might have its own preprocessor file) ;; refresh template (it might have its own preprocessor file)
(render template-path #:force force) (render template-path #:force force)
@ -252,8 +258,8 @@
;; calculate new path for generated file ;; calculate new path for generated file
(define output-path (->output-path source-path)) (define output-path (->output-path source-path))
;; 2) render the source file with template, if needed. ;; 2) Render the source file with template, if needed.
;; render is expensive, so we avoid it when we can. ;; Render is expensive, so we avoid it when we can.
;; Four conditions where we render: ;; Four conditions where we render:
(if (or force ; a) it's explicitly demanded (if (or force ; a) it's explicitly demanded
(not (file-exists? output-path)) ; b) output file does not exist (not (file-exists? output-path)) ; b) output file does not exist
@ -291,15 +297,18 @@
;; that represents the output of the operation. ;; that represents the output of the operation.
(parameterize ([current-namespace (make-base-empty-namespace)] (parameterize ([current-namespace (make-base-empty-namespace)]
[current-directory source-dir] [current-directory source-dir]
[current-output-port (open-output-nowhere)]) [current-output-port nowhere-port]
[current-error-port nowhere-port]) ; silent evaluation; exceptions still thrown
(namespace-require 'racket) ; use namespace-require for FIRST require, then eval after (namespace-require 'racket) ; use namespace-require for FIRST require, then eval after
(eval `(begin
;; for include-template (used below) ;; for include-template (used below)
(eval '(require web-server/templates) (current-namespace)) (require web-server/templates)
;; for ptree navigation functions, and template commands ;; for ptree navigation functions, and template commands
(eval '(require (planet mb/pollen/debug)(planet mb/pollen/ptree)(planet mb/pollen/template)) (current-namespace)) (require (planet mb/pollen/debug) (planet mb/pollen/ptree) (planet mb/pollen/template))
;; import source into eval space. This sets up main & metas ;; import source into eval space. This sets up main & metas
(eval `(require ,(path->string source-name)) (current-namespace)) (require ,(->string source-name))
(eval `(include-template #:command-char ,TEMPLATE_FIELD_DELIMITER ,(->string template-name)) (current-namespace)))) (include-template #:command-char ,TEMPLATE_FIELD_DELIMITER ,(->string template-name)))
(current-namespace))))
;; render files listed in a ptree file ;; render files listed in a ptree file
(define/contract (render-ptree-files ptree #:force [force #f]) (define/contract (render-ptree-files ptree #:force [force #f])

Loading…
Cancel
Save