22 mai 2002

ProCobol Oracle - Utilisation d'une séquence dans un traitement HR Access

Cet exemple de traitement HR Access utilise une séquence Oracle pour attribuer un NUDOSS unique.

Les séquences sont plus fiables que tout mécanisme applicatif pour ce qui est d'éviter les affectations de NUDOSS en double (saisie TP importante, Mises à jours batch de reprise en parallèle).

Exemple de séquence

Création sous SQL :
SQL> create sequence HR.MYSEQUENCE start with 1 increment by 1 maxvalue 9 minvalue 1 cache 2 cycle order;
SQL> select mysequence.nextval from dual;
         1


Explicitation des options :
  • cycle : pour revenir automatiquement à MINVALUE si MAXVALUE est atteint,
  • cache : nombre d'identifiants conservés en mémoire par Oracle (minimum 2),
  • order : obtenir que les identifiants soient fournis obligatoirement dans l'ordre,

Les pseudocolonnes CURRVAL et NEXTVAL pemettent d'obtenir l'identifiant en cours ou le suivant :

SQL> select mysequence.currval from dual;
         1
SQL> select mysequence.nextval from dual;
         2
...
SQL> select mysequence.nextval from dual;
         8
SQL> select mysequence.nextval from dual;
         9
SQL> select mysequence.nextval from dual;
         1


Destruction :
SQL> drop sequence HR.MYSEQUENCE;

Création de la séquence NUDOSS pour ZO

SQL> create sequence HR.NEW_NUDOSS_FOR_ZO start with 1 increment by 1 maxvalue 999999999 minvalue 1 cache 2 cycle order;

Création du traitement BNK contexte TBP051

Ce contexte de BNK est dédié à l'attribution de NUDOSS.

 Contexte de Variables TBW003 du traitement XY-ZONUDO

 ---------------------------------------- Variables AA --------------
010    *    HOST-VARIABLES
020    *    --------------
030    *    <DEBSEC>SO
040      01 H-MYNBDOSS             PICTURE 9(02).
050      01 H-MYNUDOSS             PICTURE 9(09).
060    *    <FINSEC>SO
070      01 U-MYNUDOSS-FOUND       PICTURE 9(01).


Contexte de Procédures TBP033 du traitement XY-ZONUDO

 ---------------------------------------------------- Fonction BB -------------
010    N   AFFECTATION NUDOSS ZO            10 BL
020    *
030    *   UTILISATION DE LA SEQUENCE
040    *   HR.NEW_NUDOSS_FOR_ZO
045    *   ET LECTURE DE ZO00
050    M   ZERO U-MYNUDOSS-FOUND
 ---------------------------------------------------- Fonction BF -------------
010    N   BOUCLE DE REHERCHE NUDOSS LIBRE  20 DW U-MYNUDOSS-FOUND = ZERO
020    *
030    *   SELECT NEXTVAL -----------------
040    *   <DEBSUB>RDTCOM
050    EXQ SELECT
060        %1.NEW_NUDOSS_FOR_ZO.NEXTVAL
070        INTO           :H-MYNUDOSS
080        FROM DUAL
090    *   <FINSUB>
092    COB DISPLAY "<DIGIX> Lecture Nextval "
094        "(" SQLCODE ") = " H-MYNUDOSS
100    ERR 0000015SQLCODE                   99 IT SQLCODE NOT= ZERO
110    GT  10
120    *   CTRL NUDOSS LIBRE -------------- 99 BL
130    *   <DEBSUB>RDTCOM
140    EXQ SELECT
150        COUNT(*) INTO  :H-MYNBDOSS
160        FROM %1.ZO00
170        WHERE NUDOSS = :H-MYNUDOSS
180    *   <FINSUB>
190    COB DISPLAY "<DIGIX> Lecture NbDoss "
200        "(" SQLCODE ") = " H-MYNBDOSS
210    *   ERREUR TECHNIQUE --------------- 99 IT SQLCODE NOT= ZERO
220    ERR 0000025SQLCODE                      AN SQLCODE NOT= W-WP00-NOTFND
230    GT  10
231    *   NUDOSS N'EST PAS LIBRE --------- 99 IT H-MYNBDOSS NOT= ZERO
232    COB DISPLAY "<DIGIX> Retour"
233    GB  20
243    *   NUDOSS LIBRE ------------------- 99 EL
253    COB DISPLAY "<DIGIX> Fin"
263    M   1              U-MYNUDOSS-FOUND
273    M   H-MYNUDOSS     UT-NUDOCR



