Times rendered using unlib/date.ss; added .externals, build.ss and autoplanet.ss.

Author: Dave Gurnell

.externals

@@ -0,0 +1,7 @@
+[.]
+scm = svn
+
+[planetdev/unlib]
+path = planetdev/unlib
+repository = http://svn.untyped.com/unlib/trunk/src
+scm = svn

autoplanet.ss

@@ -0,0 +1,11 @@
+#lang scheme
+
+(require scheme/runtime-path
+         (planet untyped/autoplanet:1))
+
+(define-runtime-path dev-path
+  "planetdev")
+
+(remove-hard-links)
+
+(install-local "owner" "unlib.plt" 3 99 (build-path dev-path "unlib"))

base.ss

@@ -8,15 +8,13 @@
 (define-library-aliases javascript (planet dherman/javascript:9:2)  #:provide)
 (define-library-aliases pprint     (planet dherman/pprint:4)        #:provide)
 (define-library-aliases schemeunit (planet schematics/schemeunit:3) #:provide)
-(define-library-aliases spgsql     (planet schematics/spgsql:2)     #:provide)
-(define-library-aliases unlib      (planet untyped/unlib:3:13)      #:provide)
+(define-library-aliases unlib      (planet untyped/unlib:3)         #:provide)
 
 (require net/url
          scheme/contract
          scheme/match
-         srfi/19
          srfi/26
-         (except-in (unlib-in debug exn time) time-utc->string time-tai->string))
+         (unlib-in debug exn date))
 
 ; Configuration --------------------------------
 
@@ -52,7 +50,7 @@
                        scheme/contract
                        scheme/match
                        srfi/26)
-         (unlib-out debug exn time))
+         (unlib-out debug exn date))
 
 (provide/contract
  [quote-case-restriction  (parameter/c (or/c 'lower 'upper))]

build.ss

@@ -0,0 +1,56 @@
+#!/usr/bin/env mzscheme -q
+#lang scheme
+
+(require scheme/runtime-path
+         scheme/system)
+
+; Configuration ----------------------------------
+
+; string
+(define plt-version "4.2.1.5")
+
+; path
+(define-runtime-path planet-path "planet")
+
+; Tasks ------------------------------------------
+
+(define (env)
+  (putenv "PLTVERSION" plt-version)
+  (putenv "PLTPLANETDIR" (path->string planet-path)))
+
+(define (autoplanet)
+  (env)
+  (system "mzscheme autoplanet.ss"))
+
+(define (envvars)
+  (autoplanet)
+  (let ([path (make-temporary-file "mzscheme-envvars-~a.sh")])
+    (with-output-to-file path
+      (lambda ()
+        (printf #<<ENDSCRIPT
+export PLTVERSION=~a
+export PLTPLANETDIR="~a"
+
+ENDSCRIPT
+                plt-version
+                (path->string planet-path)))
+      #:exists 'replace)
+    (display (path->string path))))
+
+(define (compile)
+  (autoplanet)
+  (system "mzc -v main.ss"))
+
+(define (test-compile)
+  (autoplanet)
+  (system "mzc -v run-tests.ss"))
+
+(define (test)
+  (test-compile)
+  (system "mzscheme run-tests.ss"))
+
+(match (vector-ref (current-command-line-arguments) 0)
+  ["envvars"         (envvars)]
+  ["compile"         (compile)]
+  ["test-compile"    (test-compile)]
+  ["test"            (test)])

csv/render-test.ss

@@ -2,14 +2,18 @@
 
 (require "../test-base.ss")
 
-(require srfi/19
-         "render.ss"
+(require "render.ss"
          "struct.ss")
 
 ; Helpers ----------------------------------------
 
-(define utc-date (date->time-utc (make-date 0 56 34 12 01 02 2003 0)))
-(define tai-date (date->time-tai (make-date 0 56 34 12 01 02 2003 0)))
+; GMT:
+(define utc-winter-date (date->time-utc (make-date 0 56 34 12 01 02 2003)))
+(define tai-winter-date (date->time-tai (make-date 0 56 34 12 01 02 2003)))
+
+; BST:
+(define utc-summer-date (date->time-utc (make-date 0 56 34 12 01 07 2003)))
+(define tai-summer-date (date->time-tai (make-date 0 56 34 12 01 07 2003)))
 
 ; Tests ------------------------------------------
 
@@ -28,10 +32,16 @@
       (check-equal? (csv->string (cell #"bytes"))                 "\"bytes\"")
       (check-equal? (csv->string (cell (string->url "/u/r/l")))   "\"/u/r/l\"")
       (check-equal? (csv->string (cell "\"string\" with quotes")) "\"\"\"string\"\" with quotes\"")
-      ; These checks give different results depending on your time zone and DST settings:
-      (let ([hour (+ 12 (floor (/ (current-time-zone-offset) (* 60 60))))])
-        (check-equal? (csv->string (cell utc-date)) (format "\"2003-02-01 ~a:34:56\"" hour))
-        (check-equal? (csv->string (cell tai-date)) (format "\"2003-02-01 ~a:34:56\"" hour))))
+      ; Times are rendered in the correct immediate time zone:
+      (check-equal? (csv->string (cell utc-winter-date)) "\"2003-02-01 12:34:56\"" "time-utc (GMT)")
+      (check-equal? (csv->string (cell tai-winter-date)) "\"2003-02-01 12:34:56\"" "time-utc (GMT)")
+      (check-equal? (csv->string (cell utc-summer-date)) "\"2003-07-01 12:34:56\"" "time-utc (BST)")
+      (check-equal? (csv->string (cell tai-summer-date)) "\"2003-07-01 12:34:56\"" "time-utc (BST)")
+      (parameterize ([current-tz "PST8PDT"])
+        (check-equal? (csv->string (cell utc-winter-date)) "\"2003-02-01 04:34:56\"" "time-utc (PST)")
+        (check-equal? (csv->string (cell tai-winter-date)) "\"2003-02-01 04:34:56\"" "time-utc (PST)")
+        (check-equal? (csv->string (cell utc-summer-date)) "\"2003-07-01 04:34:56\"" "time-utc (PDT)")
+        (check-equal? (csv->string (cell tai-summer-date)) "\"2003-07-01 04:34:56\"" "time-utc (PDT)")))
 
     (test-equal? "single row"
       (csv->string (row (cell 1) (cell "2") (cell 3)))

info.ss

@@ -7,7 +7,7 @@
 
 (define release-notes
   '((p "Changes and additions:")
-    (ul (li "nothing as yet..."))))
+    (ul (li "time rendering is based off of unlib/date.ss: times are rendered in daylight saving time for the current locale (as set by current-tz from bzlib/date-tz.plt)."))))
 
 (define primary-file "mirrors.ss")
 
@@ -21,6 +21,10 @@
 
 (define repositories '("4.x"))
 
-(define compile-omit-files '("sql"))
+(define compile-omit-files
+  '("autoplanet.ss"
+    "build.ss"
+    "planet"
+    "planetdev"))
 
 

javascript/lang.ss

@@ -1,8 +1,8 @@
-#lang scheme/base
+#lang scheme
 
-(require (only-in srfi/1 drop-right take-right)
-         "../base.ss"
-         "op-util.ss"
+(require "../base.ss")
+
+(require "op-util.ss"
          "quote.ss"
          "struct.ss")
 

javascript/op-util-internal.ss

@@ -1,15 +1,24 @@
-#lang scheme/base
+#lang scheme
 
-(require "../base.ss"
-         (for-template scheme/base
-                       "../base.ss"))
+(require "../base.ss")
 
 (require (only-in srfi/1 append-map iota make-list)
          srfi/26
          (unlib-in syntax)
          "op.ss"
-         (for-template (only-in srfi/1 drop-right take-right)
+         (for-template (except-in scheme/base
+                                  make-date
+                                  date?
+                                  date-year
+                                  date-month
+                                  date-day
+                                  date-week-day
+                                  date-hour
+                                  date-minute
+                                  date-second)
+                       scheme/list
                        (unlib-in syntax)
+                       "../base.ss"
                        "struct.ss"
                        "quote.ss"))
 

javascript/op-util.ss

@@ -1,9 +1,9 @@
-#lang scheme/base
+#lang scheme
 
-(require (for-syntax scheme/base
-                     "op-util-internal.ss"
+(require "../base.ss")
+
+(require (for-syntax "op-util-internal.ss"
                      "op.ss")
-         scheme/contract
          "struct.ss")
 
 ; Syntax -----------------------------------------

javascript/sexp/module.ss

@@ -1,8 +1,9 @@
 #lang scheme/base
 
+(require "../../base.ss")
+
 (require (for-syntax scheme/base
-                     (planet untyped/unlib:3/debug)
-                     (planet untyped/unlib:3/syntax))
+                     (unlib-in debug syntax))
          "../javascript.ss"
          "../javascript-registry.ss")
 

javascript/syntax-test.ss

@@ -1,9 +1,7 @@
-#lang scheme/base
+#lang scheme
 
-(require (for-syntax scheme/base
-                     "../test-base.ss"
+(require (for-syntax "../test-base.ss"
                      "syntax-internal.ss")
-         (prefix-in scheme: scheme/pretty)
          srfi/13
          "../test-base.ss"
          "expander.ss"

javascript/syntax.ss

@@ -1,9 +1,8 @@
-#lang scheme/base
+#lang scheme
 
 (require "../base.ss")
 
-(require (for-syntax scheme/base
-                     "../base.ss"
+(require (for-syntax "../base.ss"
                      "syntax-internal.ss"))
 
 ; Lowercase --------------------------------------

plain/render.ss

@@ -2,8 +2,6 @@
 
 (require "../base.ss")
 
-(require srfi/19)
-
 ; quotable-value [boolean] -> string
 (define (quotable-value->string val [pretty? #t])
   (cond [(string? val)     val]

scribblings/mirrors.scrbl

@@ -1,6 +1,11 @@
 #lang scribble/doc
 
-@(require (file "base.ss"))
+@(require "base.ss")
+
+@(require (for-label srfi/19
+                     (only-in (planet bzlib/date-tz)
+                              current-tz
+                              tz-names)))
 
 @title{@bold{Mirrors}: Programmatic Assembly of XML, Javascript and CSV Data}
 
@@ -10,13 +15,23 @@ Dave Gurnell
 
 @italic{Mirrors} is a collection of macro-based syntaxes for rendering content for web applications. The library currently supports the rendering of XML (including browser-compatible XHTML), Javascript 1.5 and CSV data. Future support is planned for CSS level 3.
 
+@bold{Important: changes to time rendering in Mirrors 2.4:}
+
+Mirrors 2.4 makes a subtle change in the way SRFI 19 times are rendered in XML and CSV output. The old behaviour was to use SRFI 19's @scheme[time-utc->date] and @scheme[time-tai->date] functions to convert the time to a @scheme[date], and then use @scheme[date->string] to render the date as a string.
+
+The disadvantage of that approach is the original approach is that it always creates dates according to the @italic{current} time zone offset. This means that, for example, @scheme[time-utc]@schemeidfont{s} representing timestamps in the middle of winter, can be rendered using daylight saving time if your application is running in the middle of Summer.
+
+Mirrors' new approach is to use the wrapped time/date handling functions from @scheme[(planet untyped/unlib/date)]. This module, which is essentially a wrapper for @scheme[(planet bzlib/date-tz)], converts times to dates using the immediate time zone for the current @italic{locale}. Winter times will always be rendered using a winter time zone offset, and summer times will always be rendered using a summer time zone offset.
+
+The default locale is @scheme["GB"] but it can be overridden using the @scheme[current-tz] parameter. A complete list of locales can be obtained using the @scheme[tz-names] procedure. Both of these forms are provided by @scheme[(planet bzlib/date-tz)] and reprovided by @scheme[(planet untyped/unlib/date)].
+
 @include-section{xml.scrbl}
 @include-section{javascript.scrbl}
 @include-section{csv.scrbl}
 @include-section{plain.scrbl}
 
 @section{Acknowledgements}
 
-Many thanks to Dave Herman for Javascript.plt and PPrint.plt, both of which are used extensively in Mirrors.
+Many thanks to Dave Herman for @scheme[(planet dherman/javascript)] and @scheme[(planet dherman/pprint)], both of which are used extensively in Mirrors.
 
 Thanks also to the following for their contributions: David Brooks, Matt Jadud, Fausto LS, Jay McCarthy, Karsten Patzwaldt and Noel Welsh.

xml/render-test.ss

@@ -1,13 +1,10 @@
 #lang scheme/base
 
-(require (for-syntax scheme/base)
-         "../test-base.ss")
+(require "../test-base.ss")
 
-(require (for-syntax "syntax-prerender.ss"
+(require (for-syntax scheme/base
+                     "syntax-prerender.ss"
                      "syntax-expand.ss")
-         srfi/19
-         (unlib-in time)
-         "../test-base.ss"
          "../javascript/javascript.ss"
          "expander.ss"
          "render.ss"
@@ -20,8 +17,14 @@
 (define url2     (string->url "http://www.example.com?a=b&c=d"))
 (define text     "Text")
 (define sym      'symbol)
-(define utc-date (date->time-utc (make-date 0 56 34 12 01 02 2003 0)))
-(define tai-date (date->time-tai (make-date 0 56 34 12 01 02 2003 0)))
+
+; GMT:
+(define utc-winter-date (date->time-utc (make-date 0 56 34 12 01 02 2003)))
+(define tai-winter-date (date->time-tai (make-date 0 56 34 12 01 02 2003)))
+
+; BST:
+(define utc-summer-date (date->time-utc (make-date 0 56 34 12 01 07 2003)))
+(define tai-summer-date (date->time-tai (make-date 0 56 34 12 01 07 2003)))
 
 (define-xml-syntax (!wrap expr1 expr2)
   (xml expr1 expr2 expr1))
@@ -44,16 +47,22 @@
   (test-suite "render.ss"
 
     (test-case "literals"
-      (check-xml #t            "yes"                                "true")
-      (check-xml #f            ""                                   "false")
-      (check-xml 12345         "12345"                              "number")
-      (check-xml "blah &\"<>"  "blah &amp;&quot;&lt;&gt;"           "string")
-      (check-xml 'blah\&\"<>   "blah&amp;&quot;&lt;&gt;"            "symbol")
-      (check-xml #"blah &\"<>" "blah &amp;&quot;&lt;&gt;"           "bytes")
-      ; These checks give different results depending on your time zone and DST settings:
-      (let ([hour (+ 12 (floor (/ (current-time-zone-offset) (* 60 60))))])
-        (check-xml ,utc-date (format "2003-02-01 ~a:34:56" hour)    "time-utc")
-        (check-xml ,tai-date (format "2003-02-01 ~a:34:56" hour)    "time-tai")))
+      (check-xml #t               "yes"                      "true")
+      (check-xml #f               ""                         "false")
+      (check-xml 12345            "12345"                    "number")
+      (check-xml "blah &\"<>"     "blah &amp;&quot;&lt;&gt;" "string")
+      (check-xml 'blah\&\"<>      "blah&amp;&quot;&lt;&gt;"  "symbol")
+      (check-xml #"blah &\"<>"    "blah &amp;&quot;&lt;&gt;" "bytes")
+      ; Times are rendered in the correct immediate time zone:
+      (check-xml ,utc-winter-date "2003-02-01 12:34:56" "time-utc (GMT)")
+      (check-xml ,tai-winter-date "2003-02-01 12:34:56" "time-tai (GMT)")
+      (check-xml ,utc-summer-date "2003-07-01 12:34:56" "time-utc (BST)")
+      (check-xml ,tai-summer-date "2003-07-01 12:34:56" "time-tai (BST)")
+      (parameterize ([current-tz "PST8PDT"])
+        (check-xml ,utc-winter-date "2003-02-01 04:34:56" "time-utc (PST)")
+        (check-xml ,tai-winter-date "2003-02-01 04:34:56" "time-tai (PST)")
+        (check-xml ,utc-summer-date "2003-07-01 04:34:56" "time-utc (PDT)")
+        (check-xml ,tai-summer-date "2003-07-01 04:34:56" "time-tai (PDT)")))
 
     (test-case "raw"
       (check-xml (!raw "&\"<>") "&\"<>"                          "string")

xml/syntax-expand-test.ss

@@ -2,8 +2,7 @@
 
 (require "../test-base.ss")
 
-(require srfi/19
-         "struct.ss"
+(require "struct.ss"
          "syntax.ss"
          "syntax-expand.ss")
 
@@ -12,8 +11,8 @@
 (define test-url "http://www.example.com")
 (define text     "Text")
 (define sym      'symbol)
-(define utc-date (date->time-utc (make-date 0 56 34 12 01 02 2003 0)))
-(define tai-date (date->time-tai (make-date 0 56 34 12 01 02 2003 0)))
+(define utc-date (date->time-utc (make-date 0 56 34 12 01 02 2003)))
+(define tai-date (date->time-tai (make-date 0 56 34 12 01 02 2003)))
 
 ; Tests ------------------------------------------