Gestire un database MySQL con programma in RM/COBOL

Altre pagine:	1] MySQL	4] Gestione completa dei dati
	2] Preparazione	5] Le eccezioni
	3] Replica dati in MySQL	6] Accedere i dati

Gestire un database MySQL con programma in RM/COBOL.

Come abbiamo visto nelle pagine precedenti RM/COBOL ci offre la possibilità di archiviare i dati in un database.
Questo significa non solo memorizzare i dati, ma anche la loro gestione ossia aggiunta, mutazione e cancellazione di records.
Tradotto nel liguaggio SQL vuole dire che abbiamo la possibilità di eseguire:

     immagine Query di interrogazione.
      Query di aggiornamento.
      Query di inserimento.
      Query di cancellazione.

Nonchè la gestione delle Stored Procedures e di altri comandi del linguaggio SQL.

Un programma di dimostrazione

Questo semplice programma per dare un’idea di come viene eseguita una mutazione di un record della tabella indirizzi menzionata nelle pagine precedenti.
Dapprima viene richiesta l’immissione del numero di indirizzo (mi sono limitato alla ricerca numerica) ed in seguito viene visualizzato l’indirizzo.
Poi è possibile mutare i campi relativi all’indirizzo selezionato.
Infine, se così voluto, il record viene riscritto nel database.
Con questo semplice esempio vediamo l’uso pratico delle:

immagine Query di interrogazione.
Query di aggiornamento.

La tabella indirizzi prima della mutazione

Questo è quanto otteniamo da una query di interrogazione fatta con il programma nativo di MySQL Query Browser

Query tabella MySQL

La mutazione con il programma RM/COBOL

Richiamiamo l’indirizzo numero 1035 e mutiamo la città da Mannheim a Berlino.

Programma mutazione

La tabella indirizzi dopo la mutazione

Questo è come si presenta la tabella dopo la mutazione

Query tabella MySQL

Il codice sorgente

Ecco il programma per la mutazione degli indirizzi dalla tabella indirizzi del database Demo.

