steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Add RFC822 date parser

db4
Slava Pestov 2008-04-22 20:19:54 -05:00
parent decdaf1e32
commit 6afa62b57c
6 changed files with 124 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
extra/calendar/calendar-tests.factor
View File

@ -2,6 +2,10 @@ USING: arrays calendar kernel math sequences tools.test
continuations system ; continuations system ;
IN: calendar.tests IN: calendar.tests
\ time+ must-infer
\ time* must-infer
\ time- must-infer
[ f ] [ 2004 12 32 0 0 0 instant <timestamp> valid-timestamp? ] unit-test [ f ] [ 2004 12 32 0 0 0 instant <timestamp> valid-timestamp? ] unit-test
[ f ] [ 2004 2 30 0 0 0 instant <timestamp> valid-timestamp? ] unit-test [ f ] [ 2004 2 30 0 0 0 instant <timestamp> valid-timestamp? ] unit-test
[ f ] [ 2003 2 29 0 0 0 instant <timestamp> valid-timestamp? ] unit-test [ f ] [ 2003 2 29 0 0 0 instant <timestamp> valid-timestamp? ] unit-test

35
extra/calendar/calendar.factor
View File

@ -211,12 +211,14 @@ M: duration time+
#! Uses average month/year length since dt loses calendar #! Uses average month/year length since dt loses calendar
#! data #! data
0 swap 0 swap
[ year>> + ] keep {
[ month>> months-per-year / + ] keep [ year>> + ]
[ day>> days-per-year / + ] keep [ month>> months-per-year / + ]
[ hour>> hours-per-year / + ] keep [ day>> days-per-year / + ]
[ minute>> minutes-per-year / + ] keep [ hour>> hours-per-year / + ]
second>> seconds-per-year / + ; [ minute>> minutes-per-year / + ]
[ second>> seconds-per-year / + ]
} cleave ;
M: duration <=> [ dt>years ] compare ; M: duration <=> [ dt>years ] compare ;
@ -252,14 +254,21 @@ M: timestamp time-
#! Exact calendar-time difference #! Exact calendar-time difference
(time-) seconds ; (time-) seconds ;
: time* ( obj1 obj2 -- obj3 )
dup real? [ swap ] when
dup real? [ * ] [
{
[ year>> * ]
[ month>> * ]
[ day>> * ]
[ hour>> * ]
[ minute>> * ]
[ second>> * ]
} 2cleave <duration>
] if ;
: before ( dt -- -dt ) : before ( dt -- -dt )
[ year>> neg ] keep -1 time* ;
[ month>> neg ] keep
[ day>> neg ] keep
[ hour>> neg ] keep
[ minute>> neg ] keep
second>> neg
<duration> ;
M: duration time- M: duration time-
before time+ ; before time+ ;

33
extra/calendar/format/format-tests.factor
View File