Rattachement du traitement a FP800 et regénération.

Tests

Test de création de dossier.

traces STTS_FP800BNM :
<DIGIX> Lecture Nextval (+0000000000) = 000000001
<DIGIX> Lecture NbDoss (+0000000000) = 00
<DIGIX> Fin


Select en base :
SQL> select * from zotd11 where timjdo > '2002-05-22-00.00.00';

    NUDOSS T TIVERR              TIMJDO              VAC CDS
---------- - ------------------- ------------------- --- ---
         1 0 0001-01-01-00.00.00 2002-05-22-11.39.44 NJP DG3



Reinitialisation de la séquence (par DROP et CREATE) et nouveau test.

traces STTS_FP800BNM :
<DIGIX> Lecture Nextval (+0000000000) = 000000001
<DIGIX> Lecture NbDoss (+0000000000) = 01
<DIGIX> Retour
<DIGIX> Lecture Nextval (+0000000000) = 000000002
<DIGIX> Lecture NbDoss (+0000000000) = 00
<DIGIX> Fin


Select en base :
SQL> select * from zotd11 where timjdo > '2002-05-22-00.00.00';

    NUDOSS T TIVERR              TIMJDO              VAC CDS
---------- - ------------------- ------------------- --- ---
         1 0 0001-01-01-00.00.00 2002-05-22-11.39.44 NJP DG3
         2 0 0001-01-01-00.00.00 2002-05-22-11.48.13 NJP DG4


Le traitement a bien vu que le NUDOSS 1 était déjà attribué et a affecté 2 au nouveau dossier.

17 mai 2002

Executer un PL/SQL dans un traitement Cobol HR

Ci joint un test d'exécution d'un PL/SQL Oracle se connectant a une base distante dans un traitement HR Access (d'un point de vue architectural, un traitement de ce genre est à proscrire car on génère un "lien fort" entre les deux applications : si l'application distante est indisponible, le traitement local est bloqué).

Prérequis pour la connexion à la base distante : le listener Oracle doit être démarré et paramétré pour les bases source et cible.

Création d'un database link vers la base éloignée

Sur la base locale, la base éloignée ayant le code "DIST",

create database link BASE_DIST connect to  HR identified by ** using 'DIST';

Test de select sur la table PP10 éloignée à partir de la base locale :
select * from PP10@BASE_DIST where CDPCOM='1';


Création du package sur la base distante

Exemple : insertion de la date système dans une table spécifique

drop table MY_TABLE
/
create table MY_TABLE (MYDATE DATE)
/
drop package MY_PACKAGE
/
create package MY_PACKAGE as
procedure UPDT_DATE;
end MY_PACKAGE;
/
create package body MY_PACKAGE as
procedure UPDT_DATE is
BEGIN
      insert into MY_TABLE values (SYSDATE);
END UPDT_DATE;
end MY_PACKAGE;
/


Test d’exécution du package a partir de la base éloignée :

SQL> begin my_package.updt_date@BASE_DIST;
  2  end;
  3  /
PL/SQL procedure successfully completed.

SQL> select sysdate from dual;
2002-05-17-14.34.18
SQL> select * from my_table@BASE_DIST;
2002-05-17-14.34.04
 

Exemple de traitement HR Access

En cas de création de dossier, on exécute la procédure stockée UPDT_DATE sur la base distante et on récupère la plus grande date dans la table distante MY_TABLE.

Working :
 Contexte de Variables TBW002 du traitement TT-TPSORA
 ---------------------------------------- Variables BB --------------
010    *    HOST-VARIABLES
020    *    --------------
030    *    <DEBSEC>SO
040      01  H-MYDATE PIC X(19).
050    *    <FINSEC>SO


Procedure :
 Contexte de Procédures TBP012 du traitement TT-TPSORA
 ---------------------------------------------------- Fonction BB -------------
