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

furnace.utilities: use "header" word, some cleanup.

db4
John Benediktsson 2015-04-17 17:54:13 -07:00
parent 50725002be
commit a5339d48c8
1 changed files with 7 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
basis/furnace/utilities/utilities.factor
View File

@ -1,9 +1,9 @@
! Copyright (C) 2008, 2010 Slava Pestov. ! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: definitions namespaces make assocs sequences kernel classes splitting USING: accessors arrays assocs classes combinators continuations
words vocabs.loader accessors strings combinators arrays definitions fry http http.server http.server.redirection
continuations present fry urls http http.server xml.syntax xml.writer http.server.remapping io.pathnames kernel make namespaces
http.server.redirection http.server.remapping io.pathnames ; sequences splitting strings urls words xml.syntax ;
IN: furnace.utilities IN: furnace.utilities
: word>string ( word -- string ) : word>string ( word -- string )
@ -37,7 +37,7 @@ ERROR: no-such-responder responder ;
: resolve-base-path ( string -- string' ) : resolve-base-path ( string -- string' )
"$" ?head [ "$" ?head [
[ [
"/" split1 [ base-path [ "/" % % ] each "/" % ] dip % "/" split1 [ base-path [ "/" % % ] each "/" % ] dip %
] "" make ] "" make
] when ; ] when ;
@ -93,11 +93,11 @@ CONSTANT: nested-forms-key "__n"
: referrer ( -- referrer/f ) : referrer ( -- referrer/f )
#! Typo is intentional, it's in the HTTP spec! #! Typo is intentional, it's in the HTTP spec!
"referer" request get header>> at request get "referer" header
dup [ >url ensure-port [ remap-port ] change-port ] when ; dup [ >url ensure-port [ remap-port ] change-port ] when ;
: user-agent ( -- user-agent ) : user-agent ( -- user-agent )
"user-agent" request get header>> at "" or ; request get "user-agent" header "" or ;
: same-host? ( url -- ? ) : same-host? ( url -- ? )
dup [ dup [