Initial importv0.1.0

1 files changed, 324 insertions, 0 deletions

diff --git a/src/cepis-lookup.cob b/src/cepis-lookup.cob
new file mode 100644
index 0000000..cc6e412
--- /dev/null
+++ b/src/cepis-lookup.cob
@@ -0,0 +1,324 @@
+IDENTIFICATION DIVISION.
+PROGRAM-ID. CEPIS-LOOKUP.
+
+*> ---------------------------------------------------------------------
+*> Look up one CEP.
+*>
+*>     CALL "CEPIS-LOOKUP" USING CEPIS-CONFIG CEPIS-CEP-INPUT
+*>                               CEPIS-ADDRESS CEPIS-STATUS
+*>
+*> The CEP may be masked or not. It is validated locally first, so a
+*> seven-digit CEP costs no round trip: CEPIS-INVALID-CEP comes back
+*> without a socket ever being opened.
+*>
+*> On CEPIS-OK the address is filled. On anything else CEPIS-ADDRESS is
+*> cleared, so a caller that forgets to test the status reads spaces
+*> rather than the previous CEP's street.
+*>
+*> ADDR-GEO-PRESENT says whether the coordinate exists -- about 57% of
+*> CEPs have one. When it does, read ADDR-GEO-PRECISAO before measuring
+*> any distance with it: "logradouro" means the point is a stretch of
+*> street, with ADDR-GEO-RAIO-M around 100-150 m, while "localidade"
+*> means the CEP is a whole municipality and the point is its centroid,
+*> with a radius of 7 to 40 km. Computing shipping from the second is
+*> wrong by tens of kilometres.
+*> ---------------------------------------------------------------------
+
+DATA DIVISION.
+WORKING-STORAGE SECTION.
+COPY "cepis-http.cpy".
+COPY "cepis-json.cpy".
+
+01  WS-CEP                          PIC X(8).
+01  WS-GEO-FROM                     PIC 9(9).
+01  WS-GEO-TO                       PIC 9(9).
+01  WS-GEO-OK                       PIC X.
+01  WS-NUM-OK                       PIC X.
+01  WS-LAT                          PIC S9(3)V9(6).
+01  WS-LON                          PIC S9(3)V9(6).
+01  WS-RAIO                         PIC 9(9).
+01  WS-PRECISAO                     PIC X(16).
+01  WS-I                            PIC 9(4).
+01  WS-C                            PIC X.
+01  WS-DOTS                         PIC 9(4).
+01  WS-JUNK                         PIC 9(4).
+01  WS-DIGITS                       PIC 9(4).
+
+LINKAGE SECTION.
+COPY "cepis.cpy".
+
+PROCEDURE DIVISION USING CEPIS-CONFIG CEPIS-CEP-INPUT
+                         CEPIS-ADDRESS CEPIS-STATUS.
+
+MAIN-START.
+    PERFORM CLEAR-ADDRESS
+
+    CALL "CEPIS-NORMALIZE-CEP"
+        USING CEPIS-CEP-INPUT WS-CEP CEPIS-STATUS
+    END-CALL
+    IF CEPIS-FAILED
+        GOBACK
+    END-IF
+
+    MOVE SPACES TO HTTPQ-PATH
+    STRING "/" WS-CEP DELIMITED BY SIZE INTO HTTPQ-PATH
+    END-STRING
+    MOVE 9 TO HTTPQ-PATH-LEN
+    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
+        GOBACK
+    END-IF
+
+    EVALUATE HTTP-STATUS
+        WHEN 200
+            PERFORM PARSE-ADDRESS
+        WHEN 404
+            SET CEPIS-NOT-FOUND TO TRUE
+            MOVE SPACES TO CEPIS-STATUS-MESSAGE
+            STRING "CEP " WS-CEP " does not exist in the DNE database"
+                DELIMITED BY SIZE INTO CEPIS-STATUS-MESSAGE
+            END-STRING
+        WHEN 400
+            SET CEPIS-INVALID-CEP TO TRUE
+            PERFORM API-MESSAGE
+        WHEN OTHER
+            SET CEPIS-INVALID-RESPONSE TO TRUE
+            MOVE SPACES TO CEPIS-STATUS-MESSAGE
+            STRING "unexpected status " HTTP-STATUS
+                   " for CEP " WS-CEP
+                DELIMITED BY SIZE INTO CEPIS-STATUS-MESSAGE
+            END-STRING
+    END-EVALUATE
+    GOBACK.
+
+*> -------------------------------------------------------------------
+CLEAR-ADDRESS.
+    INITIALIZE CEPIS-ADDRESS
+    SET ADDR-NOT-TRUNCATED TO TRUE
+    SET ADDR-GEO-ABSENT TO TRUE
+    MOVE SPACES TO ADDR-GEO-PRECISAO.
+
+*> -------------------------------------------------------------------
+*> The API's own 400 carries a message this client does not have: the
+*> format already passed local validation, so the server knows something
+*> we do not. Surface its "mensagem" when there is one.
+API-MESSAGE.
+    MOVE SPACES TO CEPIS-STATUS-MESSAGE
+    MOVE "mensagem" TO JS-KEY
+    PERFORM GET-MEMBER
+    IF JS-TYPE = "S" AND JS-VALUE-LEN > 0
+        MOVE JS-VALUE TO CEPIS-STATUS-MESSAGE
+    ELSE
+        STRING "CEP " WS-CEP " rejected by the API"
+            DELIMITED BY SIZE INTO CEPIS-STATUS-MESSAGE
+        END-STRING
+    END-IF.
+
+*> -------------------------------------------------------------------
+GET-MEMBER.
+    MOVE 1 TO JS-FROM
+    MOVE HTTP-BODY-LEN TO JS-TO
+    CALL "CEPIS-JSON-GET" USING HTTP-BODY CEPIS-JSON-SCAN
+    END-CALL.
+
+*> -------------------------------------------------------------------
+GET-GEO-MEMBER.
+    MOVE WS-GEO-FROM TO JS-FROM
+    MOVE WS-GEO-TO TO JS-TO
+    CALL "CEPIS-JSON-GET" USING HTTP-BODY CEPIS-JSON-SCAN
+    END-CALL.
+
+*> -------------------------------------------------------------------
+PARSE-ADDRESS.
+    MOVE "cep" TO JS-KEY
+    PERFORM GET-MEMBER
+    IF JS-TYPE = "E"
+        SET CEPIS-INVALID-RESPONSE TO TRUE
+        MOVE "response is not a JSON object -- something between you "
+          &  "and the API is answering instead of it"
+          TO CEPIS-STATUS-MESSAGE
+        EXIT PARAGRAPH
+    END-IF
+
+    IF JS-VALUE-LEN > 8
+        SET ADDR-WAS-TRUNCATED TO TRUE
+    END-IF
+    MOVE JS-VALUE TO ADDR-CEP
+    IF ADDR-CEP = SPACES
+        MOVE WS-CEP TO ADDR-CEP
+    END-IF
+    STRING ADDR-CEP(1:5) "-" ADDR-CEP(6:3)
+        DELIMITED BY SIZE INTO ADDR-CEP-MASKED
+    END-STRING
+
+    MOVE "logradouro" TO JS-KEY
+    PERFORM GET-MEMBER
+    IF JS-VALUE-LEN > 120
+        SET ADDR-WAS-TRUNCATED TO TRUE
+    END-IF
+    MOVE JS-VALUE TO ADDR-LOGRADOURO
+
+    MOVE "complemento" TO JS-KEY
+    PERFORM GET-MEMBER
+    IF JS-VALUE-LEN > 120
+        SET ADDR-WAS-TRUNCATED TO TRUE
+    END-IF
+    MOVE JS-VALUE TO ADDR-COMPLEMENTO
+
+    MOVE "unidade" TO JS-KEY
+    PERFORM GET-MEMBER
+    IF JS-VALUE-LEN > 80
+        SET ADDR-WAS-TRUNCATED TO TRUE
+    END-IF
+    MOVE JS-VALUE TO ADDR-UNIDADE
+
+    MOVE "bairro" TO JS-KEY
+    PERFORM GET-MEMBER
+    IF JS-VALUE-LEN > 100
+        SET ADDR-WAS-TRUNCATED TO TRUE
+    END-IF
+    MOVE JS-VALUE TO ADDR-BAIRRO
+
+    MOVE "localidade" TO JS-KEY
+    PERFORM GET-MEMBER
+    IF JS-VALUE-LEN > 100
+        SET ADDR-WAS-TRUNCATED TO TRUE
+    END-IF
+    MOVE JS-VALUE TO ADDR-LOCALIDADE
+
+    MOVE "uf" TO JS-KEY
+    PERFORM GET-MEMBER
+    IF JS-VALUE-LEN > 2
+        SET ADDR-WAS-TRUNCATED TO TRUE
+    END-IF
+    MOVE JS-VALUE TO ADDR-UF
+
+    MOVE "estado" TO JS-KEY
+    PERFORM GET-MEMBER
+    IF JS-VALUE-LEN > 60
+        SET ADDR-WAS-TRUNCATED TO TRUE
+    END-IF
+    MOVE JS-VALUE TO ADDR-ESTADO
+
+    MOVE "regiao" TO JS-KEY
+    PERFORM GET-MEMBER
+    IF JS-VALUE-LEN > 30
+        SET ADDR-WAS-TRUNCATED TO TRUE
+    END-IF
+    MOVE JS-VALUE TO ADDR-REGIAO
+
+    MOVE "ibge" TO JS-KEY
+    PERFORM GET-MEMBER
+    MOVE JS-VALUE TO ADDR-IBGE
+
+    MOVE "gia" TO JS-KEY
+    PERFORM GET-MEMBER
+    MOVE JS-VALUE TO ADDR-GIA
+
+    MOVE "ddd" TO JS-KEY
+    PERFORM GET-MEMBER
+    MOVE JS-VALUE TO ADDR-DDD
+
+    MOVE "siafi" TO JS-KEY
+    PERFORM GET-MEMBER
+    MOVE JS-VALUE TO ADDR-SIAFI
+
+    PERFORM PARSE-GEO
+    SET CEPIS-OK TO TRUE.
+
+*> -------------------------------------------------------------------
+*> The coordinate is omitted entirely when the database has none, so its
+*> absence is normal, not an error. A geo block that is present but
+*> malformed is dropped the same way: the rest of the address is still
+*> useful and losing it over a bad float would be a poor trade.
+PARSE-GEO.
+    SET ADDR-GEO-ABSENT TO TRUE
+    MOVE "geo" TO JS-KEY
+    PERFORM GET-MEMBER
+    IF JS-TYPE NOT = "O"
+        EXIT PARAGRAPH
+    END-IF
+    MOVE JS-VSTART TO WS-GEO-FROM
+    MOVE JS-VEND TO WS-GEO-TO
+    MOVE "Y" TO WS-GEO-OK
+
+    MOVE "lat" TO JS-KEY
+    PERFORM GET-GEO-MEMBER
+    PERFORM CHECK-NUMERIC
+    IF WS-NUM-OK = "Y"
+        COMPUTE WS-LAT = FUNCTION NUMVAL (JS-VALUE)
+    ELSE
+        MOVE "N" TO WS-GEO-OK
+    END-IF
+
+    MOVE "lon" TO JS-KEY
+    PERFORM GET-GEO-MEMBER
+    PERFORM CHECK-NUMERIC
+    IF WS-NUM-OK = "Y"
+        COMPUTE WS-LON = FUNCTION NUMVAL (JS-VALUE)
+    ELSE
+        MOVE "N" TO WS-GEO-OK
+    END-IF
+
+    MOVE "raio_m" TO JS-KEY
+    PERFORM GET-GEO-MEMBER
+    PERFORM CHECK-NUMERIC
+    IF WS-NUM-OK = "Y"
+        COMPUTE WS-RAIO ROUNDED = FUNCTION NUMVAL (JS-VALUE)
+    ELSE
+        MOVE "N" TO WS-GEO-OK
+    END-IF
+
+    MOVE "precisao" TO JS-KEY
+    PERFORM GET-GEO-MEMBER
+    IF JS-TYPE = "S" AND JS-VALUE-LEN > 0
+        MOVE JS-VALUE TO WS-PRECISAO
+    ELSE
+        MOVE "N" TO WS-GEO-OK
+    END-IF
+
+    IF WS-GEO-OK = "Y"
+        SET ADDR-GEO-KNOWN TO TRUE
+        MOVE WS-LAT TO ADDR-GEO-LAT
+        MOVE WS-LON TO ADDR-GEO-LON
+        MOVE WS-RAIO TO ADDR-GEO-RAIO-M
+        MOVE WS-PRECISAO TO ADDR-GEO-PRECISAO
+    END-IF.
+
+*> -------------------------------------------------------------------
+*> FUNCTION NUMVAL answers 0 for text it cannot read, which would turn
+*> "lat": "not a number" into a coordinate off the coast of Africa. The
+*> text is therefore checked before it is converted.
+CHECK-NUMERIC.
+    MOVE "N" TO WS-NUM-OK
+    IF JS-TYPE NOT = "N" AND JS-TYPE NOT = "S"
+        EXIT PARAGRAPH
+    END-IF
+    IF JS-VALUE-LEN = 0 OR JS-VALUE-LEN > 32
+        EXIT PARAGRAPH
+    END-IF
+    MOVE 0 TO WS-DIGITS
+    MOVE 0 TO WS-DOTS
+    MOVE 0 TO WS-JUNK
+    PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > JS-VALUE-LEN
+        MOVE JS-VALUE(WS-I:1) TO WS-C
+        EVALUATE TRUE
+            WHEN WS-C >= "0" AND WS-C <= "9"
+                ADD 1 TO WS-DIGITS
+            WHEN WS-C = "."
+                ADD 1 TO WS-DOTS
+            WHEN (WS-C = "-" OR WS-C = "+") AND WS-I = 1
+                CONTINUE
+            WHEN OTHER
+                ADD 1 TO WS-JUNK
+        END-EVALUATE
+    END-PERFORM
+    IF WS-DIGITS > 0 AND WS-DOTS <= 1 AND WS-JUNK = 0
+        MOVE "Y" TO WS-NUM-OK
+    END-IF.
+
+END PROGRAM CEPIS-LOOKUP.