1.00 |
********START OF PGM : BREAKFAST2 **************************************** |
2.00 |
*================================================================ |
3.00 |
* |
4.00 |
* After compiling this module, create the program as follow: |
5.00 |
* |
6.00 |
* CRTPGM PGM(CGICBLDEV2/BREAKFAST2) MODULE(CGICBLDEV2/BREAKFAST2) |
7.00 |
* BNDDIR(CGICBLDEV2/CGICBLDEV2) |
8.00 |
* ACTGRP(BREAKFAST2) AUT(*USE) |
9.00 |
* |
10.00 |
*================================================================ |
11.00 |
PROCESS NOXREF APOST |
12.00 |
ID DIVISION. |
13.00 |
PROGRAM-ID. BREAKFAST2. |
14.00 |
ENVIRONMENT DIVISION. |
15.00 |
CONFIGURATION SECTION. |
16.00 |
SPECIAL-NAMES. |
17.00 |
copy CPYSPCNAME of CGICBLDEV2-QCBLLESRC. |
18.00 |
INPUT-OUTPUT SECTION. |
19.00 |
FILE-CONTROL. |
20.00 |
*---------------------------------- |
21.00 |
SELECT breakfast |
22.00 |
ASSIGN TO DATABASE-breakfast |
23.00 |
ORGANIZATION IS INDEXED |
24.00 |
ACCESS IS DYNAMIC |
25.00 |
RECORD KEY IS EXTERNALLY-DESCRIBED-KEY |
26.00 |
FILE STATUS IS STATUS-breakfast. |
27.00 |
SELECT breakfast1 |
28.00 |
ASSIGN TO DATABASE-breakfast1 |
29.00 |
ORGANIZATION IS INDEXED |
30.00 |
ACCESS IS DYNAMIC |
31.00 |
RECORD KEY IS EXTERNALLY-DESCRIBED-KEY |
32.00 |
FILE STATUS IS STATUS-breakfast1. |
33.00 |
*---------------------------------- |
34.00 |
DATA DIVISION. |
35.00 |
FILE SECTION. |
36.00 |
*---------------------------------- |
37.00 |
FD breakfast |
38.00 |
LABEL RECORD IS STANDARD. |
39.00 |
01 breakfast-RECFD. |
40.00 |
COPY DDS-ALL-FORMAT OF breakfast. |
41.00 |
FD breakfast1 |
42.00 |
LABEL RECORD IS STANDARD. |
43.00 |
01 breakfast1-RECFD. |
44.00 |
COPY DDS-ALL-FORMAT OF breakfast1 ALIAS. |
45.00 |
*================================================================= |
46.00 |
WORKING-STORAGE SECTION. |
47.00 |
*================================================================= |
48.00 |
* ----- Variables specific to this program ------ |
49.00 |
* |
50.00 |
01 HTML-DATA. |
51.00 |
* Variables to execute a command |
52.00 |
05 rc PIC S9(9) comp-4. |
53.00 |
05 cmd PIC X(2000). |
54.00 |
* Variables to parse the input string |
55.00 |
05 varnamein PIC X(50). |
56.00 |
* 05 occurrs PIC S9(10) comp-3 value 0. |
57.00 |
* 05 occurrence PIC S9(9) comp-4 value 0. |
58.00 |
05 occurrs PIC S9(9) binary. |
59.00 |
05 occurrence PIC S9(9) binary. |
60.00 |
05 request PIC X(1000). |
61.00 |
05 xbftid PIC X(1000). |
62.00 |
* Variables to load external HTML |
63.00 |
05 fn PIC X(10) VALUE 'HTMLEXAMPL'. |
64.00 |
05 lib PIC X(10) VALUE 'CGICBLDEV2'. |
65.00 |
05 mbr PIC X(10) VALUE 'BREAKFAST2'. |
66.00 |
* Variable for QWrtSection subprocedure |
67.00 |
05 HtmlSects PIC X(1000). |
68.00 |
* Variables for QUpdHtmlVar subprocedure |
69.00 |
05 varnameout PIC X(30). |
70.00 |
05 varvalout PIC X(1000). |
71.00 |
* Miscellaneous variables |
72.00 |
01 MISC-DATA. |
73.00 |
05 xbftdes PIC X(50). |
74.00 |
05 wkf PIC X(01). |
75.00 |
05 openSW PIC X(01). |
76.00 |
* Status fields |
77.00 |
05 status-breakfast1 PIC X(02). |
78.00 |
05 status-breakfast PIC X(02). |
79.00 |
*================================================================= |
80.00 |
* M A I N - L I N E |
81.00 |
*================================================================= |
82.00 |
PROCEDURE DIVISION. |
83.00 |
A-start-pgm. |
84.00 |
perform OpenFiles thru z-OpenFiles. |
85.00 |
perform GetCGIInput thru z-GetCGIInput. |
86.00 |
perform LoadHtml thru z-LoadHtml. |
87.00 |
perform SendHtml thru z-SendHtml. |
88.00 |
perform CloseFiles thru z-CloseFiles. |
89.00 |
*---------------------------------- |
90.00 |
B-end-pgm. |
91.00 |
exit program and continue run unit. |
92.00 |
*================================================================= |
93.00 |
GetCGIInput. |
94.00 |
* Get input data from POST or GET |
95.00 |
call 'QZHBGETINPUT'. |
96.00 |
* Parse input parameter 'request=...' into program variable 'request' |
97.00 |
move 'request' to varnamein. |
98.00 |
call 'QZHBGETVARUPPER' using |
99.00 |
by content varnamein |
100.00 |
returning into request. |
101.00 |
*---------------------------------- |
102.00 |
z-GetCGIInput. |
103.00 |
EXIT. |
104.00 |
*================================================================= |
105.00 |
LoadHtml. |
106.00 |
* Load html skeleton source member |
107.00 |
call 'QGETHTML' using fn lib mbr. |
108.00 |
*---------------------------------- |
109.00 |
z-LoadHtml. |
110.00 |
EXIT. |
111.00 |
*================================================================= |
112.00 |
SendHtml. |
113.00 |
*Send section /$top |
114.00 |
move 'top' to HtmlSects |
115.00 |
call 'QWRTSECTION' using HtmlSects. |
116.00 |
*If request=' ', populate the table |
117.00 |
if request = ' ' |
118.00 |
perform PopTable through z-PopTable |
119.00 |
end-if. |
120.00 |
*If request not=' ', process all the multiple occurrences |
121.00 |
*of input variable xbftid |
122.00 |
if request not = ' ' |
123.00 |
perform MultOccur through z-MultOccur |
124.00 |
end-if. |
125.00 |
*Write section 'end' and send the output buffer |
126.00 |
move 'end *fini' to HtmlSects |
127.00 |
call 'QWRTSECTION' using HtmlSects. |
128.00 |
*---------------------------------- |
129.00 |
z-SendHtml. |
130.00 |
EXIT. |
131.00 |
*================================================================= |
132.00 |
PopTable. |
133.00 |
*Write section 'tab1str' |
134.00 |
move 'tab1str' to HtmlSects |
135.00 |
call 'QWRTSECTION' using HtmlSects. |
136.00 |
*Populate the table |
137.00 |
perform Write1Row thru z-Write1Row |
138.00 |
until status-breakfast1 not = '00'. 60 |
139.00 |
*Write section 'tab1end' |
140.00 |
move 'tab1end' to HtmlSects |
141.00 |
call 'QWRTSECTION' using HtmlSects. |
142.00 |
*---------------------------------- |
143.00 |
z-PopTable. |
144.00 |
EXIT. |
145.00 |
*================================================================= |
146.00 |
Write1Row. |
147.00 |
read breakfast1 next record |
148.00 |
at end |
149.00 |
move wkf to wkf. |
150.00 |
if status-breakfast1 = '00' |
151.00 |
perform SetTab1Row thru z-SetTab1Row |
152.00 |
move 'tab1row' to HtmlSects |
153.00 |
call 'QWRTSECTION' using HtmlSects |
154.00 |
end-if. |
155.00 |
*---------------------------------- |
156.00 |
z-Write1Row. |
157.00 |
EXIT. |
158.00 |
*================================================================= |
159.00 |
SetTab1Row. |
160.00 |
* Set HTML output variables |
161.00 |
* for section "tab1row" |
162.00 |
*================================== |
163.00 |
* Set output variable /%bftid%/ |
164.00 |
move 'bftid' to varnameout |
165.00 |
move bftid1 to varvalout |
166.00 |
call 'QUPDHTMLVAR' using varnameout varvalout. |
167.00 |
* Set output variable /%bftdes%/ |
168.00 |
move 'bftdes' to varnameout |
169.00 |
move bftdes1 to varvalout |
170.00 |
call 'QUPDHTMLVAR' using varnameout varvalout. |
171.00 |
*---------------------------------- |
172.00 |
z-SetTab1Row. |
173.00 |
EXIT. |
174.00 |
*================================================================= |
175.00 |
SetList2Row. |
176.00 |
* Set HTML output variables |
177.00 |
* for section "list2row" |
178.00 |
*================================== |
179.00 |
* Set output variable /%bftid%/ |
180.00 |
move 'bftid' to varnameout |
181.00 |
move bftid to varvalout |
182.00 |
call 'QUPDHTMLVAR' using varnameout varvalout. |
183.00 |
* Set output variable /%bftdes%/ |
184.00 |
move 'bftdes' to varnameout |
185.00 |
move bftdes to varvalout |
186.00 |
call 'QUPDHTMLVAR' using varnameout varvalout. |
187.00 |
*---------------------------------- |
188.00 |
z-SetList2Row. |
189.00 |
EXIT. |
190.00 |
*================================================================= |
191.00 |
MultOccur. |
192.00 |
*Process all the multiple occurrences of input variable xbftid |
193.00 |
* Retrieve the number of occurrences |
194.00 |
move 'xbftid' to varnamein. |
195.00 |
call 'QZHBGETVARCNT' using varnamein |
196.00 |
returning into occurrs. |
197.00 |
* If user selected nothing |
198.00 |
if occurrs = 0 |
199.00 |
move 'list2none' to HtmlSects |
200.00 |
call 'QWRTSECTION' using HtmlSects |
201.00 |
go to z-MultOccur |
202.00 |
end-if. |
203.00 |
* Start list of user selections |
204.00 |
move 'list2str' to HtmlSects |
205.00 |
call 'QWRTSECTION' using HtmlSects |
206.00 |
* Process each occurrence |
207.00 |
compute occurrence = 1 |
208.00 |
perform until occurrence > occurrs |
209.00 |
move 'xbftid' to varnamein |
210.00 |
call 'QZHBGETVARUPPER' using |
211.00 |
by content varnamein |
212.00 |
by content occurrence |
213.00 |
returning into xbftid |
214.00 |
move xbftid to bftid |
215.00 |
read breakfast record |
216.00 |
if status-breakfast not = '00' |
217.00 |
go to z-MultOccur |
218.00 |
end-if |
219.00 |
perform SetList2Row thru z-SetList2Row |
220.00 |
move 'list2row' to HtmlSects |
221.00 |
call 'QWRTSECTION' using HtmlSects |
222.00 |
compute occurrence = occurrence + 1 |
223.00 |
end-perform. |
224.00 |
* End list of user selections |
225.00 |
move 'list2end' to HtmlSects |
226.00 |
call 'QWRTSECTION' using HtmlSects. |
227.00 |
*---------------------------------- |
228.00 |
z-MultOccur. |
229.00 |
EXIT. |
230.00 |
*================================================================= |
231.00 |
OpenFiles. |
232.00 |
move 'ovrdbf breakfast1 cgicbldev2/breakfast1 secure(*yes)' |
233.00 |
to cmd |
234.00 |
call 'QDOCMD' using cmd |
235.00 |
returning into rc |
236.00 |
open input breakfast1 |
237.00 |
move 'ovrdbf breakfast cgicbldev2/breakfast secure(*yes)' |
238.00 |
to cmd |
239.00 |
call 'QDOCMD' using cmd |
240.00 |
returning into rc |
241.00 |
open input breakfast |
242.00 |
*---------------------------------- |
243.00 |
Z-OpenFiles. |
244.00 |
EXIT. |
245.00 |
*================================================================= |
246.00 |
CloseFiles. |
247.00 |
close breakfast1 |
248.00 |
move 'dltovr breakfast1' to cmd |
249.00 |
call 'QDOCMD' using cmd |
250.00 |
returning into rc |
251.00 |
close breakfast |
252.00 |
move 'dltovr breakfast' to cmd |
253.00 |
call 'QDOCMD' using cmd |
254.00 |
returning into rc. |
255.00 |
*---------------------------------- |
256.00 |
Z-CloseFiles. |
257.00 |
EXIT. |
258.00 |
********* END OF PGM : BREAKFAST2 **************************************** |