calendar.format: parse rfc822 military and named timezones.

char-rename
John Benediktsson 2016-12-31 13:50:08 -08:00
parent 556a2b2b5b
commit 4e9ad6ada7
2 changed files with 40 additions and 6 deletions

View File

@ -37,6 +37,18 @@ kernel math.order sequences tools.test ;
"-0500" parse-rfc822-gmt-offset "-0500" parse-rfc822-gmt-offset
] unit-test ] 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 } } } [ { 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 "Tue, 22 Apr 2008 14:36:12 GMT" rfc822>timestamp
] unit-test ] unit-test

View File

@ -1,6 +1,6 @@
! Copyright (C) 2008, 2010 Slava Pestov, Doug Coleman. ! Copyright (C) 2008, 2010 Slava Pestov, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! 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 combinators io io.streams.string kernel math math.functions
math.order math.parser math.parser.private present sequences math.order math.parser math.parser.private present sequences
typed ; typed ;
@ -212,12 +212,34 @@ ERROR: invalid-timestamp-format ;
: checked-number ( str -- n ) : checked-number ( str -- n )
string>number check-timestamp ; 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 ) : parse-rfc822-gmt-offset ( string -- dt )
dup { "UTC" "GMT" } member? [ drop instant ] [ {
unclip [ { [ dup { "UTC" "GMT" } member? ] [ drop instant ] }
2 cut [ string>number ] bi@ [ hours ] [ minutes ] bi* time+ { [ dup length 1 = ] [ parse-rfc822-military-offset ] }
] dip signed-gmt-offset { [ dup rfc822-named-zones key? ] [ rfc822-named-zones at hours ] }
] if ; [
unclip [
2 cut [ string>number ] bi@ [ hours ] [ minutes ] bi* time+
] dip signed-gmt-offset
]
} cond ;
: (rfc822>timestamp) ( -- timestamp ) : (rfc822>timestamp) ( -- timestamp )
timestamp new timestamp new