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

csv: more permission parsing.

db4
John Benediktsson 2012-07-18 12:24:24 -07:00
parent 60927a7925
commit bf3dbde042
2 changed files with 27 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
basis/csv/csv-tests.factor
View File

@ -90,3 +90,12 @@ IN: csv.tests
] unit-test
[ { { "hello" "" "" "" "goodbye" "" } } ] [ "hello,,\"\",,goodbye," <string-reader> csv ] unit-test
{ { { "asd\"f\"" "asdf" } } } [ "asd\"f\",asdf" string>csv ] unit-test
{ { { "a\"sdf" "asdf" } } } [ "a\"sdf,asdf" string>csv ] unit-test
{ { { "as\"df" "asdf" } } } [ " as\"df,asdf" string>csv ] unit-test
{ { { "asd" "f" "asdf" } } } [ "\"as\"d,f,asdf" string>csv ] unit-test
{ { { "as,df" "asdf" } } } [ "\"as,\"df,asdf" string>csv ] unit-test
! FIXME: { { { "as,df" "asdf" } } } [ "\"as,\"df ,asdf" string>csv ] unit-test
! FIXME: { { { "asd\"f\"" "asdf" } } } [ "\"asd\"\"\"f\",asdf" string>csv ] unit-test
{ { { "as,d\"f" "asdf" } } } [ "\"as,\"d\"\"\"\"f,asdf" string>csv ] unit-test

33
basis/csv/csv.factor
View File

@ -16,38 +16,39 @@ CHAR: , delimiter set-global
MEMO: (field-end) ( delimiter -- delimiter' )
"\n" swap suffix ; inline
: skip-to-field-end ( -- endchar )
delimiter> (field-end) read-until nip ; inline
: field-end ( -- str sep )
delimiter> (field-end) read-until ; inline
DEFER: quoted-field
MEMO: (quoted-field) ( delimiter -- delimiter' )
"\"\n" swap suffix ; inline
: maybe-escaped-quote ( -- endchar )
: maybe-escaped-quote ( quoted? -- endchar )
read1 dup {
{ CHAR: " [ , quoted-field ] }
{ CHAR: " [ over [ , ] [ drop ] if quoted-field ] }
{ delimiter> [ ] }
{ CHAR: \n [ ] }
[ 2drop skip-to-field-end ]
} case ;
{ CHAR: \n [ ] } ! Error: newline inside string?
[ [ , f maybe-escaped-quote ] when ]
} case nip ;
: quoted-field ( -- endchar )
"\"" read-until
drop % maybe-escaped-quote ;
drop % t maybe-escaped-quote ;
: ?trim ( string -- string' )
dup { [ first blank? ] [ last blank? ] } 1||
[ [ blank? ] trim ] when ;
: field ( -- sep string )
delimiter> (quoted-field) read-until
dup CHAR: " = [
2drop [ quoted-field ] "" make
over empty?
[ 2drop [ quoted-field ] "" make ]
[ drop field-end [ "\"" glue ] dip swap ?trim ]
if
] [
swap [ "" ] [
dup {
[ first blank? ]
[ last blank? ]
} 1||
[ [ blank? ] trim ] when
] if-empty
swap [ "" ] [ ?trim ] if-empty
] if ;
: (row) ( -- sep )