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
|
|
|
|
2004-10-10 14:28:56 -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 -- )
|
2005-03-05 16:33:40 -05:00
|
|
|
2dup string-length 2 - >= [
|
2004-07-16 02:26:21 -04:00
|
|
|
2drop
|
|
|
|
] [
|
2004-12-29 03:35:46 -05:00
|
|
|
>r 1 + dup 2 + r> substring catch-hex> [ , ] when*
|
2004-07-16 02:26:21 -04:00
|
|
|
] ifte ;
|
|
|
|
|
|
|
|
: url-decode-% ( index str -- index str )
|
2004-10-06 23:34:22 -04:00
|
|
|
2dup url-decode-hex >r 3 + r> ;
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2004-10-06 23:34:22 -04:00
|
|
|
: url-decode-+-or-other ( index str ch -- index str )
|
2004-12-29 03:35:46 -05:00
|
|
|
dup CHAR: + = [ drop CHAR: \s ] when , >r 1 + r> ;
|
2004-07-16 02:26:21 -04:00
|
|
|
|
|
|
|
: url-decode-iter ( index str -- )
|
2005-03-05 16:33:40 -05:00
|
|
|
2dup string-length >= [
|
2004-07-16 02:26:21 -04:00
|
|
|
2drop
|
|
|
|
] [
|
2005-03-05 16:33:40 -05:00
|
|
|
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 )
|
2004-11-11 15:15:43 -05:00
|
|
|
[ 0 swap url-decode-iter ] make-string ;
|