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

http.server.static, html table listings

char-rename
Jon Harper 2016-06-22 23:20:48 +02:00
parent 5345e32b84
commit 679abfa5d7
1 changed files with 46 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
basis/http/server/static/static.factor
View File

@ -9,7 +9,7 @@ sorting logging calendar.format accessors splitting io io.files
io.files.info io.directories io.pathnames io.encodings.binary io.files.info io.directories io.pathnames io.encodings.binary
fry xml.entities destructors urls html xml.syntax fry xml.entities destructors urls html xml.syntax
html.templates.fhtml http http.server http.server.responses html.templates.fhtml http http.server http.server.responses
http.server.redirection xml.writer ; http.server.redirection xml.writer locals ;
QUALIFIED: sets QUALIFIED: sets
TUPLE: file-responder root hook special index-names allow-listings ; TUPLE: file-responder root hook special index-names allow-listings ;
@ -58,18 +58,54 @@ TUPLE: file-responder root hook special index-names allow-listings ;
\ serve-file NOTICE add-input-logging \ serve-file NOTICE add-input-logging
:: file-html-template ( href size modified -- xml )
[XML
<tr>
<td><a href=<-href->><-href-></a></td>
<td align="right"><-modified-></td>
<td align="right"><-size-></td>
</tr>
XML] ;
: file>html ( name -- xml ) : file>html ( name -- xml )
dup link-info directory? [ "/" append ] when dup link-info [
dup [XML <li><a href=<->><-></a></li> XML] ; dup directory?
[ drop "/" append "-" ]
[ size>> number>string ] if
] [ modified>> ] bi file-html-template ;
: parent-dir-link ( -- xml )
"../" "" "" file-html-template ;
: ?parent-dir-link ( -- xml/f )
url get [ path>> "/" = [ "" ] [ parent-dir-link ] if ] [ "" ] if* ;
: listing-title ( -- title )
url get [ path>> "Index of " prepend ] [ "" ] if* ;
:: listing-html-template ( title listing ?parent -- xml )
[XML <h1><-title-></h1>
<table>
<tr>
<th>Name</th>
<th>Last modified</th>
<th>Size</th>
</tr>
<tr><th colspan="5"><hr/></th></tr>
<-?parent->
<-listing->
<tr><th colspan="5"><hr/></th></tr>
</table>
XML] ;
: listing ( path -- seq-xml )
[ natural-sort [ file>html ] map ] with-directory-files ;
: listing-body ( title path -- xml )
listing ?parent-dir-link listing-html-template ;
: directory>html ( path -- xml ) : directory>html ( path -- xml )
[ file-name ] [ listing-title f over ] dip listing-body simple-page ;
[ drop f ]
[
[ file-name ] [ [ natural-sort [ file>html ] map ] with-directory-files ] bi
[XML <h1><-></h1> <ul><-></ul> XML]
] tri
simple-page ;
: list-directory ( directory -- response ) : list-directory ( directory -- response )
file-responder get allow-listings>> [ file-responder get allow-listings>> [