Skip to content
Navigation Menu
{{ message }}
-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathphonefcgi.pls
More file actions
412 lines (362 loc) · 13.8 KB
/
phonefcgi.pls
File metadata and controls
412 lines (362 loc) · 13.8 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
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
*---------------------------------------------------------------
.
. Program Name: phonefcgi
. Description: A sample program for the REST API
. This program is written to demonstrate the
. Fast CGI support
.
. Revision History:
.
. 10 Apr 2026 whk
. Original code
.
INCLUDE plbequ.inc
INCLUDE plbmeth.inc
*---------------------------------------------------------------
Runtime RUNTIME
PauseTime FORM ".1"
GUI FORM 2
.
. Message Data
.
MsgId DIM 8
MsgTo DIM 20
MsgFrom DIM 20
MsgPhone DIM 16
MsgData DIM 200
.
. Database
.
PhoneMsgDb DBFILE
SqlCommand DIM 4096
SqlId FORM 8
F10 FORM "10"
.
. REST request
.
Request DIM 40
Uri DIM 400
UriSections FORM 3
UriParts DIM 100(7)
Host DIM 100
.
. JSON Variables
.
MsgJson JSONDATA
MsgJsonText DIM 40960
.
*................................................................
.
. Code start
.
CALL Main
.
. Pause to allow the web server to send the response
.
PAUSE PauseTime
STOP
*................................................................
.
. RestNotImpl
.
. Returns not implemented message
.
RestNotImpl LFUNCTION
ENTRY
Runtime.HttpResponse Using *HttpCode=501,*MimeType="text/html", *Body="Not Implemented" *ExtraHdrs="", *Options=0
FUNCTIONEND
*................................................................
.
. RestDelete
.
. DELETE /MyServices/phonemsg/2
.
. Deletes message based on primary key
.
RestDelete LFUNCTION
ENTRY
PACK SqlCommand Using "Delete from msgs where id=",UriParts(4)
DBSEND PhoneMsgDb;SqlCommand
DBEXECUTE PhoneMsgDb
Runtime.HttpResponse Using *HttpCode=200,*MimeType="application/json", *Body="Delete Complete", *ExtraHdrs="", *Options=0
FUNCTIONEND
*................................................................
.
. RestMakeResponse
.
. Makes a JSON response based on the given SQL command
.
RestMakeResponse LFUNCTION
ENTRY
pos FORM 2
MsgJson.Reset
CLEAR pos
MsgJson.SetArray USING "messages", ""
DBSEND PhoneMsgDb;SqlCommand
DBEXECUTE PhoneMsgDb
LOOP
DBFETCH PhoneMsgDb,F10;MsgId, MsgTo, MsgFrom, MsgPhone, MsgData
UNTIL OVER
MsgJson.SetString Using "messages[$1].Message.id",MsgId,pos
MsgJson.SetString Using "messages[$1].Message.to",MsgTo,pos
MsgJson.SetString Using "messages[$1].Message.from",MsgFrom,pos
MsgJson.SetString Using "messages[$1].Message.phoneNumber",MsgPhone,pos
MsgJson.SetString Using "messages[$1].Message.message",MsgData,pos
ADD "1" to pos
REPEAT
MsgJson.Store Giving MsgJsonText
MsgJson.Reset
FUNCTIONEND
*................................................................
.
. RestGetName
.
. GET /MyServices/phonemsg/search/Name
.
. Searches for messages sent to Name
.
RestGetName LFUNCTION
ENTRY
UPPERCASE UriParts(4)
MATCH UriParts(4) To "SEARCH"
IF Equal
PACK SqlCommand Using "Select id, msgto, msgfrom, msgphone, msgdata from msgs where lower(msgto)=lower('",UriParts(5),"') order by msgto"
CALL RestMakeResponse
Runtime.HttpResponse Using *HttpCode=200,*MimeType="application/json", *Body=MsgJsonText, *ExtraHdrs="", *Options=0
ELSE
Runtime.HttpResponse Using *HttpCode=501,*MimeType="text/html", *Body="Not Implemented" *ExtraHdrs="", *Options=0
ENDIF
FUNCTIONEND
*................................................................
.
. RestGetKey
.
. GET /MyServices/phonemsg/2
.
. Retrieves message based on primary key
.
RestGetKey LFUNCTION
ENTRY
MOVE UriParts(4) To SqlId
IF ( SqlId > 0 )
PACK SqlCommand Using "Select id, msgto, msgfrom, msgphone, msgdata from msgs where id=",SqlId," order by msgto"
CALL RestMakeResponse
Runtime.HttpResponse Using *HttpCode=200,*MimeType="application/json", *Body=MsgJsonText, *ExtraHdrs="", *Options=0
ELSE
Runtime.HttpResponse Using *HttpCode=501,*MimeType="text/html", *Body="Not Implemented" *ExtraHdrs="", *Options=0
ENDIF
FUNCTIONEND
*................................................................
.
. RestGetAll
.
. GET /MyServices/phonemsg
.
. Retrieves all messages
.
RestGetAll LFUNCTION
ENTRY
MOVE "Select id, msgto, msgfrom, msgphone, msgdata from msgs order by msgto",SqlCommand
CALL RestMakeResponse
Runtime.HttpResponse Using *HttpCode=200,*MimeType="application/json":
*Body=MsgJsonText, *ExtraHdrs="", *OutFile="msg.out" *Options=0
FUNCTIONEND
*................................................................
.
. RestOptions
.
. Return the supported actions
.
RestOptions LFUNCTION
ENTRY
OptionHdr INIT "Allow: GET,POST,PUT,DELETE,OPTIONS",0xD,0xA
Runtime.HttpResponse Using *HttpCode=200,*MimeType="text/html", *Body="", *ExtraHdrs=OptionHdr, *Options=0
FUNCTIONEND
*................................................................
.
. RestFetchData
.
. This function will get the HTML message body from STDIN. It will then use
. the JSONDATA methods to extract the necessay fields.
.
RestFetchData LFUNCTION
ENTRY
HtmlData DIM 4096
ReqResult FORM 5
Runtime.HttpStdinSize giving ReqResult
DISPLAY ReqResult
Runtime.HttpStdinData giving HtmlData
DISPLAY HtmlData
MsgJson.Parse Using HtmlData
MsgJson.GetString Giving MsgTo USING "to"
MsgJson.GetString Giving MsgFrom USING "from"
MsgJson.GetString Giving MsgPhone USING "phoneNumber"
MsgJson.GetString Giving MsgData USING "message"
FUNCTIONEND
*................................................................
.
. RestPost
.
. POST /MyServices/phonemsg
.
. Adds a new message
.
. Body contains json data object
. Primary key is return in Location: field
.
RestPost LFUNCTION
ENTRY
LineTerm INIT 0xD,0xA
LocationHdr DIM 200
MOVE "unknown" To MsgTo
MOVE "unknown" To MsgFrom
MOVE "unknown" To MsgPhone
MOVE "None" To MsgData
CALL RestFetchData
PACK SqlCommand Using "insert into msgs(msgto,msgfrom,msgphone,msgdata) values('",MsgTo:
"', '",MsgFrom,"', '",MsgPhone,"', '",MsgData,"' )"
DBSEND PhoneMsgDb;SqlCommand
DBEXECUTE PhoneMsgDb
DBSEND PhoneMsgDb;"select last_insert_rowid()"
DBEXECUTE PhoneMsgDb
DBFETCH PhoneMsgDb,F10;MsgId
PACK LocationHdr Using "Location: http://", Host, Uri, "/", MsgId, LineTerm
Runtime.HttpResponse Using *HttpCode=201,*MimeType="text/html", *Body=" created", *ExtraHdrs=LocationHdr, *Options=0
FUNCTIONEND
*................................................................
.
. RestPut
.
. PUT /MyServices/phonemsg/2
.
. Updates message based on primary key
.
. Body contains json data object
.
RestPut LFUNCTION
ENTRY
MOVE UriParts(4) To SqlId
IF ( SqlId > 0 )
PACK SqlCommand Using "Select id, msgto, msgfrom, msgphone, msgdata from msgs where id=",SqlId," order by msgto"
DBSEND PhoneMsgDb;SqlCommand
DBEXECUTE PhoneMsgDb
DBFETCH PhoneMsgDb,F10;MsgId, MsgTo, MsgFrom, MsgPhone, MsgData
IF OVER
Runtime.HttpResponse Using *HttpCode=404,*MimeType="text/html", *Body="Not found" *ExtraHdrs="", *Options=0
ELSE
CALL RestFetchData
PACK SqlCommand Using "Update msgs SET msgto='",MsgTo,"', msgfrom='", MsgFrom,"', msgphone='",MsgPhone:
"', msgdata='", MsgData,"' where id=",SqlId
DBSEND PhoneMsgDb;SqlCommand
DBEXECUTE PhoneMsgDb
Runtime.HttpResponse Using *HttpCode=204,*MimeType="text/html", *Body="" *ExtraHdrs="", *Options=0
ENDIF
ELSE
Runtime.HttpResponse Using *HttpCode=501,*MimeType="text/html", *Body="Not Implemented" *ExtraHdrs="", *Options=0
ENDIF
FUNCTIONEND
*................................................................
.
. RestAction
.
. Handle a REST Request
.
RestAction LFUNCTION
ENTRY
.
. Decoding the requested action
.
Runtime.CgiString Giving Request Using "REQUEST_METHOD"
Runtime.CgiString Giving Uri Using "REQUEST_URI"
Runtime.CgiString Giving Host Using "HTTP_HOST"
EXPLODE Uri Using "/" Giving UriSections into UriParts
SWITCH Request
CASE "DELETE"
IF (UriSections = 4 )
CALL RestDelete
ELSE
CALL RestNotImpl
ENDIF
CASE "GET"
IF (UriSections = 5 )
CALL RestGetName
ELSE If (UriSections = 4 )
CALL RestGetKey
ELSE
CALL RestGetAll
ENDIF
CASE "OPTIONS"
CALL RestOptions
CASE "PATCH"
CALL RestNotImpl
CASE "POST"
IF (UriSections = 3 )
CALL RestPost
ELSE
CALL RestNotImpl
ENDIF
CASE "PUT"
IF (UriSections = 4 )
CALL RestPut
ELSE
CALL RestNotImpl
ENDIF
DEFAULT
CALL RestNotImpl
ENDSWITCH
FUNCTIONEND
*................................................................
.
. Main - Main program entry point
.
Main LFUNCTION
ENTRY
ReqResult FORM 5
nCount FORM 6
GETMODE *GUI=GUI
IF ( GUI != 0 )
WINSHOW
ENDIF
.
. Start by creating a default database if one is not availiable
.
DBCONNECT PhoneMsgDb, "SQLITE;;phonefcgi.db","",""
DBSEND PhoneMsgDb;"create table msgs(id integer primary key, msgto char(20), msgfrom char(20), msgphone char(16), msgdata char(200) )"
EXCEPTSET SkipBuild IF DBFAIL
DBEXECUTE PhoneMsgDb
DBSEND PhoneMsgDb;"insert into msgs(msgto,msgfrom,msgphone,msgdata) values('bill', 'mike', '1-345-555-1212', 'Moved meeting to 12:00pm' )"
DBEXECUTE PhoneMsgDb
DBSEND PhoneMsgDb;"insert into msgs(msgto,msgfrom,msgphone,msgdata) values('bill', 'bob', '1-235-555-1212', 'Lunch tomorrow ?' )"
DBEXECUTE PhoneMsgDb
DBSEND PhoneMsgDb;"insert into msgs(msgto,msgfrom,msgphone,msgdata) values('bill', 'lazy bro', '1-995-555-1212', 'Need to borrow $10' )"
DBEXECUTE PhoneMsgDb
SkipBuild EXCEPTCLEAR DBFAIL
.
. Decoding the requested action
.
.
LOOP
Runtime.HttpRequest Giving ReqResult Using *Timeout=3
SWITCH ReqResult
CASE 0 // A request was made
CALL RestAction
ADD "1", nCount
DISPLAY nCount, " ", *LL, Request, " ", Uri
CASE 1 // Shutdown message received from PWS server!
DBDISCONNECT PhoneMsgDb
SHUTDOWN
CASE 2 // Time out
IF ( GUI != 0 )
EVENTCHECK
ENDIF
CASE 3 // Previous request still outstanding
CALL RestNotImpl
DEFAULT // Error
DBDISCONNECT PhoneMsgDb
SHUTDOWN
ENDSWITCH
REPEAT
FUNCTIONEND
.
.
.
You can’t perform that action at this time.