calendar.format: parse rfc822 military and named timezones.

diff --git a/basis/calendar/format/format-tests.factor b/basis/calendar/format/format-tests.factor
index e5ae43c90f595a98d2fe44b16d841f45b3ed05af..9e18fbf6baa077512ccbb11d8b372ccfdcaf2c4b 100644 (file)
--- a/basis/calendar/format/format-tests.factor
+++ b/basis/calendar/format/format-tests.factor
@@ -37,6 +37,18 @@ kernel math.order sequences tools.test ;
     "-0500" parse-rfc822-gmt-offset
 ] unit-test
 
+{ T{ duration f 0 0 0 -1 0 0 } } [
+    "A" parse-rfc822-gmt-offset
+] unit-test
+
+{ T{ duration f 0 0 0 12 0 0 } } [
+    "Y" parse-rfc822-gmt-offset
+] unit-test
+j
+{ T{ duration f 0 0 0 -8 0 0 } } [
+    "PST" parse-rfc822-gmt-offset
+] unit-test
+
 { T{ timestamp f 2008 4 22 14 36 12 T{ duration f 0 0 0 0 0 0 } } } [
     "Tue, 22 Apr 2008 14:36:12 GMT" rfc822>timestamp
 ] unit-test

diff --git a/basis/calendar/format/format.factor b/basis/calendar/format/format.factor
index f5c799365c73b65afadb0caa2f159c96141c4195..602341bcb0f84e22e1c5d740325de25ef9a32700 100644 (file)
--- a/basis/calendar/format/format.factor
+++ b/basis/calendar/format/format.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2008, 2010 Slava Pestov, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays calendar calendar.format.macros
+USING: accessors arrays assocs calendar calendar.format.macros
 combinators io io.streams.string kernel math math.functions
 math.order math.parser math.parser.private present sequences
 typed ;
@@ -212,12 +212,34 @@ ERROR: invalid-timestamp-format ;
 : checked-number ( str -- n )
     string>number check-timestamp ;
 
+CONSTANT: rfc822-named-zones H{
+    { "EST" -5 }
+    { "EDT" -4 }
+    { "CST" -6 }
+    { "CDT" -5 }
+    { "MST" -7 }
+    { "MDT" -6 }
+    { "PST" -8 }
+    { "PDT" -7 }
+}
+
+: parse-rfc822-military-offset ( string -- dt )
+    first CHAR: A - {
+        -1 -2 -3 -4 -5 -6 -7 -8 -9 f -10 -11 -12
+        1 2 3 4 5 6 7 8 9 10 11 12 0
+    } nth hours ;
+
 : parse-rfc822-gmt-offset ( string -- dt )
-    dup { "UTC" "GMT" } member? [ drop instant ] [
-        unclip [
-            2 cut [ string>number ] bi@ [ hours ] [ minutes ] bi* time+
-        ] dip signed-gmt-offset
-    ] if ;
+    {
+        { [ dup { "UTC" "GMT" } member? ] [ drop instant ] }
+        { [ dup length 1 = ] [ parse-rfc822-military-offset ] }
+        { [ dup rfc822-named-zones key? ] [ rfc822-named-zones at hours ] }
+        [
+            unclip [
+                2 cut [ string>number ] bi@ [ hours ] [ minutes ] bi* time+
+            ] dip signed-gmt-offset
+        ]
+    } cond ;
 
 : (rfc822>timestamp) ( -- timestamp )
     timestamp new