@ -1,26 +1,45 @@
USING: calendar.format calendar kernel tools.test USING: calendar.format calendar kernel math tools.test
io.streams.string ; io.streams.string accessors io ;
IN: calendar.format.tests IN: calendar.format.tests
[ 0 ] [ [ 0 ] [
"Z" [ read-rfc3339-gmt-offset ] with-string-reader "Z" [ read1 read-rfc3339-gmt-offset ] with-string-reader dt>hours
] unit-test ] unit-test
[ 1 ] [ [ 1 ] [
"+01" [ read-rfc3339-gmt-offset ] with-string-reader "+01" [ read1 read-rfc3339-gmt-offset ] with-string-reader dt>hours
] unit-test ] unit-test
[ -1 ] [ [ -1 ] [
"-01" [ read-rfc3339-gmt-offset ] with-string-reader "-01" [ read1 read-rfc3339-gmt-offset ] with-string-reader dt>hours
] unit-test ] unit-test
[ -1-1/2 ] [ [ -1-1/2 ] [
"-01:30" [ read-rfc3339-gmt-offset ] with-string-reader "-01:30" [ read1 read-rfc3339-gmt-offset ] with-string-reader dt>hours
] unit-test ] unit-test
[ 1+1/2 ] [ [ 1+1/2 ] [
"+01:30" [ read-rfc3339-gmt-offset ] with-string-reader "+01:30" [ read1 read-rfc3339-gmt-offset ] with-string-reader dt>hours
] unit-test ] unit-test
[ ] [ now timestamp>rfc3339 drop ] unit-test [ ] [ now timestamp>rfc3339 drop ] unit-test
[ ] [ now timestamp>rfc822 drop ] unit-test [ ] [ now timestamp>rfc822 drop ] unit-test
[ 8/1000 -4 ] [
"2008-04-19T04:56:00.008-04:00" rfc3339>timestamp
[ second>> ] [ gmt-offset>> hour>> ] bi
] unit-test
[ T{ duration f 0 0 0 0 0 0 } ] [
"GMT" parse-rfc822-gmt-offset
] unit-test
[ T{ duration f 0 0 0 -5 0 0 } ] [
"-0500" 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
[ t ] [ now dup timestamp>rfc822 rfc822>timestamp time- 1 seconds before? ] unit-test

100
extra/calendar/format/format.factor
View File

@ -1,5 +1,6 @@
USING: math math.parser kernel sequences io calendar USING: math math.parser kernel sequences io calendar
accessors arrays io.streams.string combinators accessors ; accessors arrays io.streams.string splitting
combinators accessors debugger ;
IN: calendar.format IN: calendar.format
GENERIC: day. ( obj -- ) GENERIC: day. ( obj -- )
@ -58,11 +59,11 @@ M: timestamp year. ( timestamp -- )
[ hour>> write-00 ] [ minute>> write-00 ] bi ; [ hour>> write-00 ] [ minute>> write-00 ] bi ;
: write-gmt-offset ( gmt-offset -- ) : write-gmt-offset ( gmt-offset -- )
dup instant <=> { dup instant <=> sgn {
{ [ dup 0 = ] [ 2drop "GMT" write ] } { 0 [ drop "GMT" write ] }
{ [ dup 0 < ] [ drop "-" write before (write-gmt-offset) ] } { -1 [ "-" write before (write-gmt-offset) ] }
{ [ dup 0 > ] [ drop "+" write (write-gmt-offset) ] } { 1 [ "+" write (write-gmt-offset) ] }
} cond ; } case ;
: timestamp>rfc822 ( timestamp -- str ) : timestamp>rfc822 ( timestamp -- str )
#! RFC822 timestamp format #! RFC822 timestamp format
@ -83,20 +84,22 @@ M: timestamp year. ( timestamp -- )
[ minute>> write-00 ] bi ; [ minute>> write-00 ] bi ;
: write-rfc3339-gmt-offset ( duration -- ) : write-rfc3339-gmt-offset ( duration -- )
dup instant <=> { dup instant <=> sgn {
{ [ dup 0 = ] [ 2drop "Z" write ] } { 0 [ drop "Z" write ] }
{ [ dup 0 < ] [ drop CHAR: - write1 before (write-rfc3339-gmt-offset) ] } { -1 [ CHAR: - write1 before (write-rfc3339-gmt-offset) ] }
{ [ dup 0 > ] [ drop CHAR: + write1 (write-rfc3339-gmt-offset) ] } { 1 [ CHAR: + write1 (write-rfc3339-gmt-offset) ] }
} cond ; } case ;
: (timestamp>rfc3339) ( timestamp -- ) : (timestamp>rfc3339) ( timestamp -- )
dup year>> number>string write CHAR: - write1 {
dup month>> write-00 CHAR: - write1 [ year>> number>string write CHAR: - write1 ]
dup day>> write-00 CHAR: T write1 [ month>> write-00 CHAR: - write1 ]
dup hour>> write-00 CHAR: : write1 [ day>> write-00 CHAR: T write1 ]
dup minute>> write-00 CHAR: : write1 [ hour>> write-00 CHAR: : write1 ]
dup second>> >fixnum write-00 [ minute>> write-00 CHAR: : write1 ]
gmt-offset>> write-rfc3339-gmt-offset ; [ second>> >fixnum write-00 ]
[ gmt-offset>> write-rfc3339-gmt-offset ]
} cleave ;
: timestamp>rfc3339 ( timestamp -- str ) : timestamp>rfc3339 ( timestamp -- str )
[ (timestamp>rfc3339) ] with-string-writer ; [ (timestamp>rfc3339) ] with-string-writer ;
@ -106,14 +109,20 @@ M: timestamp year. ( timestamp -- )
: read-00 2 read string>number ; : read-00 2 read string>number ;
: read-000 3 read string>number ;
: read-0000 4 read string>number ; : read-0000 4 read string>number ;
: read-rfc3339-gmt-offset ( -- n ) : signed-gmt-offset ( dt ch -- dt' )
read1 dup CHAR: Z = [ drop 0 ] [ { { CHAR: + [ 1 ] } { CHAR: - [ -1 ] } } case time* ;
{ { CHAR: + [ 1 ] } { CHAR: - [ -1 ] } } case
read-00 : read-rfc3339-gmt-offset ( ch -- dt )
read1 { { CHAR: : [ read-00 ] } { f [ 0 ] } } case dup CHAR: Z = [ drop instant ] [
60 / + * >r
read-00 hours
read1 { { CHAR: : [ read-00 ] } { f [ 0 ] } } case minutes
time+
r> signed-gmt-offset
] if ; ] if ;
: read-ymd ( -- y m d ) : read-ymd ( -- y m d )
@ -126,26 +135,61 @@ M: timestamp year. ( timestamp -- )
read-ymd read-ymd
"Tt" expect "Tt" expect
read-hms read-hms
read-rfc3339-gmt-offset ! timezone read1 { { CHAR: . [ read-000 1000 / + read1 ] } [ ] } case
read-rfc3339-gmt-offset
<timestamp> ; <timestamp> ;
: rfc3339>timestamp ( str -- timestamp ) : rfc3339>timestamp ( str -- timestamp )
[ (rfc3339>timestamp) ] with-string-reader ; [ (rfc3339>timestamp) ] with-string-reader ;
ERROR: invalid-rfc822-date ;
: check-rfc822-date ( obj/f -- obj ) [ invalid-rfc822-date ] unless* ;
: read-token ( seps -- token )
[ read-until ] keep member? check-rfc822-date drop ;
: read-sp ( -- token ) " " read-token ;
: checked-number ( str -- n )
string>number check-rfc822-date ;
: parse-rfc822-gmt-offset ( string -- dt )
dup "GMT" = [ drop instant ] [
unclip >r
2 cut [ string>number ] bi@ [ hours ] [ minutes ] bi* time+
r> signed-gmt-offset
] if ;
: (rfc822>timestamp) ( -- timestamp )
timestamp new
"," read-token day-abbreviations3 member? check-rfc822-date drop
read1 CHAR: \s assert=
read-sp checked-number >>day
read-sp month-abbreviations index check-rfc822-date >>month
read-sp checked-number >>year
":" read-token checked-number >>hour
":" read-token checked-number >>minute
" " read-token checked-number >>second
readln parse-rfc822-gmt-offset >>gmt-offset ;
: rfc822>timestamp ( str -- timestamp )
[ (rfc822>timestamp) ] with-string-reader ;
: (ymdhms>timestamp) ( -- timestamp ) : (ymdhms>timestamp) ( -- timestamp )
read-ymd " " expect read-hms 0 <timestamp> ; read-ymd " " expect read-hms instant <timestamp> ;
: ymdhms>timestamp ( str -- timestamp ) : ymdhms>timestamp ( str -- timestamp )
[ (ymdhms>timestamp) ] with-string-reader ; [ (ymdhms>timestamp) ] with-string-reader ;
: (hms>timestamp) ( -- timestamp ) : (hms>timestamp) ( -- timestamp )
f f f read-hms f <timestamp> ; f f f read-hms instant <timestamp> ;
: hms>timestamp ( str -- timestamp ) : hms>timestamp ( str -- timestamp )
[ (hms>timestamp) ] with-string-reader ; [ (hms>timestamp) ] with-string-reader ;
: (ymd>timestamp) ( -- timestamp ) : (ymd>timestamp) ( -- timestamp )
read-ymd f f f f <timestamp> ; read-ymd f f f instant <timestamp> ;
: ymd>timestamp ( str -- timestamp ) : ymd>timestamp ( str -- timestamp )
[ (ymd>timestamp) ] with-string-reader ; [ (ymd>timestamp) ] with-string-reader ;

0
extra/webapps/planet/blog-summary.xml → extra/webapps/planet/blog-admin-link.xml
View File

0
extra/webapps/planet/mini-planet.xml → extra/webapps/planet/postings-summary.xml
View File