factor/library/httpd/url-encoding.factor

48 lines
1.2 KiB
Factor
Raw Normal View History

2005-04-19 20:28:01 -04:00
! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
2004-07-16 02:26:21 -04:00
IN: url-encoding
2005-04-19 20:28:01 -04:00
USING: errors kernel math namespaces parser sequences strings
unparser ;
2004-07-16 02:26:21 -04:00
: url-encode ( str -- str )
[
2005-04-19 20:28:01 -04:00
[
dup url-quotable? [
,
] [
CHAR: % , >hex 2 CHAR: 0 pad %
] ifte
] seq-each
] make-string ;
2004-07-16 02:26:21 -04:00
: catch-hex> ( str -- n )
#! Push f if string is not a valid hex literal.
[ hex> ] [ [ drop f ] when ] catch ;
2004-07-16 02:26:21 -04:00
: url-decode-hex ( index str -- )
2dup string-length 2 - >= [
2004-07-16 02:26:21 -04:00
2drop
] [
>r 1 + dup 2 + r> substring catch-hex> [ , ] when*
2004-07-16 02:26:21 -04:00
] ifte ;
: url-decode-% ( index str -- index str )
2dup url-decode-hex >r 3 + r> ;
2004-07-16 02:26:21 -04:00
: url-decode-+-or-other ( index str ch -- index str )
dup CHAR: + = [ drop CHAR: \s ] when , >r 1 + r> ;
2004-07-16 02:26:21 -04:00
: url-decode-iter ( index str -- )
2dup string-length >= [
2004-07-16 02:26:21 -04:00
2drop
] [
2dup string-nth dup CHAR: % = [
2004-07-16 02:26:21 -04:00
drop url-decode-%
] [
url-decode-+-or-other
] ifte url-decode-iter
] ifte ;
: url-decode ( str -- str )
[ 0 swap url-decode-iter ] make-string ;