010    N   EXECUTION D'UNE PROCEDURE STOCKE 10 BL
020    *   SUR UNE BASE DE DONNEES DISTANTE
030    *
040    *   PREREQUIS :
050    *   - DATABASE LINK BASE_DIST
060    *   - PACKAGE   MY_PACKAGE SUR DIST
070    *   - PROCEDURE UPDT_DATE  SUR DIST
075    COB DISPLAY "<DIGIX> ENTER TTTPSORA"
080    EXQ EXECUTE
085        BEGIN
090        MY_PACKAGE.UPDT_DATE@BASE_DIST;
100        END;
110    ERR 0000015SQLCODE                   99 IT SQLCODE NOT = ZERO
115    COB DISPLAY "<DIGIX> SQLCDE1 " SQLCODE
120    GT  10
130    EXQ SELECT                           99 BL
140        MYDATE INTO :H-MYDATE
150        FROM   MY_TABLE@BASE_DIST
160    ERR 0000025SQLCODE                   99 IT SQLCODE NOT = ZERO
162    COB DISPLAY "<DIGIX> SQLCDE2 " SQLCODE
164    GT  10
170    COB DISPLAY "<DIGIX> " H-MYDATE      99 EL


Incident a la compilation :
Les options de précompilation doivent intégrer une spécificité PL/SQL

Error at line 15886, column 24 in file FP800BNA.pco
000010     EXEC SQL    EXECUTE                                          TBP012
.......................1
PCB-S-00008, Must use option SQLCHECK=SEMANTICS(FULL) when there is embedded PL/SQL


Si l'option sqlcheck=semantics est ajoutée (fichier config, item PROFLAGS), la compilation du source affiche des warning volumineux avec un code retour bloquant :

/oracle/8.1.5/bin/procob    select_error=yes MODE=ANSI sqlcheck=SEMANTICS iname=FP800BNA.pco oname=FP800BNA.cbl

Pro*COBOL: Release 8.1.5.0.0 - Production on Fri May 17 16:26:39 2002
(c) Copyright 1999 Oracle Corporation.  All rights reserved.

System default option values taken from: /oracle/8.1.5/precomp/admin/pcbcfg.cfg

Error at line 6766, column 13 in file FP800BNA.pco
000001      EXEC SQL DECLARE CZOTD12 CURSOR FOR                         MACSYS
............1
PCB-S-00576, PLS-201: identifier 'ZOTD12' must be declared
Error at line 6766, column 13 in file FP800BNA.pco
000001      EXEC SQL DECLARE CZOTD12 CURSOR FOR                         MACSYS
............1

etc...

Il faut ajouter une seconde option userid=HR/** (fichier config, item PROFLAGS) pour permettre au précompilateur de vérifier l'existence des objets dans le dictionnaire Oracle.

En conséquence, on placera dans le fichier $SIGACS/adm/cfg/config :
PROFLAGS=select_error=yes MODE=ANSI sqlcheck=SEMANTICS userid=HR/**

Ces modifications faites, la compilation cobol se termine bien.

---
---    FP800BNA.pco  -->  FP800BNA.so
---
/oracle/8.1.5/bin/procob                                                 select_error=yes MODE=ANSI sqlcheck=SEMANTICS userid=HR/HR iname=FP800BNA.pco oname=FP800BNA.cbl

Pro*COBOL: Release 8.1.5.0.0 - Production on Fri May 17 16:59:12 2002

(c) Copyright 1999 Oracle Corporation.  All rights reserved.

System default option values taken from: /oracle/8.1.5/precomp/admin/pcbcfg.cfg

cob -C nolist -vz -C ASSIGN=EXTERNAL -C SEQUENTIAL=LINE -C IBMCOMP -C SIGN=EBCDIC -C WRITELOCK -C NOTRUNC -C NOBOUND -C PERFORM-TYPE=MF -C COPYLIST -C NORESEQ -U FP800BNA.cbl
* Micro Focus Server Express         V1.1 revision 000 Compiler
* Copyright (C) 1984-2000 MERANT International URN HXCAI/AA0/00000G

...
* Accepted - NORESEQ
* Compiling FP800BNA.cbl
* Total Messages:     0
* Data:       81196     Code:      160818
* Server Express V1.1.0 Code generator
* Copyright (C) 1984-2000 MERANT International Ltd. All rights reserved.
* Accepted - verbose
* Generating FP800BNA
* Data:       81728     Code:      264232     Literals:       13512.


A noter :
  • L'ajout de l'option userid fait que le user/password de connexion Oracle et présent dans le fichier $SIGACS/adm/cfg/config, et dans tous les compte rendus de précompilation...
  • L'ajout de l'option spellcheck=semantics impose que les tables soient créées (par RBH, RBF) avant la génération physique des programmes (par RBG, RBA).

L'executable fonctionne.
On trouve dans les traces après exécution :

<DIGIX> ENTER TTTPSORA
<DIGIX> 2002-05-17-16.23.00

SQL> select * from MY_TABLE@BASE_DIST;  
2002-05-17-16.23.00