Repository navigation
Expand file tree
/
Copy pathcgi.f
More file actions
executable file
·188 lines (155 loc) · 3.96 KB
/
Copy pathcgi.f
File metadata and controls
executable file
·188 lines (155 loc) · 3.96 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
#! /usr/bin/spf4
\ #! /home/ygrek/work/forth/spf/spf4
REQUIRE ATTACH ~pinka/samples/2005/lib/append-file.f
REQUIRE USER-TYPE ~ygrek/lib/typestr.f
REQUIRE XHTML ~ygrek/lib/xhtml/core.f
REQUIRE NOT ~profit/lib/logic.f
REQUIRE DateTime>PAD ~ygrek/lib/spec/unixdate.f
REQUIRE FileLines=> ~ygrek/lib/filelines.f
REQUIRE BACKSTRFREE ~ygrek/lib/backstr.f
REQUIRE StartAppWait ~ygrek/lib/linux/process.f
REQUIRE content:html ~ygrek/lib/net/cgi.f
REQUIRE XHTML-EXTRA ~ygrek/lib/xhtml/extra.f
ALSO XMLSAFE
ALSO XHTML
\ Every page
: <page> ( `title -- )
PRO
xml-declaration
doctype-strict
xhtml
<< `head tag
<< `application/xhtml+xml;charset=utf-8 `content-type http-equiv >>
<< `title tag ( `title ) TYPE >>
>>
`body tag
CONT ;
: sdiv ( `style --> \ <-- ) PRO %[ `style $$ ]% `div atag CONT ;
: option ( `value `name -- ) 2SWAP %[ `value $$ ]% `option atag TYPE ;
: render-edit ( a u -- )
S" " form-post
<<
S" float:left; margin: 0 1em 1em 0" sdiv
%[ `content `name $$ `25 `rows $$ `80 `cols $$ ]% `textarea atag
( a u ) TYPE
>>
<< S" float:left; padding: 0 1em; background-color: #eee; border: 1px solid green" sdiv
<< `h3 tag S" Example" TYPE >>
<< `pre tag
" CREATE TABLE t1 (x INT, name TEXT);
CREATE TABLE t2 (y INT, name TEXT);
CREATE TABLE t3 (z INT, r INT);
SELECT *, y+z AS q FROM t1
JOIN t2 USING (name)
JOIN t3 ON x = r
WHERE x = @val;" STYPE
>>
>>
<<
S" clear:left" sdiv
( << `div tag S" Output query parameters substitution :" TYPE
<<
%[ `params `name $$ ]% `select atag
`input S" As is" option
`named S" Only named" option
`unnamed S" Only unnamed" option
>>
>>
)
<<
%[ `gen `name $$ ]% `select atag
`cxx `C++ option
`csharp `C# option
`java `Java option
`caml `OCaml option
`xml `XML option
>>
S" generate code " `button `submit input
>>
;
20 1024 * CONSTANT limit
: gen-param ( `s -- `s2 )
2DUP `caml CEQUAL IF EXIT THEN
2DUP `xml CEQUAL IF EXIT THEN
2DUP `java CEQUAL IF EXIT THEN
2DUP `csharp CEQUAL IF EXIT THEN
2DROP `cxx ;
: process ( a u -- )
`p tag
hrule
<< `h2 tag S" Input" TYPE >>
DUP limit > IF DROP limit S" Input too long, truncated" TYPE CR THEN
<< `pre tag 2DUP TYPE >>
hrule
(( S" data_sqlgg" DROP 0x1FF )) mkdir DROP
ms@ { tick | src dst err gen }
`gen GetParam gen-param >STR TO gen
tick " data_sqlgg/{n}.in" -> src
tick " data_sqlgg/{n}.out" -> dst
tick " data_sqlgg/{n}.err" -> err
\ src STR@ TYPE CR dst STR@ TYPE CR err STR@ TYPE CR
src STR@ OCCUPY
err STR@ dst STR@ src STR@ gen STR@
" ./sqlgg.native -gen {s} {s} > {s} 2> {s}" STR@ StartAppWait DROP
dst STR@ FILE
<< `h2 tag S" Output" TYPE >>
<< `pre tag TYPE >>
hrule
err STR@ FILE DUP 0= IF 2DROP EXIT THEN
<< `h2 tag S" Errors" TYPE >>
<< `pre tag TYPE >>
hrule
;
: ask-input
<< `p tag
S" Input SQL statements terminated with semicolon (;) each. " TYPE
S" Use ? or @name for binding slots" TYPE
>>
S" " render-edit ;
: main ( -- )
S" SQL Guided (code) generator" 2DUP <page>
<< `h1 tag `/p/sqlgg/ link-text >>
`content GetParam DUP 0= IF 2DROP ask-input ELSE process THEN
\ S" CREATE TABLE x (z INT);" process
;
PREVIOUS
PREVIOUS
: env ENVIRONMENT? NOT IF S" " THEN ;
: TAB 0x09 EMIT ;
ALSO CGI
: log_request
LAMBDA{
TIME&DATE DateTime>PAD TYPE TAB
`REMOTE_ADDR env TYPE TAB
`REQUEST_METHOD env TYPE TAB
`SCRIPT_NAME env TYPE SPACE
`QUERY_STRING env TYPE TAB
`HTTP_USER_AGENT env TYPE
} TYPE>STR BACKSTRFREE STR@ `request.log ATTACH-LINE-CATCH DROP ;
: headers
content:xhtml
\ S" Cache-Control: no-cache" TYPE CR
;
: content
log_request
get-params
main
CR ;
: index
headers
['] content TYPE>STR DUP STRLEN content-length
CR
STYPE
BYE ;
PREVIOUS
\ : index headers CR content ;
\ : REQUEST_METHOD S" GET" ;
\ : QUERY_STRING S" page_name=MainPage" ;
\ ' TYPE1 TO USER-TYPE
: save
['] index MAINX !
`sqlgg.cgi SAVE
`sqlgg.cgi.o DELETE-FILE DROP
`sqlgg.cgi.ld DELETE-FILE DROP
;
save BYE