000001 IDENTIFICATION DIVISION.
000002*
000003*
000004*
000005*            Mutazione records tabella indirizzi in MySQL
000006*            --------------------------------------------
000007*
000008*     Programma semplificato di esempio per la mutazione dei campi
000009*     della tabella indirizzi in MySQL tramite un programma
000010*     in Rm/Cobol.
000011*      
000012 PROGRAM-ID.  MY-EX-04.
000013*
000014*
000015*
000016 ENVIRONMENT DIVISION.
000017 CONFIGURATION SECTION.
000018 SOURCE-COMPUTER.  RMC10.
000019 OBJECT-COMPUTER.  RMC10.
000020*
000021*
000022 INPUT-OUTPUT SECTION.
000023 FILE-CONTROL.
000024*
000025*
000026*
000027*                 SCHEDARIO INDIRIZZI
000028*
000029*
000030     SELECT F01         ASSIGN TO DISC
000031           "INDZZI.DAT"
000032                        ORGANIZATION    INDEXED
000033                        ACCESS          DYNAMIC
000034                        RECORD KEY      F01KEY
000035                        FILE STATUS     ERF01.
000036*
000037 DATA DIVISION.
000038*
000039 FILE SECTION.
000040*
000041*
000042*
000043 FD   F01
000044                     LABEL RECORD        STANDARD.
000045*
000046*
000047*
000048 1    F01REC.
000049  2   F01KEY.
000050   3  F0101       PIC 9(4).         *> Numero indirizzo
000051  2   F0102       PIC X(25).        *> Cognome e nome
000052  2   F0103       PIC X(25).        *> Via
000053  2   F0104       PIC X(15).        *> Citta'
000054  2   F0105       PIC X(11).        *> Nazione
000055*
000056*
000057*
000058/      
000059 WORKING-STORAGE SECTION.
000060*
000061*                 Nome e versione del programma
000062*                 -----------------------------
000063*
000064 1   PROGRAMMA.
000065 2   FILLER    PIC X(09)    VALUE "MY-EX-04-".
000066 2   VERSIONE  PIC XX       VALUE "01".
000067  2  FILLER    PIC  X       VALUE "-".
000068  2  COMPILATO PIC 9(6).
000069*
000070 78  DATE-COMP              VALUE IS DATE-COMPILED.
000071*
000072*
000073*
000074*                 Costanti & campi di lavori
000075*                 --------------------------
000076 1    NUMERO            PIC 9(4).
000077*
000078 1    WS-INDIRIZZO.
000079  2   WS-NUMERO         PIC 9(4).
000080  2   WS-NOME           PIC X(25).
000081  2   WS-VIA            PIC X(25).
000082  2   WS-CITTA          PIC X(15).
000083  2   WS-NAZIONE        PIC X(11).
000084*
000085 1    FUNZ              PIC 99.
000086*
000087*                  Campi per display
000088*                  -----------------
000089*
000090 1   TXS     PIC X(80) VALUE SPACES.
000091 1   TXR     PIC X(80) VALUE ALL "-".
000092*
000093*
000094*                  Campi accept ad uso generale
000095*                  ----------------------------
000096  1   A0.
000097   2   A1  PIC X.
000098   2    A2  PIC XX.
000099   2     A3  PIC XXX.
000100   2      A4  PIC XXXX.
000101   2       A5  PIC XXXXX.
000102   2        A6  PIC XXXXXX.
000103   2         A7  PIC XXXXXXX.
000104   2          A8  PIC XXXXXXXX.
000105   2           A9  PIC XXXXXXXXX.
000106 1     N0 REDEFINES A0.
000107   2    N1  PIC 9.
000108   2     N2  PIC 99.
000109   2      N3  PIC 999.
000110   2       N4  PIC 9999.
000111   2        N5  PIC 99999.
000112   2         N6  PIC 999999.
000113   2          N7  PIC 9999999.
000114   2           N8  PIC 99999999.
000115   2            N9  PIC 999999999.
000116*
000117*
000118/
000119*                 Campi per test numerico
000120*                 ----------------------- 
000121*
000122 01  TINT.
000123  02 WIN     PIC X   OCCURS 20 TIMES.
000124*
000125 01  TOUT.
000126  02 WOUT    PIC X   OCCURS 20 TIMES.
000127*
000128 01  TOUTN   REDEFINES TOUT.
000129  02 WNUM    PIC S9(13)V9(5) TRAILING SEPARATE.
000130*
000131 01  WZ1     PIC 99.
000132 01  WZ2     PIC 99.
000133 01  WSP     PIC 99.
000134*
000135*
000136 01  SWI     PIC 99.
000137*
000138*
000139*
000140*
000141*
000142*     Campi riservati per la gestione degli status sql 
000143*     ------------------------------------------------
000144*
000145 1   TXQ.
000146  2  FILLER                VALUE  "Errore ".
000147  2  TXQ-TYPE     PIC X(4).
000148  2  FILLER                VALUE  " Numero ".
000149  2  TXQ-ST       PIC ZZZZZ9-.
000150  2  FILLER                VALUE  " (?=Spiegazioni)".
000151*
000152 1   QTXT-TAB.
000153  2  QTXT         PIC X(74) OCCURS 7.
000154*       
000155*                 Campi per popup window errore SQL
000156*                 ---------------------------------
000157*
000158 77  QWIN-LINE                  PIC 999 BINARY VALUE 7.
000159 77  QWIN-POSITION              PIC 999 BINARY VALUE 2.
000160 77  QWIN-STATUS                PIC 999.
000161 77  QWIN-CONTROL               PIC X(80).
000162 01  QWIN-X1                    PIC 99.
000163*
000164 01  QWCB.
000165     03  QWCB-HANDLE               PIC 999 BINARY  VALUE 0.
000166     03  QWCB-NUM-ROWS             PIC 999 BINARY  VALUE 7.
000167     03  QWCB-NUM-COLS             PIC 999 BINARY  VALUE 78.
000168     03  QWCB-LOCATION-REFERENCE   PIC X           VALUE "S".
000169     03  QWCB-BORDER-SWITCH        PIC X           VALUE "N".
000170     03  QWCB-BORDER-TYPE          PIC 9           VALUE  0.
000171     03  QWCB-BORDER-CHAR          PIC X           VALUE SPACES.
000172     03  QWCB-FILL-SWITCH          PIC X           VALUE "N".
000173     03  QWCB-FILL-CHAR            PIC X           VALUE SPACES.
000174     03  QWCB-TITLE-LOCATION       PIC X           VALUE "T".
000175     03  QWCB-TITLE-POSITION       PIC X           VALUE "C".
000176     03  QWCB-TITLE-LENGTH         PIC 999 BINARY  VALUE 19.
000177     03  QWCB-TITLE                PIC X(19)       VALUE
000178         "Errore Instant SQL".
000179*
000180 01  QFU                          PIC 99.
000181*
000182*                 Comandi SQL
000183*                 -----------
000184*    A) Ricerca indirizzo
000185*
000186 1   WR-RICERCA.
000187  2  FILLER                      VALUE
000188     "SELECT * FROM indirizzi WHERE Numero =".
000189  2  WR-NUMERO         PIC 9(4).
000190*
000191*    B) Aggiornamento indirizzo
000192*           
000193 1   WU-AGGIORNA.
000194  2  FILLER                       VALUE
000195     "UPDATE indirizzi SET Nome = '".
000196  2  WU-NOME           PIC X(25).
000197  2  FILLER                       VALUE
000198     "', Via = '".
000199  2  WU-VIA            PIC X(25).
000200  2  FILLER                       VALUE
000201     "', Citta = '".
000202  2  WU-CITTA          PIC X(15).
000203  2  FILLER                       VALUE
000204     "', Nazione = '".
000205  2  WU-NAZIONE        PIC X(11).
000206  2  FILLER                       VALUE
000207     "' WHERE Numero = ".
000208  2  WU-NUMERO         PIC 9(4).
000209*
000210/
000211 COPY "lisqlall.cpy".
000212*
000213*
000214/                    
000215 PROCEDURE DIVISION.
000216*
000217/
000218 HAUPT SECTION.
000219*
000220*
000221*
000222*             
000223 A-1.
000224     PERFORM IN1  THRU IN9.        *> Inizializzare programma
000225*
000226 A-2.
000227     PERFORM MA1  THRU MA9.        *> Visualizza maschera
000228*
000229 A-3.
000230     PERFORM SEL1 THRU SEL9.       *> Seleziona e leggi indirizzo
000231     IF NUMERO = 0 GO A-9.         *> Fine programma                  
000232*
000233     PERFORM SH1  THRU SH9.        *> Visualizza contenuto record
000234*           
000235 A-4.
000236*
000237     PERFORM MUT1 THRU MUT9.       *> Mutare indirizzo
000238*           
000239     GO A-2.                       *> Loop mutazioni
000240*
000241 A-9.
000242     PERFORM CL1 THRU CL9.
000243*
000244     GOBACK.
000245*
000246/
000247*                 Chiusura del programma
000248*                 ---------------------- 
000249 CL1.
000250     DISPLAY "END OF - " LINE 1  ERASE
000251             PROGRAMMA   LINE 1  POSITION 10.
000252*
000253*
000254*                 Disconnetti ODBC
000255*
000256     SQL DISCONNECT DATASOURCE sql-ConnectionHandle.
000257*                     Terminate InstantSQL.
000258*
000259*                 Scarico DLL 
000260*
000261     SQL SHUTDOWN.
000262*
000263*
000264 CL9.
000265     EXIT.
000266*
000267/
000268*                 Inizializzare programma
000269*                 -----------------------
000270 IN1.
000271     MOVE DATE-COMP TO COMPILATO.
000272     DISPLAY PROGRAMMA   LINE 1 ERASE.
000273*
000274*            CONNESSIONE ODBC
000275*
000276*
000277     SQL CONNECT DATASOURCE sql-ConnectionHandle
000278         "RMC-MY-ODBC"  *> NOME ODBC
000279         "RM-MY"        *> USER  
000280         "rmc".         *> PASSWORD
000281     IF NOT sql-OK
000282       PERFORM TQ   THRU TQE
000283       GOBACK.
000284*
000285*
000286*
000287 IN9.
000288     EXIT.
000289/
000290*                 Visualizza maschera
000291*                 -------------------
000292 MA1.
000293     DISPLAY PROGRAMMA            LINE  1 POSITION 60 LOW ERASE
000294              CONTROL  "FCOLOR=BLACK BCOLOR=BROWN".
000295     DISPLAY "Gestione indirizzi" LINE  1 POSITION 27 REVERSE.
000296     DISPLAY "Numero"             LINE  3 POSITION  4
000297             "1- Cognome e nome"  LINE  5 POSITION 15
000298             "2- Via"             LINE  7 POSITION 15        
000299             "3- Citta'"           LINE  9 POSITION 15        
000300             "4- Nazione"         LINE 11 POSITION 15.
000301*
000302 MA9.
000303     EXIT. 
000304/
000305*                 Mutazione campi indirizzo           
000306*                 -------------------------
000307 MUT1.
000308     DISPLAY "Funzione / Posizione        :"
000309                                      LINE 16 POSITION 16
000310             "(Fine / Ignora / 1-4 = Campo)"
000311                                      LINE 17 POSITION 16 LOW.
000312     ACCEPT A1 LINE 16 POSITION 46 PROMPT ECHO.
000313     DISPLAY TXS LINE 16 POSITION 1
000314             TXS LINE 17 POSITION 1.
000315*
000316     IF A1 = "I" OR "i"        GO MUT9.
000317     IF A1 = "F" OR "f"        GO MUT3.                                       
000318*
000319     MOVE A1 TO TINT. 
000320     PERFORM NUMT THRU NU99.
000321     IF SWI = 1                GO MUT1.
000322     MOVE WNUM TO FUNZ.
000323     IF FUNZ = 0 OR FUNZ > 4   GO MUT1.
000324*
000325     GO MUT2-1 MUT2-2 MUT2-3 MUT2-4 DEPENDING ON FUNZ.
000326*
000327 MUT2-1.
000328     ACCEPT WS-NOME    LINE  5 POSITION 35 UPDATE.  GO MUT1.
000329 MUT2-2.
000330     ACCEPT WS-VIA     LINE  7 POSITION 35 UPDATE.  GO MUT1.
000331 MUT2-3.
000332     ACCEPT WS-CITTA   LINE  9 POSITION 35 UPDATE.  GO MUT1.
000333 MUT2-4.
000334     ACCEPT WS-NAZIONE LINE 11 POSITION 35 UPDATE.  GO MUT1.
000335*
000336 MUT3.
000337     MOVE WS-NOME    TO WU-NOME.
000338     MOVE WS-VIA     TO WU-VIA.
000339     MOVE WS-CITTA   TO WU-CITTA.
000340     MOVE WS-NAZIONE TO WU-NAZIONE
000341*                  
000342     SQL PREPARE QUERY sql-QueryHandle
000343         sql-ConnectionHandle
000344         WU-AGGIORNA.
000345     IF NOT sql-OK
000346       PERFORM TQ   THRU TQE.
000347         
000348     SQL START QUERY sql-QueryHandle.
000349     IF NOT sql-OK
000350       PERFORM TQ   THRU TQE.
000351     SQL END QUERY sql-QueryHandle.       
000352     
000353 MUT9.
000354     EXIT. 
000355*
000356/           
000357*                 Test numerico
000358*                 -------------
000359*
000360*
000361 NUMT.
000362         MOVE    ZERO TO WNUM, WZ1, WZ2, WSP.
000363         IF      TINT = SPACE, GO TO NU12.
000364*
000365         INSPECT TINT TALLYING WZ2 FOR ALL "-".
000366         IF      WZ2 = 0, GO TO NU01.
000367         MOVE "-" TO WOUT (19).
000368 NU01.
000369         INSPECT TINT TALLYING WZ1 FOR ALL ".".
000370         IF      WZ1 > 1, GO TO NU13.
000371         IF      WZ1 NOT = 0, GO TO NU05.
000372         MOVE    1 TO WZ1.
000373 NU02.
000374         IF      WIN (WZ1) = SPACE, GO TO NU03.
000375         ADD     1 TO WZ1.
000376         GO  TO  NU02.
000377 NU03.
000378         MOVE "." TO WIN (WZ1).
000379 NU04.
000380         IF  WZ1 > 19, GO TO NU05.
000381         ADD 1 TO WZ1.
000382         IF  WIN (WZ1) = SPACE, GO TO NU04.
000383         GO TO NU13.
000384 NU05.
000385         INSPECT TINT TALLYING WSP FOR CHARACTERS
000386                 BEFORE INITIAL ".".
000387         MOVE WSP TO WZ1.
000388         MOVE 13 TO WZ2.
000389*
000390 NU06.
000391         IF  WZ1 = 0, GO TO NU08.
000392         IF  WZ2 = 0, GO TO NU13.
000393         IF  WIN (WZ1) = "-", GO TO NU07.
000394         MOVE WIN (WZ1) TO WOUT (WZ2).
000395         SUBTRACT 1 FROM WZ2.
000396 NU07.
000397         SUBTRACT 1 FROM WZ1.
000398         GO TO NU06.
000399 NU08.
000400         ADD  2, WSP GIVING WZ1.
000401         MOVE 14 TO WZ2.
000402 NU09.
000403         IF  WIN (WZ1) = SPACE, GO TO NU11.
000404         IF  WIN (WZ1) = "-", GO TO NU10.
000405         IF  WZ1 > 20, GO NU12.
000406         IF  WZ2 > 18, GO NU12.
000407         MOVE WIN (WZ1) TO WOUT (WZ2).
000408         ADD 1 TO WZ2.
000409 NU10.
000410         ADD 1 TO WZ1.
000411         GO  TO  NU09.
000412*
000413 NU11.
000414         IF  WZ1 > 19, GO TO NU12.
000415         ADD 1 TO WZ1.
000416         IF  WIN (WZ1) = SPACE, GO TO NU11.
000417 NU12.
000418         IF  WNUM NOT NUMERIC, GO TO NU13.
000419         MOVE 0 TO SWI.
000420         GO TO NU99.
000421 NU13.
000422         MOVE 1 TO SWI.
000423*
000424 NU99.
000425         EXIT.
000426*                     
000427/
000428*                 Selezione indirizzo
000429*                 -------------------
000430 SEL1.
000431     INITIALIZE WS-INDIRIZZO.
000432     DISPLAY "Impostare numero indirizzo o F per terminare"
000433                 LINE 16 POSITION 16.
000434     ACCEPT A4   LINE 3  POSITION 12 PROMPT ECHO.
000435     DISPLAY TXS LINE 16 POSITION 1.
000436     IF A4 = "F" OR "f" MOVE 0 TO NUMERO GO SEL9.
000437     MOVE A4 TO TINT.
000438     PERFORM NUMT THRU NU99.
000439     IF SWI = 1                          GO SEL1.
000440     MOVE WNUM TO NUMERO WR-NUMERO WU-NUMERO.
000441*            
000442*
000443    SQL PREPARE QUERY sql-QueryHandle
000444          sql-ConnectionHandle
000445          WR-RICERCA.
000446*            
000447*
000448     SQL START QUERY sql-QueryHandle.
000449*
000450          IF NOT sql-OK
000451             PERFORM TQ THRU TQE.
000452*
000453      SQL FETCH ROW sql-QueryHandle
000454       
000455       IF sql-OK
000456         SQL GET DATA sql-QueryHandle
000457             "Numero"   WS-NUMERO   OMITTED
000458             "Nome"     WS-NOME     OMITTED
000459             "Via"      WS-VIA      OMITTED
000460             "Citta"    WS-CITTA    OMITTED
000461             "Nazione"  WS-NAZIONE  OMITTED
000462       ELSE IF sql-EndOfData
000463         DISPLAY "Nessun indirizzo trovato" LINE 16 POSITION 16
000464         ACCEPT A1 LINE 16 POSITION 75 PROMPT ECHO
000465         DISPLAY TXS LINE 16 POSITION 1
000466         GO SEL1
000467       ELSE
000468         PERFORM TQ THRU TQE
000469         GO SEL1.
000470*
000471*           
000472           
000473 SEL9.
000474     EXIT. 
000475/
000476*                 Visualizza contenuto record                               
000477*                 ---------------------------
000478 SH1.
000479     DISPLAY WS-NUMERO  LINE  3 POSITION 12
000480             WS-NOME    LINE  5 POSITION 35
000481             WS-VIA     LINE  7 POSITION 35
000482             WS-CITTA   LINE  9 POSITION 35
000483             WS-NAZIONE LINE 11 POSITION 35.
000484 SH9.
000485     EXIT.                   
000486/
000487*
000488*
000489*                 Gestione errori SQL
000490*                 -------------------
000491 TQ.
000492     IF sql-OK      GO TQE.
000493*           
000494     SQL DESCRIBE ERROR
000495     sql-Error-Description.
000496*
000497     IF sql-ErrType  = "O" MOVE "ODBC" TO TXQ-TYPE
000498        ELSE               MOVE "SQL"  TO TXQ-TYPE.
000499     MOVE sql-ErrNo                    TO TXQ-ST.
000500*              
000501     DISPLAY TXS    LINE 22 POSITION 1  
000502             TXQ    LINE 22 POSITION 1.                 
000503     ACCEPT  A1     LINE 22 POSITION 79 PROMPT.
000504     DISPLAY TXS    LINE 22 POSITION 1.
000505     IF A1     = "$"  STOP RUN.
000506     IF A1 NOT = "?" GO TQE.
000507*
000508     MOVE SPACES TO QWIN-CONTROL.
000509     STRING "WINDOW-CREATE," DELIMITED SIZE
000510            "FCOLOR=BLACK BCOLOR=BROWN"
000511            DELIMITED BY SIZE
000512             INTO QWIN-CONTROL.
000513     DISPLAY QWCB LINE QWIN-LINE POSITION QWIN-POSITION
000514             CONTROL QWIN-CONTROL.
000515     ACCEPT QWIN-STATUS FROM EXCEPTION STATUS.
000516     IF QWIN-STATUS NOT = 0 GO TQE.
000517     DISPLAY SPACES LINE 1 POSITION 1 ERASE.
000518     DISPLAY Sql-ErrMsg.
000519     ACCEPT A1 LINE 7 POSITION 79.
000520     DISPLAY QWCB CONTROL "WINDOW-REMOVE".                       
000521     IF A1     = "$"  STOP RUN.
000522 TQE.
000523     EXIT. 
000524*           
000525*                **** END MY-EX-04.CBL ****

Come prelevare questi codici

Pagina precedente

Pagina successiva

Cobol in pratica