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
|
IDENTIFICATION DIVISION.
PROGRAM-ID. CEPIS-LOOKUP-MANY.
*> ---------------------------------------------------------------------
*> Resolve a whole table of CEPs.
*>
*> CALL "CEPIS-LOOKUP-MANY"
*> USING CEPIS-CONFIG CEPIS-BATCH CEPIS-STATUS
*>
*> Fill BATCH-COUNT and BATCH-REQUESTED for each slot; every slot comes
*> back in place. A CEP that does not exist, or that is not eight
*> digits, leaves its slot BATCH-ENTRY-MISSING -- it is never removed,
*> never shifted, and never raises. In a batch of a thousand, one bad
*> CEP must not cost the other nine hundred and ninety-nine. To find out
*> which one was malformed, call CEPIS-NORMALIZE-CEP on it first.
*>
*> Do not loop over CEPIS-LOOKUP instead. This resolves up to 500 CEPs
*> per request and chunks longer tables automatically; a loop of 500
*> calls pays 500 TLS handshakes where the batch pays one.
*>
*> The batch carries no coordinate. The endpoint behind it is CSV and
*> the CSV has no geo column, so BAT-GEO-PRESENT is "N" on every slot,
*> including CEPs that do have a coordinate. Need it? Use CEPIS-LOOKUP.
*>
*> The table holds 1000 slots. A BATCH-COUNT above that is rejected with
*> CEPIS-INVALID-CEP rather than silently truncated.
*> ---------------------------------------------------------------------
DATA DIVISION.
WORKING-STORAGE SECTION.
COPY "cepis-http.cpy".
COPY "cepis-csv.cpy".
01 WS-NORM.
COPY "cepis-status.cpy" REPLACING
==:P:== BY ==WSN== ==:L1:== BY ==05==.
01 WS-CHUNK-MAX PIC 9(4) VALUE 500.
01 WS-BATCH-MAX PIC 9(4) VALUE 1000.
01 WS-COLUMNS PIC 9(4) VALUE 13.
01 WS-INPUT PIC X(20).
01 WS-CEP PIC X(8).
01 WS-ROW-CEP PIC X(8).
01 WS-NEXT PIC 9(4).
01 WS-CHUNK-N PIC 9(4).
01 WS-ROW PIC 9(4).
01 WS-SLOTX PIC 9(4).
01 WS-I PIC 9(4).
01 WS-K PIC 9(4).
01 WS-ID PIC 9(4).
01 WS-NCOLS PIC 9(4).
01 WS-QLEN PIC 9(9).
01 WS-QUERY PIC X(5000).
01 WS-CHUNK-MAP.
05 WS-CHUNK-ROW OCCURS 500 TIMES.
10 WS-SLOT PIC 9(4).
10 WS-SENT PIC X(8).
01 WS-HEADER-MAP.
05 WS-COL-ID OCCURS 64 TIMES PIC 9(4).
01 WS-ROW-VALUES.
05 WS-ROW-FIELD OCCURS 13 TIMES.
10 WS-VAL PIC X(512).
10 WS-VAL-LEN PIC 9(9).
01 WS-NAME-TABLE.
05 FILLER PIC X(16) VALUE "cep".
05 FILLER PIC X(16) VALUE "logradouro".
05 FILLER PIC X(16) VALUE "complemento".
05 FILLER PIC X(16) VALUE "unidade".
05 FILLER PIC X(16) VALUE "bairro".
05 FILLER PIC X(16) VALUE "localidade".
05 FILLER PIC X(16) VALUE "uf".
05 FILLER PIC X(16) VALUE "estado".
05 FILLER PIC X(16) VALUE "regiao".
05 FILLER PIC X(16) VALUE "ibge".
05 FILLER PIC X(16) VALUE "gia".
05 FILLER PIC X(16) VALUE "ddd".
05 FILLER PIC X(16) VALUE "siafi".
01 WS-NAMES REDEFINES WS-NAME-TABLE.
05 WS-NAME OCCURS 13 TIMES PIC X(16).
LINKAGE SECTION.
COPY "cepis.cpy".
PROCEDURE DIVISION USING CEPIS-CONFIG CEPIS-BATCH CEPIS-STATUS.
MAIN-START.
SET CEPIS-OK TO TRUE
MOVE SPACES TO CEPIS-STATUS-MESSAGE
MOVE 0 TO CEPIS-STATUS-HTTP
MOVE -1 TO CEPIS-STATUS-RETRY-AFTER-MS
MOVE 0 TO CEPIS-STATUS-ATTEMPTS
IF BATCH-COUNT = 0
GOBACK
END-IF
IF BATCH-COUNT > WS-BATCH-MAX
SET CEPIS-INVALID-CEP TO TRUE
MOVE SPACES TO CEPIS-STATUS-MESSAGE
STRING "BATCH-COUNT is " BATCH-COUNT
" but the table holds only " WS-BATCH-MAX " slots"
DELIMITED BY SIZE INTO CEPIS-STATUS-MESSAGE
END-STRING
GOBACK
END-IF
PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > BATCH-COUNT
PERFORM CLEAR-SLOT
END-PERFORM
MOVE 1 TO WS-NEXT
PERFORM UNTIL WS-NEXT > BATCH-COUNT
PERFORM BUILD-CHUNK
IF WS-CHUNK-N > 0
PERFORM FETCH-CHUNK
IF CEPIS-FAILED
GOBACK
END-IF
PERFORM PARSE-CHUNK
IF CEPIS-FAILED
GOBACK
END-IF
END-IF
END-PERFORM
GOBACK.
*> -------------------------------------------------------------------
CLEAR-SLOT.
INITIALIZE BATCH-ADDRESS (WS-I)
SET BATCH-ENTRY-MISSING (WS-I) TO TRUE
SET BAT-NOT-TRUNCATED (WS-I) TO TRUE
SET BAT-GEO-ABSENT (WS-I) TO TRUE
MOVE SPACES TO BAT-GEO-PRECISAO (WS-I).
*> -------------------------------------------------------------------
*> Collect the next run of at most 500 well-formed CEPs and remember,
*> for each, which slot it came from. Malformed entries are skipped
*> here: they keep their slot but cost no round trip, because a CEP that
*> is not eight digits is the caller's bug and the server can only say
*> so more slowly.
BUILD-CHUNK.
MOVE 0 TO WS-CHUNK-N
MOVE 0 TO WS-QLEN
MOVE SPACES TO WS-QUERY
PERFORM UNTIL WS-NEXT > BATCH-COUNT
OR WS-CHUNK-N >= WS-CHUNK-MAX
MOVE BATCH-REQUESTED (WS-NEXT) TO WS-INPUT
CALL "CEPIS-NORMALIZE-CEP" USING WS-INPUT WS-CEP WS-NORM
END-CALL
IF WSN-OK
ADD 1 TO WS-CHUNK-N
MOVE WS-NEXT TO WS-SLOT (WS-CHUNK-N)
MOVE WS-CEP TO WS-SENT (WS-CHUNK-N)
IF WS-QLEN > 0
ADD 1 TO WS-QLEN
MOVE "," TO WS-QUERY (WS-QLEN:1)
END-IF
MOVE WS-CEP TO WS-QUERY (WS-QLEN + 1:8)
ADD 8 TO WS-QLEN
END-IF
ADD 1 TO WS-NEXT
END-PERFORM.
*> -------------------------------------------------------------------
FETCH-CHUNK.
MOVE SPACES TO HTTPQ-PATH
STRING "/csv?ceps=" WS-QUERY (1:WS-QLEN)
DELIMITED BY SIZE INTO HTTPQ-PATH
END-STRING
COMPUTE HTTPQ-PATH-LEN = 10 + WS-QLEN
MOVE "N" TO HTTPQ-ALLOW-503
CALL "CEPIS-REQUEST" USING CEPIS-CONFIG CEPIS-HTTP-REQUEST
CEPIS-HTTP-RESPONSE CEPIS-STATUS
END-CALL
IF CEPIS-FAILED
EXIT PARAGRAPH
END-IF
IF HTTP-STATUS = 400
SET CEPIS-INVALID-CEP TO TRUE
MOVE "the API rejected the batch request" TO
CEPIS-STATUS-MESSAGE
EXIT PARAGRAPH
END-IF
IF HTTP-STATUS NOT = 200
SET CEPIS-INVALID-RESPONSE TO TRUE
MOVE SPACES TO CEPIS-STATUS-MESSAGE
STRING "unexpected status " HTTP-STATUS " from /csv"
DELIMITED BY SIZE INTO CEPIS-STATUS-MESSAGE
END-STRING
END-IF.
*> -------------------------------------------------------------------
*> The API answers one row per requested CEP, in the requested order.
*> Should that ever fail to hold -- a proxy truncating, a cut response
*> -- the rows that did arrive are placed and the rest of the slots stay
*> missing. Padding beats shifting: a shifted list silently pairs the
*> wrong address with the wrong CEP, and nothing downstream can tell.
PARSE-CHUNK.
MOVE 1 TO CSV-POS
MOVE HTTP-BODY-LEN TO CSV-LEN
IF CSV-LEN >= 3
IF HTTP-BODY (1:3) = X"EFBBBF"
MOVE 4 TO CSV-POS
END-IF
END-IF
PERFORM READ-HEADER
IF WS-NCOLS = 0
SET CEPIS-INVALID-RESPONSE TO TRUE
MOVE "the batch response carries no CSV header row"
TO CEPIS-STATUS-MESSAGE
EXIT PARAGRAPH
END-IF
MOVE 0 TO WS-ROW
PERFORM UNTIL CSV-POS > CSV-LEN OR WS-ROW >= WS-CHUNK-N
ADD 1 TO WS-ROW
PERFORM READ-ROW
PERFORM ASSIGN-ROW
END-PERFORM.
*> -------------------------------------------------------------------
*> Map the header's column order onto the field identifiers, so a column
*> the API adds, moves or drops cannot shift the others out of place.
READ-HEADER.
MOVE 0 TO WS-NCOLS
PERFORM VARYING WS-K FROM 1 BY 1 UNTIL WS-K > 64
MOVE 0 TO WS-COL-ID (WS-K)
END-PERFORM
MOVE 0 TO WS-K
PERFORM UNTIL WS-K >= 64
ADD 1 TO WS-K
CALL "CEPIS-CSV-NEXT" USING HTTP-BODY CEPIS-CSV-SCAN
END-CALL
IF CSV-EXHAUSTED = "Y"
SUBTRACT 1 FROM WS-K
EXIT PERFORM
END-IF
MOVE WS-K TO WS-NCOLS
PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > WS-COLUMNS
IF CSV-FIELD (1:16) = WS-NAME (WS-I)
MOVE WS-I TO WS-COL-ID (WS-K)
EXIT PERFORM
END-IF
END-PERFORM
IF CSV-ROW-END = "Y"
EXIT PERFORM
END-IF
END-PERFORM.
*> -------------------------------------------------------------------
READ-ROW.
PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > WS-COLUMNS
MOVE SPACES TO WS-VAL (WS-I)
MOVE 0 TO WS-VAL-LEN (WS-I)
END-PERFORM
MOVE 0 TO WS-K
PERFORM UNTIL WS-K >= 64
ADD 1 TO WS-K
CALL "CEPIS-CSV-NEXT" USING HTTP-BODY CEPIS-CSV-SCAN
END-CALL
IF WS-K <= WS-NCOLS
MOVE WS-COL-ID (WS-K) TO WS-ID
IF WS-ID > 0
MOVE CSV-FIELD TO WS-VAL (WS-ID)
MOVE CSV-FIELD-LEN TO WS-VAL-LEN (WS-ID)
END-IF
END-IF
IF CSV-ROW-END = "Y"
EXIT PERFORM
END-IF
END-PERFORM.
*> -------------------------------------------------------------------
*> A row the API filled only in its cep column means "not in the DNE
*> database"; it keeps its slot as missing. The cep column is also
*> matched against the CEP that was actually sent, so a response that
*> came back in the wrong order marks slots missing instead of pairing
*> them with someone else's street.
ASSIGN-ROW.
MOVE WS-SLOT (WS-ROW) TO WS-SLOTX
IF WS-VAL (6) = SPACES
EXIT PARAGRAPH
END-IF
MOVE WS-VAL (1) (1:20) TO WS-INPUT
CALL "CEPIS-NORMALIZE-CEP" USING WS-INPUT WS-ROW-CEP WS-NORM
END-CALL
IF NOT WSN-OK OR WS-ROW-CEP NOT = WS-SENT (WS-ROW)
EXIT PARAGRAPH
END-IF
SET BATCH-ENTRY-FOUND (WS-SLOTX) TO TRUE
MOVE WS-ROW-CEP TO BAT-CEP (WS-SLOTX)
STRING WS-ROW-CEP (1:5) "-" WS-ROW-CEP (6:3)
DELIMITED BY SIZE INTO BAT-CEP-MASKED (WS-SLOTX)
END-STRING
IF WS-VAL-LEN (2) > 120
SET BAT-WAS-TRUNCATED (WS-SLOTX) TO TRUE
END-IF
MOVE WS-VAL (2) TO BAT-LOGRADOURO (WS-SLOTX)
IF WS-VAL-LEN (3) > 120
SET BAT-WAS-TRUNCATED (WS-SLOTX) TO TRUE
END-IF
MOVE WS-VAL (3) TO BAT-COMPLEMENTO (WS-SLOTX)
IF WS-VAL-LEN (4) > 80
SET BAT-WAS-TRUNCATED (WS-SLOTX) TO TRUE
END-IF
MOVE WS-VAL (4) TO BAT-UNIDADE (WS-SLOTX)
IF WS-VAL-LEN (5) > 100
SET BAT-WAS-TRUNCATED (WS-SLOTX) TO TRUE
END-IF
MOVE WS-VAL (5) TO BAT-BAIRRO (WS-SLOTX)
IF WS-VAL-LEN (6) > 100
SET BAT-WAS-TRUNCATED (WS-SLOTX) TO TRUE
END-IF
MOVE WS-VAL (6) TO BAT-LOCALIDADE (WS-SLOTX)
MOVE WS-VAL (7) TO BAT-UF (WS-SLOTX)
IF WS-VAL-LEN (8) > 60
SET BAT-WAS-TRUNCATED (WS-SLOTX) TO TRUE
END-IF
MOVE WS-VAL (8) TO BAT-ESTADO (WS-SLOTX)
IF WS-VAL-LEN (9) > 30
SET BAT-WAS-TRUNCATED (WS-SLOTX) TO TRUE
END-IF
MOVE WS-VAL (9) TO BAT-REGIAO (WS-SLOTX)
MOVE WS-VAL (10) TO BAT-IBGE (WS-SLOTX)
MOVE WS-VAL (11) TO BAT-GIA (WS-SLOTX)
MOVE WS-VAL (12) TO BAT-DDD (WS-SLOTX)
MOVE WS-VAL (13) TO BAT-SIAFI (WS-SLOTX).
END PROGRAM CEPIS-LOOKUP-MANY.
|