blob: cdbc954cc7fb6139a9580c987a0480302fcf9bb3 (
plain)
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
|
IDENTIFICATION DIVISION.
PROGRAM-ID. CEPIS-NORMALIZE-CEP.
*> ---------------------------------------------------------------------
*> Reduce a CEP to its eight digits.
*>
*> CALL "CEPIS-NORMALIZE-CEP"
*> USING CEPIS-CEP-INPUT CEPIS-CEP CEPIS-STATUS
*>
*> "01001-000", "01001000", " 01001-000 " and "01001.000" all give
*> "01001000". Anything that does not leave exactly eight digits sets
*> CEPIS-INVALID-CEP and leaves CEPIS-CEP as spaces.
*>
*> CEPIS-LOOKUP runs this before opening a socket. A seven-digit CEP is
*> the caller's bug, and a round trip for the server to say so wastes
*> both sides' time.
*> ---------------------------------------------------------------------
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-I PIC 9(4).
01 WS-N PIC 9(4).
01 WS-C PIC X.
01 WS-CLEAN PIC X(20).
LINKAGE SECTION.
COPY "cepis.cpy".
PROCEDURE DIVISION USING CEPIS-CEP-INPUT CEPIS-CEP CEPIS-STATUS.
MAIN-START.
MOVE SPACES TO CEPIS-CEP
MOVE SPACES TO WS-CLEAN
MOVE 0 TO WS-N
MOVE 0 TO CEPIS-STATUS-HTTP
MOVE 0 TO CEPIS-STATUS-ATTEMPTS
MOVE -1 TO CEPIS-STATUS-RETRY-AFTER-MS
MOVE SPACES TO CEPIS-STATUS-MESSAGE
INITIALIZE CEPIS-FAIXA
SET CEPIS-FAIXA-ABSENT TO TRUE
PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > 20
MOVE CEPIS-CEP-INPUT(WS-I:1) TO WS-C
EVALUATE TRUE
WHEN WS-C = SPACE OR WS-C = "-" OR WS-C = "."
CONTINUE
WHEN WS-C >= "0" AND WS-C <= "9"
ADD 1 TO WS-N
IF WS-N <= 20
MOVE WS-C TO WS-CLEAN(WS-N:1)
END-IF
WHEN OTHER
PERFORM REJECT
GOBACK
END-EVALUATE
END-PERFORM
IF WS-N NOT = 8
PERFORM REJECT
GOBACK
END-IF
MOVE WS-CLEAN(1:8) TO CEPIS-CEP
SET CEPIS-OK TO TRUE
GOBACK.
*> -------------------------------------------------------------------
REJECT.
SET CEPIS-INVALID-CEP TO TRUE
MOVE SPACES TO CEPIS-STATUS-MESSAGE
STRING "CEP must be 8 digits, got '"
FUNCTION TRIM(CEPIS-CEP-INPUT) "'"
DELIMITED BY SIZE INTO CEPIS-STATUS-MESSAGE
END-STRING.
END PROGRAM CEPIS-NORMALIZE-CEP.
|