je me suis souvenu de nombreuses discussions avec des collègues et également de nombreux plantages, et par conséquent de nombreuses interventions généralement casse-tête du fait que le code en cause était écrit par un autre qui bien sûr, n'était plus là...
Vous aurez reconnu, grâce au titre sans doute, que je parle de l'appareillage des fichiers avec mise à jour. J'imagine que ce sujet a du être abordé de nombreuses fois mais comme il m'intéresse particulièrement, j'ai voulu réaliser un programme opérationnel simple mais suffisamment complet pour être mis en exploitation et servir éventuellement de squelette à des réalisations réelles. Je ne sais pas comment ce type de traitement est réalisé de nos jours, peut-être suis-je à coté de la plaque, à vous de me le dire.
Le cas traité est un cas classique : un fichier permanent mis à jour par un fichier mouvement.
Les deux sont triés sur l'indicatif d'appareillage qui sera 0 ou 1 permanent pour 0 ou n mouvements.
La mise à jour est simple:
- Création du permanent si mouvement seul
- Reconduction du permanent sans mouvement
- Mise à jour du permanent si correspondance de mouvement
- Mise à jour particulière pour le premier d'un groupe
- Mise à jour générale pour tous les enregistrements du groupe
Je vous laisse le découvrir et j'attends vos réactions.
Merci.
Le pack fourni contient:
- Le cobol
- Les fichiers entrées et sorties des différents tests (5 tests)
- Les listes réalisées au cours des 5 tests
Je n'ai pas inclus de doc, car le programme est suffisamment simple et documenté pour s'en passer.
Je passais dans le coin COBOL, vraiment par hasard et par nostalgie.
Coboliste de 1971 à 1985, j’ai été amené à développer de 1991 à 2007 avec le SGBD Informix. Tout le problème a été de transcrire mes acquis coboliste en Informix. Base de Données, SQL, pas de « GO TO » et pas de « PERFORM » ! J’ai dû m’adapter… Facile, avec une boucle « DO » et un aiguillage ! Très franchement, j’ai regretté mon « PERFORM ». Bon, à côté de ça, pas de lectures… J’ai également dû m’adapter.
1ères réactions
Préfixer « FIC » toutes les étiquettes logiques de fichier ne sert strictement à rien, ça coûte inutilement 3 caractères.
Les étiquettes logiques du COBOL deviennent les noms des tables de la BDD.
La norme SQL veut que les noms d’attributs soient préfixés du nom de la table.
nom-table.nom-attribut
Dans cet esprit, je propose non pas de suffixer les noms de données de l’étiquette logique mais l’inverse, de les préfixer de cette étiquette logique. C’est également vrai pour la Working. Je travaillais déjà comme ça en COBOL.
J’ai remplacé le séparateur « . » du SQL par « _ »
AVANT
009100 FD FICPMT RECORD CONTAINS 24 CHARACTERS.
009200 01 ART-PMT.
009300 05 INDIC-PMT PIC X(04).
009400 05 DTMAJ-PMT PIC 9(06).
009500 05 MONT1-PMT PIC 9(07).
009600 05 MONT2-PMT PIC 9(07).
APRÈS
009100 FD PMT RECORD CONTAINS 24 CHARACTERS.
009200 01 PMT_ART.
009300 05 PMT_INDIC PIC X(04).
009400 05 PMT_D_MAJ PIC 9(06).
009500 05 PMT_MONTANT_1 PIC 9(07).
009600 05 PMT_MONTANT_2 PIC 9(07).
EN SQL :
{ pmt (pmt) -----------------------------------------------------------------}
create table pmt
(
indic char(4),
d_maj date,
mont1 integer,
mont2 integer,
) ;
grant all on pmt to osmose;
grant select on pmt to public;
grant update on pmt to public;
grant insert on pmt to public;
grant delete on pmt to public;
{------------------------------------------------------------------------------}
Dans un programme, ça donne ça :
{==============================} SELECT UNIQUE {==============================}
pmt.indic pmt_indic,
pmt.d_maj pmt_d_maj,
pmt.montant_1 pmt_montant_1,
pmt.montant_2 pmt_montant_2
FROM pmt,
{=============================} INTO TEMP t1; {==============================}
Etc.
Cela demande quelques explications, mais bon…
{------------------------------------------------------------------------------}
Je ne comprends pas « DTMAJ ». Si DT signifie DATE, « D » suffit. Je remplace donc par « D_MAJ ». Le radical « D_ » signifiera toujours « DATE ».
Je ne comprends pas non plus « MONT1 », « MONT2 », « MONTA ». Pourquoi ces abréviations ?
DT, MONT, COD, etc. ça m’énerve. Désolé !
Même remarque pour les Zones en Working. Les données ne devraient pas être suffixées mais préfixées.
Je n’ai pas vu d’édition. En COBOL, je m’étais inspiré de PAC700 avec ses zones « libellés » et ses zones « structures ».
J'ai adapté l'IDENTIFICATION DIVISION dans mes programmes Informix :
Code:
1 2 3 4 5 6 7 8 9 10 11 12 13 14
{================================= cec_convoc =================================}
{ }
{ ACE : cec_convoc.ace }
{ }
{ SHELL : ../shell_1/cec_convoc (voir en fin de programme) }
{ }
{ AUTEUR : IFA2377 }
{ }
{ Objet : Convocations des candidats }
{ }
{ Date : 6 Mai 1992 }
{ }
{==============================================================================}
… Mais tout ça, c’était avant.
02/12/2019, 00h39
Obelix84
Que l'on désire passer par une normalisation des noms d'étiquettes est certainement une bonne chose, mais ma "normalisation" personnelle permet de m'y retrouver... et elle est suffisamment explicite pour de la maintenance. Maintenant avec un bon éditeur et une rafale de CHANGE ALL on normalise comme on veut.
Et comme disait une connaissance "Les avis c'est comme les trous du cul, tout le monde en a un" phrase facilement transposable à la normalisation! (et bien d'autres choses d'ailleurs...) :mrgreen:
En postant cet exercice, mon but était surtout d'avoir des réactions concernant l'appareillage. J'ai de vifs souvenirs d'appareillages ne fonctionnant pas dans certains cas avec de multiples aiguillages un peu partout positionnés par ALTER TO PROCEED TO et des fins de fichiers ne fonctionnant pas dans tous les cas... Maintenir ces programmes n'était pas de la tarte et bien souvent plutôt que de perdre du temps à comprendre les méandres de certains esprits tortueux, et trouver quels emplâtres il fallait appliquer, j'ai carrément réécrit les programmes de A à Z!
02/12/2019, 10h22
Invité
J’balance pas, j’raconte
Bonjour,
Je reprends la formule que j’aime d’André Pousse : « J’balance pas, j’raconte ». Même si elle n'est pas tout-à-fait adaptée.
J’explique simplement comment étant coboliste au départ, j’ai pu assumer facilement ma transition vers les Bases de Données et le langage SQL.
En 1971, quand j’ai débuté, j’avais 23 ans et je me suis tout de suite démarqué de ce qui se pratiquait. Ma programmation COBOL était en quelque sorte visionnaire, je faisais déjà du SQL sans le savoir. Finalement, j’ai fait du COBOL-SQL pendant 35 ans.
À propos de la « PROCEDURE », (clause « FORMAT » dans mon compilateur Informix), j’ai pu conserver la même structure LCP.
Les « DEBUT TRAITEMENT », « TRAITEMENT » et « FIN TRAITEMENT » se sont mués en clauses « BEFORE GROUP OF », « ON EVERY ROW » et « AFTER GROUP OF ».
Excuse-moi si je suis un peu vif dans… mon avis. Je suis particulièrement sensible à la forme. Pour répondre à ton interrogation « comment ce type de traitement est réalisé de nos jours » je dirais qu’en gestion, les fichiers plats se sont transformés en tables de BDD et le COBOL, en SQL.
Le traitement en lui-même n’est qu’un problème d’algorithmie. En principe, il ne devrait pas être daté. Pour moi, un algorithme est indépendant du langage. Logique et langage sont deux approches qui se superposent pour composer le programme. Même si dans la réalité d’aujourd’hui, on parle d’algorithme pour dire programme. De même qu’on a transformé l’organigramme en algorigramme.
10/12/2019, 20h00
Invité
Tiens ! Que s’est-il passé sur la planète COBOL depuis ce demi-siècle ?
Proposer et non imposer une autre façon de penser
Citation:
Envoyé par Obelix84
Que l'on désire passer par une normalisation des noms d'étiquettes est certainement une bonne chose, mais ma "normalisation" personnelle permet de m'y retrouver...
Je ne cherche à pas à normaliser quoi que ce soit, j’exprime ce qui me gêne. S’y retrouver soi-même, c’est la moindre des choses ! Mais ce n’est quand même pas le seul but, le véritable but c’est que n’importe qui puisse s’y retrouver, donc de faciliter la lecture, de faire preuve d’empathie cognitive.
Citation:
Envoyé par IFA2377
Préfixer « FIC » toutes les étiquettes logiques de fichier ne sert strictement à rien, ça coûte inutilement 3 caractères.
Question fondamentale en matière d’écriture : sa nécessité
Dans son sketch "Les oranges" Fernand Raynaud aborde une question fondamentale en matière d’écriture : sa nécessité.
Le principal défaut des développeurs, c’est d’en rajouter inutilement des tonnes. Pas facile de rester simple, sobre, pur.
Citation:
Envoyé par Obelix84
"Les avis c'est comme les trous du cul, tout le monde en a un", phrase facilement transposable à la normalisation !
L’objectif d’une discussion c’est de faire partager son expérience, ses idées. Ce n’est pas un avis qui s’oppose à un autre. Plusieurs membres et invités qui ne se manifestent pas, consultent les discussions et notamment celle-ci (à mon grand étonnement !). Un avis n’est pas qu’une réponse à un seul interlocuteur mais un discours qui s’adresse à l’ensemble de la communauté. Une discussion n’est qu’un prétexte pour apporter une plus-value à un sujet. Je rédige mes rares interventions avec réflexion, autocensure, concision, références, mise en page, orthographe, vocabulaire, grammaire, et toujours le souci d’être positif, d’apporter quelque chose de constructif, d’exploitable.
Aparté : à propos de vocabulaire, pour trouver le mot juste, je consulte régulièrement le site http://www.synonymo.fr/.
Et à propos de communication : je citais Bertrand PICCARD dans une discussion…
Citation:
Envoyé par IFA2377
Comme nous négligeons de nous enquérir de ce que l’autre comprend, nous vivons régulièrement dans des mondes parallèles. Il nous appartient de choisir si nous préférons résister face à des manières différentes de fonctionner ou développer la liberté de découvrir d’autres façons de penser.
Dites-moi ce que vous pensez de mon code et si mes techniques vieilles de 30 ans sont encore d'actualité et ce qu'il me faudrait améliorer pour être crédible de nos jours comme développeur.
Tu attendais des réactions, non ? En m’aventurant sur ce forum, je me demandais « Tiens ! Que s’est-il passé sur la planète COBOL depuis ce demi-siècle ? ».
Quand je regarde un programme, je comprends immédiatement la psychologie de son auteur. C’est comme le graphologue qui déduit les caractéristiques psychologiques de la personnalité d’un individu à partir de l’observation de son écriture manuscrite.
Au premier regard, je comprends ta réflexion que tu commentes toi-même par cette remarque : « Ma "normalisation" personnelle permet de m'y retrouver ».
Il y a une certaine cohérence entre tes deux programmes, mais ta réflexion ne semble s’adresser qu’à toi-même. Je ne perçois pas suffisamment de recul, d’universalité, de temporalité, de convivialité, d’empathie cognitive. Pour évoquer une métaphore, je dirais que quand tu ouvres une porte, tu ne regardes pas derrière toi pour t’assurer que tu peux la laisser se refermer sans gêner quelqu’un.
Ta programmation manque de globalité, c’est-à-dire que pour comprendre, il ne faut pas lâcher le morceau.
Un PERFORM, c’est deux GO TO.
APP01P0N : 32 PERFORM, soient 64 GO TO pour 167 instructions.
EXO : 52 PERFORM, soient 104 GO TO pour 305 instructions.
Des PERFORM de PERFORM de PERFORM d’une poignée d’instructions, voire d’une seule instruction. Des PERFORM appelés qu’une seule fois. Bref, c’est un véritable assemblage de poupées russes. Garder le fil devient une chasse au trésor. Et ce ne sont que de tous petits programmes. Un programme de gestion devrait se lire comme un roman et ce n’est pas le cas. La préoccupation principale n’est manifestement pas de faciliter la lecture. Ainsi, on perçoit difficilement la démarche algorithmique LCP par traitements.
Cela signifie que pour un même identifiant, tu traites distinctement le premier item puis les éventuels suivants 0,n. En clair, le traitement est bissé, un dans le Début-Traitement et l’autre dans le T-Traitement. Ça n’apparait pas au premier coup d’œil, pour le voir, il faut remplacer les PERFORM par leur contenu.
Conséquence : nécessité de prévoir une zone de stockage du premier mouvement d’un groupe de même identifiant (lignes 013700 à 014100).
Abréviation des noms de données, excès de PERFORM : ça rappelle la programmation assembleur des années 60 où l’objectif était de réduire au maximum le nombre de caractères et le nombre d’instructions. Il importe plus de lire aisément que d’économiser des caractères et des instructions.
Numéros de ligne : C’est un reste de la carte perforée. Ces numéros servaient à pouvoir remettre les cartes perforées dans l’ordre quand on les faisait tomber. Le risque était réel, elles étaient rassemblées par un élastique et manipulées de nombreuse fois, notamment par l’opérateur-pupitreur pour la compilation. Il me semble qu’autrefois ils étaient à droite (8 derniers caractères). J’ai oublié comment étaient utilisés les 6 premiers caractères. Ces numéros pourraient être supprimés. Rien que pour ça, COBOL parait obsolète. Ils ne servent à rien sinon à gêner la lecture.
D’évoquer les cartes perforées me rappelle certains collègues qui ajoutaient des cartes octales à leurs programmes compilés pour éviter de recompiler ; pratique courante avant les années 70, je n’y ai pour ma part jamais eu recours.
MAJUSCULES / minuscules : J’ai vu que l’on pouvait utiliser les minuscules. Sous Unix/Informix, on privilégie les minuscules. Dans ma programmation Informix, j’avais adopté les majuscules pour les mots-clés (instructions) et les minuscules pour les noms de données. J’ai tenté de faire la même chose pour ma version de ce programme APP01P0 mais de vieux réflexes cobolistes m’y ont fait renoncer.
Sous Unix, on est tellement conditionné à utiliser les minuscules que l’on n’imagine même pas la possibilité d’utiliser les majuscules. C’est par hasard (une erreur de frappe) que je me suis aperçu que le compilateur s’en accommodait. Un jour, un collègue qui passait derrière moi s’est étonné de voir que j’utilisais des majuscules dans mes programmes. Lui-même ne s’était jamais posé la question et pensait tout simplement que ce n’était pas possible. Personnellement, je ne peux plus m’en passer, c’est une façon de mettre du relief dans ma programmation. Avec COBOL, c’est l’inverse. Nous sommes conditionnés, comme les personnes qui soutiennent qu’il ne faut pas mettre de majuscules dans une adresse mail.
Anecdote : Toujours sous Unix, par habitude d’utiliser les caractères semi-graphiques sur PC, j’ai laissé échapper un Alt/180 et je me suis aperçu que mon écran affichait correctement mon caractère semi-graphique. Ça a complètement bouleversé l’ergonomie de mes écrans et de mes éditions. À l’époque, en 1991, j’étais sous Unix/SCO sur un serveur de type PC. Ça pouvait s’expliquer. Mais plus tard quand j’ai changé de serveur pour un AIX, ça m’a posé un problème. Il m’a fallu « trafiquer » le système pour qu’il accepte les caractères semi-graphiques, et encore pas tous car le nombre de caractères interchangeables est limité. Et la manipulation m’a interdit d’utiliser la couleur. Tant pis pour la couleur, j’ai préféré conserver mes caractères semi-graphiques.
Tiret / underscore : Toujours sur Unix/Informix, on privilégie l’underscore. J’ai également tenté ce choix dans ma version du programme APP01P0 pour finalement y renoncer. Certains mots-clés COBOL utilisant le tiret, mélanger tiret et underscore est assez dissuasif.
À propos de tiret, je viens de voir sur internet que les utilisateurs NetExpress pouvaient utiliser le tiret en colonne 7 pour poursuivre un texte :
Code:
1 2 3 4 5 6 7 8
01 pla-sup.
02 LINE 6 COL 10 VALUE "La valeur de 'val' est superieure ou".
02 VALUE " egale a 100".
01 pla-sup.
02 LINE 6 COL 10 VALUE "La valeur de 'val' est superieure ou
-"egale a 100".
La syntaxe est peut-être à vérifier, la fin du niveau 02 m’étonne, je sens un problème d’espace.
À propos des niveaux en FILE et WORKING : Décomposer le niveau 01 de 5 en 5 ou même de 10 en 10, c’était une pratique d'autrefois lorsque les terminaux n’existaient pas encore et donc les éditeurs.
Exemple :
Code:
1 2 3 4 5 6 7 8 9
1 personne.
2 nom PIC x(30).
2 prenom PIC x(30).
2 adresse.
3 numero PIC 9(3).
3 rue PIC x (40).
3 code postal PIC x(5).
3 ville PIC x(20).
Si je me suis intéressé à ton COBOL, c’était pour savoir si j’avais raté quelque chose depuis toutes ces années et si je pouvais découvrir une pépite ; on ne sait jamais. Parcourir le code d’un collègue avec un œil neuf permet de soulever des améliorations possible. En fait, je cherche davantage des idées de mise en page que des astuces purement techniques.
J’ai découvert l’instruction EVALUATE… END-EVALUATE qui me semble-t-il n’existait pas lors de ma période coboliste. C’est un moyen d’éradiquer le GO TO, non ?
J’ai conservé cette combinaison EVALUATE + PERFORM dans ma version du programme mais sincèrement je préférerais la combinaison IF + GO TO. Je m’interroge sur l’intérêt d’éradiquer les GO TO. Un GO TO n’a jamais fait planter un programme. Ou si c’est le cas, ce n’est pas le GO TO qui est en cause mais le programmeur. EVALUATE + PERFORM ne facilitent pas la lecture du programme. Et cette difficulté de lecture se trouve compensée par une foultitude de commentaires.
J’ai dû oublier les DECLARATIVES, je ne m’en souviens plus, pourtant je crois me souvenir du FILE STATUS, du coup je ne comprends pas trop l’instruction CALL GESTFST.
Je ne connaissais pas non plus les deux dernières instructions (RETOUR. GOBACK. et END PROGRAM APP01P0N.), j’en était resté au STOP RUN.
J’aime revisiter un programme, confronter deux façons de développer, comprendre le processus de pensé de l’auteur, comprendre ce qui gêne ma lecture. J’ai donc réécrit ce programme, tel que je l’aurais programmé autrefois et tel que je le programmerais encore aujourd’hui d’ailleurs.
Je ne comprends pas le paragraphe DISPLAY-ERR qui se réfère à un code erreur jamais renseigné.
J’ai pu oublier un point ou mis un point où il ne fallait pas. J’ai perdu mes réflexes de coboliste.
IDENTIFICATION DIVISION.
PROGRAM-ID. APP01P0N.
AUTHOR. OBELIX84.
*OBJET. Création d’un OUT depuis le permanent PMT et le Mouvement MVT.
*==============================================================================*
* *
* - Sur PC (DOS) liens aux fichiers réels par variables envt *
* *
* Exemple : *
* *
* set FICPMT=E:\FIC\FICPMT1 *
* set FICMVT=E:\FIC\FICMVT1 *
* *
* rem appel au pgm (display sur E:\FIC\APP1.LST) *
* app01P0n > E:\FIC\APP1.LST *
* *
* - Gestion des erreurs fichiers par déclaratives *
* *
*==============================================================================*
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. PC WITH DEBUGGING MODE.
OBJECT-COMPUTER. PC.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT OPTIONAL
FICPMT ASSIGN TO EXTERNAL PMT
ORGANIZATION IS LINE SEQUENTIAL
FILE STATUS IS FS-PMT.
SELECT FICMVT ASSIGN TO EXTERNAL MVT
ORGANIZATION IS LINE SEQUENTIAL
FILE STATUS IS FS-MVT.
SELECT FICOUT ASSIGN TO EXTERNAL OUT
ORGANIZATION IS LINE SEQUENTIAL
FILE STATUS IS FS-OUT.
DATA DIVISION.
FILE SECTION.
FD PMT RECORD CONTAINS 24 CHARACTERS.
01 PMT-ART.
05 PMT-INDICATIF PIC X(04).
05 PMT-D-MAJ PIC 9(06).
05 PMT-MONTANT-1 PIC 9(07).
05 PMT-MONTANT-2 PIC 9(07).
FD MVT RECORD CONTAINS 10 CHARACTERS.
01 MVT-ART.
05 MVT-INDICATIF PIC X(04).
05 MVT-C-MONTANT PIC X(01).
05 MVT-MONTANT PIC 9(05).
FD OUT RECORD CONTAINS 24 CHARACTERS.
01 OUT-ART.
05 OUT-INDICATIF PIC X(04).
05 OUT-D-MAJ PIC 9(06).
05 OUT-MONTANT-1 PIC 9(07).
05 OUT-MONTANT-2 PIC 9(07).
WORKING-STORAGE SECTION.
01 FS-PMT PIC X(02) VALUE SPACES.
01 FS-MVT PIC X(02) VALUE SPACES.
01 FS-OUT PIC X(02) VALUE SPACES.
01 NOM-PMT PIC X(08) VALUE "FICPMT".
01 NOM-MVT PIC X(08) VALUE "FICMVT".
01 NOM-OUT PIC X(08) VALUE "FICOUT".
01 GESTFST PIC X(07) VALUE "GESTFST".
01 RC PIC S9(05) VALUE ZERO.
01 D-TODAY PIC 9(06) VALUE ZERO.
01 PMTLU-ART.
05 PMTLU-INDICATIF PIC X(04).
05 PMTLU-D-MAJ PIC 9(06).
05 PMTLU-MONTANT-1 PIC 9(07).
05 PMTLU-MONTANT-2 PIC 9(07).
01 MVTLU-ART.
05 MVTLU-INDICATIF PIC X(04).
05 MVTLU-C-MONTANT PIC X(01).
05 MVTLU-MONTANT PIC 9(05).
01 OUTWS-ART.
05 OUTWS-INDICATIF PIC X(04).
05 OUTWS-D-MAJ PIC 9(06).
05 OUTWS-MONTANT-1 PIC 9(07).
05 OUTWS-MONTANT-2 PIC 9(07).
01 NB_BILANS.
05 NB-PMT-LU PIC S9(06) COMP VALUE ZERO.
05 NB-PMT-ADD PIC S9(06) COMP VALUE ZERO.
05 NB-PMT-MAJ PIC S9(06) COMP VALUE ZERO.
05 NB-MVT-LU PIC S9(06) COMP VALUE ZERO.
05 NB-OUT PIC S9(06) COMP VALUE ZERO.
01 LIB-ERREUR.
05 C-ERREUR PIC 9(02).
05 FILLER PIC X(01).
05 L-ERREUR PIC X(70).
01 DSP-ERREUR.
05 DSP-ERREUR-1 PIC X(13).
05 FILLER PIC X(01) VALUE SPACE.
05 DSP-ERREUR-2 PIC X(70).
01 ERR-NAT.
05 ERR-NAT1 PIC X(13) VALUE "---APP01P0N--".
05 ERR-NAT9 PIC X(13) VALUE "***APP01P0N**".
PROCEDURE DIVISION.
DECLARATIVES.
ERREUR-PMT SECTION.
USE AFTER STANDARD ERROR PROCEDURE ON PMT.
IF FS-PMT NOT = ""
CALL GESTFST USING "PMT" FS-PMT RC
END-IF.
ERREUR-MVT SECTION.
USE AFTER STANDARD ERROR PROCEDURE ON MVT.
IF FS-MVT NOT = ""
CALL GESTFST USING "MVT" FS-MVT RC
END-IF.
ERREUR-OUT SECTION.
USE AFTER STANDARD ERROR PROCEDURE ON OUT.
IF FS-OUT NOT = ""
CALL GESTFST USING "OUT" FS-OUT RC
END-IF.
END DECLARATIVES.
MAIN-PROC SECTION.
P020-D-INDICATIF.
PERFORM WITH TEST BEFORE UNTIL PMTLU-INDICATIF = MVTLU-INDICATIF
AND PMTLU-INDICATIF = HIGH-VALUE
EVALUATE TRUE
*P030-T-PMTLU.
WHEN PMTLU-INDICATIF < MVTLU-INDICATIF
MOVE PMTLU-ART TO OUTWS-ART
PERFORM WRITE-OUT
PERFORM READ-PMT
*P040-D-MVTLU.
WHEN PMTLU-IDICATIF > MVTLU-INDICATIF
MOVE MVTLU-INDICATIF TO OUTWS-INDICATIF
MOVE D-TODAY TO OUTWS-D-MAJ
MOVE ZERO TO OUTWS-MONTANT-1
OUTWS-MONTANT-2
*P050-T-MVT-C-MONTANT.
PERFORM UNTIL MVTLU-INDICATIF = OUTWS-INDICATIF
EVALUATE MVTLU-C-MONTANT
WHEN "1" ADD MVTLU-MONTANT TO OUTWS-MONTANT-1
WHEN "2" ADD MVTLU-MONTANT TO OUTWS-MONTANT-2
END-EVALUATE
PERFORM READ-MVT
*P060-F-MVTLU.
ELSE
PERFORM WRITE-OUT
ADD 1 TO NB-PMT-ADD
END-IF
END-PERFORM.
*P070-D-PMTLU-ET-MVTLU.
WHEN PMTLU-INDICATIF = MVTLU-INDICATIF
MOVE PMTLU-ART TO OUTWS-ART
MOVE D-TODAY TO OUTWS-D-MAJ
*P080-T-MVT-C-MONTANT.
PERFORM UNTIL MVTLU-INDICATIF = OUTWS-INDICATIF
EVALUATE MVTLU-C-MONTANT
WHEN "1" ADD MVTLU-MONTANT TO OUTWS-MONTANT-1
WHEN "2" ADD MVTLU-MONTANT TO OUTWS-MONTANT-2
END-EVALUATE
PERFORM READ-MVT
*P090-F-PMTLU-ET-MVTLU.
ELSE
PERFORM WRITE-OUT
ADD 1 TO NB-PMT-MAJ
END-IF
END-PERFORM.
PERFORM READ-PMT.
*P100-F-INDICATIF.
END-EVALUATE
END-PERFORM.
P110-F-PROG.
MOVE ZERO TO RC.
CLOSE PMT.
IF FS-PMT NOT = ""
MOVE "91 PROBLEME AU CLOSE FICPMT " TO L-ERREUR
PERFORM DISPLAY-ERR
END-IF.
CLOSE MVT.
IF FS-MVT NOT = ""
MOVE "91 PROBLEME AU CLOSE FICMVT " TO L-ERREUR
PERFORM DISPLAY-ERR
END-IF.
CLOSE OUT.
IF FS-OUT NOT = ""
MOVE "91 PROBLEME AU CLOSE FICMVT " TO L-ERREUR
PERFORM DISPLAY-ERR
END-IF.
DISPLAY ERR-NAT1 " NB ENREG PMT LUS =" NB-PMT-LU.
DISPLAY ERR-NAT1 " NB ENREG PMT CREES =" NB-PMT-ADD.
DISPLAY ERR-NAT1 " NB ENREG PMT M-A-J =" NB-PMT-MAJ.
DISPLAY ERR-NAT1 " NB ENREG MVT LUS =" NB-MVT-LU.
DISPLAY ERR-NAT1 " NB ENREG PMT ECRITS =" NB-OUT.
GO TO RETOUR.
READ-PMT.
MOVE SPACES TO PMTLU-ART.
READ PMT INTO PMTLU-ART
AT END MOVE HIGH-VALUE TO PMTLU-INDICATIF.
IF FS-PMT NOT = "" AND NOT = "10"
MOVE "93 PROBLEME AU READ PMT " TO L-ERREUR
PERFORM DISPLAY-ERR
END-IF.
IF PMTLU-INDICATIF NOT = HIGH-VALUE
ADD 1 TO NB-PMT-LU
END-IF.
READ-MVT.
MOVE SPACES TO ART-MVT-LU.
READ FICMVT INTO ART-MVT-LU
AT END MOVE HIGH-VALUE TO MVTLU-INDIC.
IF FS-MVT NOT = "" AND NOT = "10"
MOVE "93 PROBLEME AU READ MVT " TO L-ERREUR
PERFORM DISPLAY-ERR
END-IF.
IF MVTLU-INDICATIF NOT = HIGH-VALUE
ADD 1 TO NB-MVTLU
END-IF.
WRITE-OUT.
WRITE OUT-ART FROM OUTWS-ART.
IF FS-OUT NOT = ""
MOVE "93 PROBLEME AU WRITE OUT " TO L-ERREUR
PERFORM DISPLAY-ERR
END-IF.
ADD 1 TO NB-OUT.
DISPLAY-ERR.
MOVE SPACES TO DSP-ERREUR.
MOVE L-ERREUR TO DSP-ERREUR-2.
EVALUATE C-ERREUR
*==============================================================================*
* *
* C-ERREUR (COD-ERR) est testé mais jamais renseigné. Est-ce normal ? *
* *
*==============================================================================*
WHEN 01 THRU 09
MOVE ERR-NAT1 TO DSP-ERREUR-1
DISPLAY DSP-ERREUR
MOVE SPACES TO DSP-ERREUR-1
DISPLAY DSP-ERREUR-1
"/ MVTLU-ART =" MVTLU-ART
WHEN 10 THRU 19
MOVE ERR-NAT9 TO DSP-ERREUR-1
DISPLAY DSP-ERREUR
MOVE SPACES TO DSP-ERREUR-1
DISPLAY DSP-ERREUR-1
"/MVTLU-ART =" MVTLU-ART
GO TO RETOUR
WHEN 20 THRU 29
MOVE ERR-NAT1 TO DSP-ERREUR-1
DISPLAY DSP-ERREUR
MOVE SPACES TO DSP-ERREUR-1
DISPLAY DSP-ERREUR-1
"/PMTLU-ART =" PMTLU-ART
WHEN 30 THRU 39
MOVE ERR-NAT9 TO DSP-ERREUR-1
DISPLAY DSP-ERREUR
MOVE SPACES TO DSP-ERREUR-1
DISPLAY DSP-ERREUR-1
"/PMTLU-ART =" PMTLU-ART
GO TO RETOUR
WHEN 40 THRU 49
MOVE ERR-NAT9 TO DSP-ERREUR-1
DISPLAY DSP-ERREUR
MOVE SPACES TO DSP-ERREUR-1
DISPLAY DSP-ERREUR-1
"/OUTWS-ART =" OUTWS-ART
GO TO RETOUR
WHEN OTHER
MOVE ERR-NAT9 TO DSP-ERREUR-1
DISPLAY DSP-ERREUR
GO TO RETOUR
END-EVALUATE.
RETOUR. GOBACK.
END PROGRAM APP01P0N.
Le source original… pour ceux qui consultent sans aller jusqu'à dézipper :
000100$SET NOTRACE
000200 IDENTIFICATION DIVISION.
000300 PROGRAM-ID. APP01P0N.
000400 AUTHOR. OBELIX84.
000500
000600*---------------------
000700* V1.0 du 27/11/2019 -
000800*-----------------------------------------------------------------
000900* - APPAREILLAGE DE FICHIERS 0,1 POUR 0,N -
001000*
001100*-----------------------------------------------------------------
001200* Infos programme
001300*
001400* - Sur PC (DOS) liens aux fichiers reels par variables envt
001500* Par exemple:
001600* set FICPMT=E:\FIC\FICPMT1
001700* set FICMVT=E:\FIC\FICMVT1
001800* rem appel au pgm (display sur E:\FIC\APP1.LST)
001900* app01P0n > E:\FIC\APP1.LST
002000*
002100* - Gestion des erreurs fichiers par declaratives
002200* - GO TO uniquement vers sortie programme (GOBACK)
002300*-----------------------------------------------------------------
002400* Appareillage classique de fichiers permanent et mouvement
002500* tries sur un indicatif donne.
002600* - Permanent (PMT) 0 ou 1 enregistrement pour un indicatif
002700* - Mouvement (MVT) 0 ou n enregistrements pour un indicatif
002800*
002900* Le traitement va consister a comparer les indicatifs et a
003000* realiser une mise … jour du fichier PMT avec le fichier MVT
003100* L'ecriture du permanent mis a jour se fera a la rupture
003200* sur l'indicatif
003300*
003400* On aura une iteration principale
003500* qui appellera 3 blocs de traitements principaux
003600* - PMT et MVT => Mise a jour de PMT par MVT
003700* - MVT seul => Creation de PMT avec MVT
003800* - PMT seul => Reconduction de PMT avec maj specifique
003900*
004000* 3 blocs de traitements secondaires
004100* - MAJ specifique au premier d'un groupe de meme indicatif
004200* - MAJ commune a tous les mouvements d'un groupe
004300* - Boucle de relecture pour traiter tous les mouvements du groupe
004400*
004500*-----------------------------------------------------------------
004600* Le traitement est simple. L'appareillage se fait sur l'indicatif
004700* - MVT seul
004800* On cree un PMT avec le premier MVT sans correspondance
004900* Les autres MVT seront cumules sur le PMT (voir MVT + PMT)
005000* - PMT seul
005100* On reconduit le PMT a l'identique
005200* - MVT + PMT
005300* On cumule le montant dans l'une des 2 zones montant
005400* suivant le code ventilation qui contiendra 1 ou 2
005500* 1er montant pour code 1 - 2eme montant pour code 2
005600*
005700* En reel le premier passage se fera avec le fichier PMT absent
005800* ou vide (cas sous DOS) ce qui permettra de le creer
005900*-----------------------------------------------------------------
006000
006100 ENVIRONMENT DIVISION.
006200 CONFIGURATION SECTION.
006300*=====================
006400 SOURCE-COMPUTER. PC WITH DEBUGGING MODE.
006500 OBJECT-COMPUTER. PC.
006600*-----------------------------------------------------------------
006700 INPUT-OUTPUT SECTION.
006800*====================
006900*----------------------------------------------------------------
007000* Les SELECT et FD sont a adapter suivant l'environnement
007100* MAINFRAME ou autre. Celui-ci fonctionne avec du DOS sur PC
007200*----------------------------------------------------------------
007300 FILE-CONTROL.
007400 SELECT OPTIONAL
007500 FICPMT ASSIGN TO EXTERNAL FICPMT
007600 ORGANIZATION IS LINE SEQUENTIAL
007700 FILE STATUS IS FS-PMT.
007800 SELECT FICMVT ASSIGN TO EXTERNAL FICMVT
007900 ORGANIZATION IS LINE SEQUENTIAL
008000 FILE STATUS IS FS-MVT.
008100 SELECT FICOUT ASSIGN TO EXTERNAL FICOUT
008200 ORGANIZATION IS LINE SEQUENTIAL
008300 FILE STATUS IS FS-OUT.
008400*-----------------------------------------------------------------
008500
008600 DATA DIVISION.
008700
008800 FILE SECTION.
008900*============
009000
009100 FD FICPMT RECORD CONTAINS 24 CHARACTERS.
009200 01 ART-PMT.
009300 05 INDIC-PMT PIC X(04).
009400 05 DTMAJ-PMT PIC 9(06).
009500 05 MONT1-PMT PIC 9(07).
009600 05 MONT2-PMT PIC 9(07).
009700
009800 FD FICMVT RECORD CONTAINS 10 CHARACTERS.
009900 01 ART-MVT.
010000 05 INDIC-MVT PIC X(04).
010100 05 CODEV-MVT PIC X(01).
010200 05 MONTA-MVT PIC 9(05).
010300
010400 FD FICOUT RECORD CONTAINS 24 CHARACTERS.
010500 01 ART-OUT.
010600 05 INDIC-OUT PIC X(04).
010700 05 DTMAJ-OUT PIC 9(06).
010800 05 MONT1-OUT PIC 9(07).
010900 05 MONT2-OUT PIC 9(07).
011000*
011100 WORKING-STORAGE SECTION.
011200*=======================
011300 01 FS-PMT PIC X(02) VALUE SPACES.
011400 01 FS-MVT PIC X(02) VALUE SPACES.
011500 01 FS-OUT PIC X(02) VALUE SPACES.
011600
011700 01 NOM-PMT PIC X(08) VALUE "FICPMT".
011800 01 NOM-MVT PIC X(08) VALUE "FICMVT".
011900 01 NOM-OUT PIC X(08) VALUE "FICOUT".
012000 01 GESTFST PIC X(07) VALUE "GESTFST".
012100 01 RC PIC S9(05) VALUE ZERO.
012200 01 DATE-JOUR PIC 9(06) VALUE ZERO.
012300
012400*----Zone de lecture du fichier permanent-----------------------
012500 01 ART-PMT-LU.
012600 05 INDIC-PMT-LU PIC X(04).
012700 05 DTMAJ-PMT-LU PIC 9(06).
012800 05 MONT1-PMT-LU PIC 9(07).
012900 05 MONT2-PMT-LU PIC 9(07).
013000
013100*----Zone de lecture du fichier mouvement-----------------------
013200 01 ART-MVT-LU.
013300 05 INDIC-MVT-LU PIC X(04).
013400 05 CODEV-MVT-LU PIC X(01).
013500 05 MONTA-MVT-LU PIC 9(05).
013600
013700*----Zone de stockage 1er mouvement d'un groupe de meme indic---
013800 01 ART-MVT-ST.
013900 05 INDIC-MVT-ST PIC X(04).
014000 05 CODEV-MVT-ST PIC X(01).
014100 05 MONTA-MVT-ST PIC 9(05).
014200
014300*----Zone de gestion du fichier sortie (permanent mis a jour)---
014400 01 ART-OUT-WS.
014500 05 INDIC-OUT-WS PIC X(04).
014600 05 DTMAJ-OUT-WS PIC 9(06).
014700 05 MONT1-OUT-WS PIC 9(07).
014800 05 MONT2-OUT-WS PIC 9(07).
014900
015000*----------------------------------------------------------------
015100* Stats - Ajustement : NB-PMT-LU + NB-PMT-CREE = NB-OUT-ECRIT
015200*----------------------------------------------------------------
015300 01 NB-PMT-LU PIC S9(06) COMP VALUE ZERO.
015400 01 NB-PMT-CREE PIC S9(06) COMP VALUE ZERO.
015500 01 NB-OUT-ECRIT PIC S9(06) COMP VALUE ZERO.
015600 01 NB-MVT-LU PIC S9(06) COMP VALUE ZERO.
015700
015800*----------------------------------------------------------------
015900* Gestion de l'affichage des libelles d'erreurs
016000*----------------------------------------------------------------
016100 01 LIB-ERR.
016200 05 COD-ERR PIC 9(02).
016300 05 FILLER PIC X(01).
016400 05 TXT-ERR PIC X(70).
016500 01 DSP-ERR.
016600 05 DSP1-ERR PIC X(13).
016700 05 FILLER PIC X(01) VALUE SPACES.
016800 05 DSP2-ERR PIC X(70).
016900 01 NAT1-ERR PIC X(13) VALUE "---APP01P0N--".
017000 01 NAT8-ERR PIC X(13) VALUE "...........LU".
017100 01 NAT9-ERR PIC X(13) VALUE "***APP01P0N**".
017200
017300 PROCEDURE DIVISION.
017400*===================
017500*----------------------------------------------------------------
017600* La gestion des erreurs fichiers se fait par DECLARATIVES
017700* Le module GESTFST ne fait que decortiquer le FILE STATUS
017800* informe de l'erreur par un display et renvoie un RC
017900* Voir ce programme pour la nature du RC
018000*
018100* Dans ce programme en sortie de DECLARATIVES on retourne
018200* systematiquement au traitement appelant (FILE SATUS inchange)
018300* Il faut donc tester le FILE-STATUS en retour
018400* - OPEN/CLOSE erreur si FS autre que "00"
018500* - READ erreur si FS autre que "00" ou "10"
018600* - WRITE erreur si FS autre que "00"
018700*
018800* Les declaratives sont appelees s'il y a un incident sur une
018900* operation I/O (OPEN/CLOSE/READ/WRITE).
019000*
019100*----------------------------------------------------------------
019200 DECLARATIVES.
019300 ERREUR-FICPMT SECTION.
019400 USE AFTER STANDARD ERROR PROCEDURE ON FICPMT.
019500 IF FS-PMT NOT = "00"
019600 CALL GESTFST USING "FICPMT" FS-PMT RC
019700 END-IF.
019800*----------------------------------------------------------------
019900 ERREUR-FICMVT SECTION.
020000 USE AFTER STANDARD ERROR PROCEDURE ON FICMVT.
020100 IF FS-MVT NOT = "00"
020200 CALL GESTFST USING "FICMVT" FS-MVT RC
020300 END-IF.
020400*----------------------------------------------------------------
020500 ERREUR-FICOUT SECTION.
020600 USE AFTER STANDARD ERROR PROCEDURE ON FICOUT.
020700 IF FS-OUT NOT = "00"
020800 CALL GESTFST USING "FICOUT" FS-OUT RC
020900 END-IF.
021000 END DECLARATIVES.
021100*-----------------------------------------------------------------
021200
021300 MAIN-PROC SECTION.
021400*================================================================
021500* Cinematique generale
021600*================================================================
021700D READY TRACE.
021800 DEBUT.
021900 PERFORM INITIALISATIONS-DEBUT-PGM.
022000 PERFORM TRAITEMENT-PGM.
022100 PERFORM TRAITEMENT-FINAL-PGM.
022200 FIN. GO TO RETOUR.
022300
022400*================================================================
022500* Initialisations de debut de programme
022600* - Ouverture des fichiers
022700* - Lire le fichier permanent
022800* - Lire le fichier mouvement
022900*================================================================
023000 INITIALISATIONS-DEBUT-PGM.
023100 MOVE ZERO TO RC.
023200 ACCEPT DATE-JOUR FROM DATE.
023300
023400 OPEN INPUT FICPMT.
023500 IF FS-PMT NOT = "00"
023600 MOVE "90 PROBLEME A L'OPEN FICPMT " TO LIB-ERR
023700 PERFORM DISPLAY-ERR
023800 END-IF.
023900
024000 OPEN INPUT FICMVT.
024100 IF FS-MVT NOT = "00"
024200 MOVE "90 PROBLEME A L'OPEN FICMVT " TO LIB-ERR
024300 PERFORM DISPLAY-ERR
024400 END-IF.
024500
024600 OPEN OUTPUT FICOUT.
024700 IF FS-OUT NOT = "00"
024800 MOVE "90 PROBLEME A L'OPEN FICOUT " TO LIB-ERR
024900 PERFORM DISPLAY-ERR
025000 END-IF.
025100
025200 PERFORM READ-FICPMT.
025300 PERFORM READ-FICMVT.
025400
025500*================================================================
025600* Traitement principal
025700* La 1ere fois il existe un permanent et un mouvement lu en WSS
025800* En fin de boucle quel que soit le cas on aura egalement un
025900* MVT et un PMT lus en attente de traitement c'est a dire les
026000* les memes conditions que la 1ere fois
026100*================================================================
026200 TRAITEMENT-PGM.
026300 PERFORM WITH TEST BEFORE UNTIL INDIC-PMT-LU = INDIC-MVT-LU
026400 AND INDIC-PMT-LU = HIGH-VALUE
026500 EVALUATE TRUE
026600 WHEN INDIC-PMT-LU = INDIC-MVT-LU
026700 MOVE ART-PMT-LU TO ART-OUT-WS
026800 PERFORM PMT-ET-MVT
026900 PERFORM READ-FICPMT
027000
027100 WHEN INDIC-PMT-LU > INDIC-MVT-LU
027200 PERFORM MVT-SEUL
027300
027400 WHEN INDIC-PMT-LU < INDIC-MVT-LU
027500 MOVE ART-PMT-LU TO ART-OUT-WS
027600 PERFORM PMT-SEUL
027700 PERFORM READ-FICPMT
027800 END-EVALUATE
027900 END-PERFORM.
028000
028100*----------------------------------------------------------------
028200* Traitement de mise a jour du PMT par MVT
028300* La zone article en WSS de FICOUT est garnie et recoit les maj
028400*----------------------------------------------------------------
028500 PMT-ET-MVT.
028600 PERFORM MISE-A-JOUR-PREMIER.
028700 PERFORM MISE-A-JOUR-TOUS.
028800 PERFORM RELIRE-MVT.
028900
029000*----------------------------------------------------------------
029100* Traitement mouvement seul. Il va y avoir creation d'un PMT
029200* ne pas oublier qu'il y a un PMT en attente
029300*----------------------------------------------------------------
029400 MVT-SEUL.
029500 PERFORM INITIALISER-PMT.
029600 PERFORM PMT-ET-MVT.
029700
029800*----------------------------------------------------------------
029900* Traitement permanent seul. on va reconduire le PMT tel quel
030000* la gestion lecture du PMT se fait dans la boucle principale
030100* ne pas oublier qu'il y a un MVT en attente
030200*----------------------------------------------------------------
030300 PMT-SEUL.
030400 PERFORM WRITE-FICOUT.
030500
030600*----------------------------------------------------------------
030700* Traitement specifique de mise a jour par un mouvement
030800* Il s'agit du 1er mouvement d'un groupe de meme indicatif
030900*----------------------------------------------------------------
031000 MISE-A-JOUR-PREMIER.
031100 MOVE DATE-JOUR TO DTMAJ-OUT-WS.
031200
031300*----------------------------------------------------------------
031400* Traitement mise a jour commun a tous les mouvements
031500* d'un groupe de meme indicatif
031600*----------------------------------------------------------------
031700 MISE-A-JOUR-TOUS.
031800 EVALUATE CODEV-MVT-LU
031900 WHEN "1" ADD MONTA-MVT-LU TO MONT1-OUT-WS
032000 WHEN "2" ADD MONTA-MVT-LU TO MONT2-OUT-WS
032100 END-EVALUATE.
032200
032300*----------------------------------------------------------------
032400* Traitement d'initialisation d'un permanent avec le premier
032500* mouvement d'un groupe de meme indicatif
032600*----------------------------------------------------------------
032700 INITIALISER-PMT.
032800 MOVE SPACES TO ART-OUT-WS.
032900 MOVE INDIC-MVT-LU TO INDIC-OUT-WS.
033000 MOVE ZERO TO MONT1-OUT-WS MONT2-OUT-WS.
033100 ADD 1 TO NB-PMT-CREE.
033200
033300*----------------------------------------------------------------
033400* Stocker le premier mouvement d'un groupe de meme indicatif
033500* Boucler en mise a jour jusqu'a la rupture d'indicatif
033600* Relire MVT
033700* Ecrire le permanent mis a jour en rupture d'indicatif
033800* sinon faire la mise a jour commune a tout le groupe
033900* En sortie de boucle le MVT lu est en attente de traitement
034000*----------------------------------------------------------------
034100 RELIRE-MVT.
034200 MOVE ART-MVT-LU TO ART-MVT-ST.
034300 PERFORM UNTIL INDIC-MVT-LU NOT = INDIC-MVT-ST
034400 PERFORM READ-FICMVT
034500 IF INDIC-MVT-LU = INDIC-MVT-ST
034600 PERFORM MISE-A-JOUR-TOUS
034700 ELSE
034800 PERFORM WRITE-FICOUT
034900 END-IF
035000 END-PERFORM.
035100
035200*================================================================
035300* Traitement sortie de programme
035400* (Fin PGM, fermetures, statistiques, etc.)
035500*================================================================
035600 TRAITEMENT-FINAL-PGM.
035700 MOVE ZERO TO RC.
035800
035900 CLOSE FICPMT.
036000 IF FS-PMT NOT = "00"
036100 MOVE "91 PROBLEME AU CLOSE FICPMT " TO LIB-ERR
036200 PERFORM DISPLAY-ERR
036300 END-IF.
036400
036500 CLOSE FICMVT.
036600 IF FS-MVT NOT = "00"
036700 MOVE "91 PROBLEME AU CLOSE FICMVT " TO LIB-ERR
036800 PERFORM DISPLAY-ERR
036900 END-IF.
037000
037100 CLOSE FICOUT.
037200 IF FS-OUT NOT = "00"
037300 MOVE "91 PROBLEME AU CLOSE FICMVT " TO LIB-ERR
037400 PERFORM DISPLAY-ERR
037500 END-IF.
037600
037700 DISPLAY NAT1-ERR " NB ENREG PMT LUS =" NB-PMT-LU.
037800 DISPLAY NAT1-ERR " NB ENREG PMT CREES =" NB-PMT-CREE.
037900 DISPLAY NAT1-ERR " NB ENREG PMT ECRITS =" NB-OUT-ECRIT.
038000 DISPLAY NAT1-ERR " NB ENREG MVT LUS =" NB-MVT-LU.
038100
038200*----------------------------------------------------------------
038300* Lecture physique du permanent en WSS via un READ INTO
038400* En fin de fichier on force l'indicatif lu a HIGH-VALUE
038500* Le traitement sera termine quand les indicatifs PMT et MVT
038600* seront tous les deux egaux a HIGH-VALUE
038700*----------------------------------------------------------------
038800 READ-FICPMT.
038900 MOVE SPACES TO ART-PMT-LU.
039000 READ FICPMT INTO ART-PMT-LU
039100 AT END MOVE HIGH-VALUE TO INDIC-PMT-LU.
039200 IF FS-PMT NOT = "00" AND NOT = "10"
039300 MOVE "93 PROBLEME AU READ FICPMT " TO LIB-ERR
039400 PERFORM DISPLAY-ERR
039500 END-IF.
039600 IF INDIC-PMT-LU NOT = HIGH-VALUE
039700 ADD 1 TO NB-PMT-LU
039800 END-IF.
039900
040000*----Pour debbuging a commenter en fonctionnement reel-----------
040100* DISPLAY NAT1-ERR " ARTICLE PMT LU="
040200* INDIC-PMT-LU " "
040300* DTMAJ-PMT-LU " "
040400* MONT1-PMT-LU " "
040500* MONT2-PMT-LU " ".
040600
040700*----------------------------------------------------------------
040800* Lecture physique du mouvement en WSS via un READ INTO
040900* En fin de fichier on force l'indicatif lu a HIGH-VALUE
041000*----------------------------------------------------------------
041100 READ-FICMVT.
041200 MOVE SPACES TO ART-MVT-LU.
041300 READ FICMVT INTO ART-MVT-LU
041400 AT END MOVE HIGH-VALUE TO INDIC-MVT-LU.
041500 IF FS-MVT NOT = "00" AND NOT = "10"
041600 MOVE "93 PROBLEME AU READ FICMVT " TO LIB-ERR
041700 PERFORM DISPLAY-ERR
041800 END-IF.
041900 IF INDIC-MVT-LU NOT = HIGH-VALUE
042000 ADD 1 TO NB-MVT-LU
042100 END-IF.
042200
042300*----Pour debbuging a commenter en fonctionnement reel-----------
042400* DISPLAY NAT1-ERR " ARTICLE MVT LU="
042500* INDIC-MVT-LU " "
042600* CODEV-MVT-LU " "
042700* MONTA-MVT-LU " ".
042800
042900*----------------------------------------------------------------
043000* Ecriture physique du permanent apres mise a jour
043100*----------------------------------------------------------------
043200 WRITE-FICOUT.
043300 WRITE ART-OUT FROM ART-OUT-WS.
043400 IF FS-OUT NOT = "00"
043500 MOVE "93 PROBLEME AU WRITE FICOUT " TO LIB-ERR
043600 PERFORM DISPLAY-ERR
043700 END-IF.
043800 ADD 1 TO NB-OUT-ECRIT.
043900
044000*----Pour debbuging a commenter en fonctionnement reel-----------
044100 DISPLAY NAT1-ERR " ARTICLE ECRIT="
044200 INDIC-OUT-WS " "
044300 DTMAJ-OUT-WS " "
044400 MONT1-OUT-WS " "
044500 MONT2-OUT-WS " ".
044600
044700*----------------------------------------------------------------
044800* Gestion des erreurs
044900* Le libelle des erreur est dans la zone LIB-ERR
045000* Si ce libelle commence par
045100* - 01-09 Display du libelle erreur + MVT lu et on continue
045200* - 10-19 Display du libelle erreur + MVT mais on arrete
045300* - 20-29 Display du libelle erreur + PMT lu et on continue
045400* - 30-39 Display du libelle erreur + PMT lu mais on arrete
045500* - 40-49 Display du libelle erreur + OUT et on arrete
045600* - 90-99 Display du libelle erreur seul et on arrete
045700*----------------------------------------------------------------
045800 DISPLAY-ERR.
045900 MOVE SPACES TO DSP-ERR.
046000 MOVE TXT-ERR TO DSP2-ERR.
046100 EVALUATE COD-ERR
046200 WHEN 01 THRU 09
046300 MOVE NAT1-ERR TO DSP1-ERR
046400 DISPLAY DSP-ERR
046500 MOVE SPACES TO DSP1-ERR
046600 DISPLAY DSP1-ERR
046700 "/ART-MVT-LU=" ART-MVT-LU
046800
046900 WHEN 10 THRU 19
047000 MOVE NAT9-ERR TO DSP1-ERR
047100 DISPLAY DSP-ERR
047200 MOVE SPACES TO DSP1-ERR
047300 DISPLAY DSP1-ERR
047400 "/ART-MVT-LU=" ART-MVT-LU
047500 GO TO RETOUR
047600
047700 WHEN 20 THRU 29
047800 MOVE NAT1-ERR TO DSP1-ERR
047900 DISPLAY DSP-ERR
048000 MOVE SPACES TO DSP1-ERR
048100 DISPLAY DSP1-ERR
048200 "/ART-PMT-LU=" ART-PMT-LU
048300
048400 WHEN 30 THRU 39
048500 MOVE NAT9-ERR TO DSP1-ERR
048600 DISPLAY DSP-ERR
048700 MOVE SPACES TO DSP1-ERR
048800 DISPLAY DSP1-ERR
048900 "/ART-PMT-LU=" ART-PMT-LU
049000 GO TO RETOUR
049100
049200 WHEN 40 THRU 49
049300 MOVE NAT9-ERR TO DSP1-ERR
049400 DISPLAY DSP-ERR
049500 MOVE SPACES TO DSP1-ERR
049600 DISPLAY DSP1-ERR
049700 "/ART-OUT-WS=" ART-OUT-WS
049800 GO TO RETOUR
049900
050000 WHEN OTHER
050100 MOVE NAT9-ERR TO DSP1-ERR
050200 DISPLAY DSP-ERR
050300 GO TO RETOUR
050400 END-EVALUATE.
050500
050600*--- Il est bien que RETOUR soit la derniere ligne du programme
050700 RETOUR. GOBACK.
050800 END PROGRAM APP01P0N.
STATISTIQUES WORD :
APP01P0
Obelix84
IFA2377
Pages
Mots
Caractères (espaces non compris)
Caractères (espaces compris)
Paragraphes
Lignes
PERFORM
8
2415
16605
20480
508
508
32
8
1033
6003
9750
280
349
24
Cela dit, je suis à la retraite depuis octobre 2007, soit depuis plus de 12 ans et mon COBOL remonte au début des années 80. Je suis périmé et ce que je raconte n’a donc aucune valeur.
La technicité d’un langage m’importe peu. Les idées que je défends dans ce post ne sont pas propres au COBOL. Mais je ne suis pas sûr de me faire comprendre. Un langage, c’est concret, il respecte des syntaxes et des règles. L’échange sur le sujet ne peut pas être ambigu et chacun peut s’accrocher à sa compétence acquise. Mais ce n’est pas ce qui m’intéresse même si je n’ignore pas bien sûr le langage. Ce n’est pas le cadeau mais le papier cadeau qui m’importe. Pas le fond mais la forme. Pas la technicité mais la communication.
On dit que le COBOL est verbeux. Le COBOL est lui-même du commentaire. En surajoutant des commentaires, on ne voit plus le COBOL. Pour comprendre et réécrire ce programme, j’ai commencé par supprimer tous les commentaires, tous les numéros de ligne, puis j’ai remplacé les PERFORM par leur contenu. Ouf ! On y voit plus clair.
Si j’en ai le courage, je me risquerais bien à transposer ce programme en Base de données et SQL.
12/12/2019, 10h51
escartefigue
Citation:
Envoyé par IFA2377
Aparté : à propos de vocabulaire, pour trouver le mot juste, je consulte régulièrement le site http://www.synonymo.fr/.
Sur ce point particulier, je préfère le site du CNRTL, qui propose non seulement un dictionnaire des synonymes mais aussi bien d'autres fonctionnalités
Ou encore le site du CRISCO
Sur le reste, je partage en partie, mais je n'ai pas le temps d'y répondre maintenant, il y a beaucoup de points abordés...
12/12/2019, 19h52
Invité
Transposition du programme COBOL en Base de Données et SQL
Citation:
Envoyé par escartefigue
… Sur le reste, je partage en partie, mais je n'ai pas le temps d'y répondre maintenant, il y a beaucoup de points abordés...
Oui, beaucoup de points mais je triche ! Je n’ai que ça à faire et je prépare mes interventions sous Word que je transpose ensuite dans un Billet de mon blog, que je mets en état de publication d’ébauche. Quand mon Billet est proche de la perfection, je n’ai plus qu’à faire un copier-coller du Billet vers le FORUM et je supprime mon Billet.
J’insiste sur le fait que je suis complètement obsolète et qu’il faut donc prendre mon discours avec beaucoup de recul. Cela dit, rien ne m’offusque vraiment, je reste très serein. Je ne défends pas une compétence technique car ce n’est pas ce qui m’intéresse. La technicité, ça change, ça évolue, et ça m’ennuie. En fait, quand je développe, je ne me rends même pas compte que je programme, mon esprit est totalement accaparé par la problématique et son informatisation dans sa globalité.
Je n’impose rien, j’expose ma pratique. Libre à chacun de s’en inspirer, de me piller ou d’ignorer. Il faut aussi comprendre que mon seul outil de travail, c’est Word sous Windows et ma mémoire. Je n’ai pas de SGBD, pas de compilateur.
J’avais proposé, si j’étais courageux, de transposer ce programme en Base de Données et SQL. Voilà le résultat…
{------------------------------------------------------------------------------}
{
create_bdd.sql
}
{------------------------------------------------------------------------------}
{
sql de création de toutes les tables de la BDD "mabase"
Les attributs les plus courants sont codifiés par un radical suivi du nom de la
table à laquelle ils appartiennent ou du nom de leur table référente.
Les attributs retenus sont les suivants :
+------------+----+------------------------------------------------------------+
| Numéro | n_ | l'attribut "n_pec" se lit "Numéro de la table pec" |
| Code | c_ | l'attribut "c_ec" se lit "Code de la table ec" |
| Type | t_ | etc. |
| Session | s_ | |
| Libellé | l_ | |
| Mnémonique | m_ | |
+------------+----+------------------------------------------------------------+
}
{------------------------------------------------------------------------------}
{
sql de précaution en cas de run accidentel
}
{------------------------------------------------------------------------------}
select rien
from rien;
{------------------------------------------------------------------------------}
{ pmt (permanent) -----------------------------------------------------------}
create table pmt
(
indicatif integer,
d_maj date,
montant_1 integer,
montant_2 integer
) ;
grant all on pmt to public;
{ pmt (permanent) -----------------------------------------------------------}
lock table pmt in exclusive mode;
{
drop index indicatif;
}
create unique cluster index pmt_indicatif on pmt (indicatif);
alter index pmt_indicatif to cluster;
unlock table pmt;
{ mvt (mouvements) ----------------------------------------------------------}
create table mvt
(
indicatif integer,
c_montant smallint,
montant_1 integer,
montant_2 integer
) ;
grant all on pmt to public;
{ mvt (mouvements) ----------------------------------------------------------}
lock table mvt in exclusive mode;
{
drop index indicatif;
}
create index mvt_indicatif on mvt (indicatif);
alter index mvt_indicatif to cluster;
unlock table mvt;
{------------------------------------------------------------------------------}
SIMULATION
Fichier PMT (0,1) :
0004|AAMMJJ|0001000|0000300|
0025|AAMMJJ|0001111|0000333|
Fichier MVT (1,n) :
0005|1|00050|
0005|2|00150|
0005|1|01000|
0005|1|00050|
0005|2|00210|
0020|1|00500|
0020|2|00350|
0020|1|01000|
Fichier OUT :
0004|AAMMJJ|0001000|0000300|
0005|AAMMJJ|0001100|0000360|
0020|AAMMJJ|0001500|0000350|
0025|AAMMJJ|0001111|0000333|
┌───────┐ 1,n┌───────┐
│ PMT ├─────────────┤ MVT │
└───┬───┘0,1 └───┬───┘
┌─┴─────────────────────┴─┐
│ APP01P0 │
└────────────┬────────────┘
┌───┴───┐
│ OUT │
└───────┘
┌─────────────────────────┐
│BEFORE GROUP OF indicatif│
└────────────┬────────────┘
├───────────────┐
┌────────────┴────────────┐ │
│ ON EVERY ROW │ │
└────────────┬────────────┘ │
◊───────────────┘
┌────────────┴────────────┐
│AFTER GROUP OF indicatif│
└─────────────────────────┘
Le programme :
Tout ce qui est entre accolades est du commentaire. Attention ! Les clauses obligatoires servent également de commentaires. Certaines clauses inutilisées sont réellement en commentaires mais restent présentes dans le programme par compatibilité avec tous mes programmes.
Le programme ne traite pas les totalisations (bilans) qui s’obtiennent facilement via des requêtes SQL (voir juste après le programme).
{------------------------------------------------------------------------------}
{
Nombre d’articles pmt lus
}
{------------------------------------------------------------------------------}
select count(*) nb_pmt_lu
from pmt;
{------------------------------------------------------------------------------}
{
Nombre d’articles pmt ajoutés
Nombre d’articles pmt modifiés
}
{------------------------------------------------------------------------------}
select unique
pmt.indicatif pmt_indicatif,
mvt.indicatif mvt_indicatif
from
outer pmt,
mvt
where pmt.indicatif = mvt.indicatif
into tmp;
select count(*) nb_pmt_add
from tmp
where tmp.pmt_indicatif is null;
select count(*) nb_pmt_maj
from tmp
where tmp.pmt_indicatif = tmp.mvt_indicatif;
{------------------------------------------------------------------------------}
{
MAJ_pmt.sql
}
{------------------------------------------------------------------------------}
delete
from pmt
where pmt.indicatif is not null;
load from "logname.out" insert into pmt;
alter index pmt.indicatif to cluster;
{------------------------------------------------------------------------------}
{
Nombre d’articles out
}
{------------------------------------------------------------------------------}
select count(*) nb_out
from pmt;
{------------------------------------------------------------------------------}
Statistiques Word
APP01P0
Obelix84
IFA2377
SGBD/SQL
Pages
Mots
Caractères (espaces non compris)
Caractères (espaces compris)
Paragraphes
Lignes
Lectures
Écritures
PERFORM
8
2415
16605
20480
508
508
6
2
32
8
1033
6003
9750
280
349
6
2
24
2
319
2979
4975
82
115
0
1
0
J'ai adoré le COBOL mais très franchement, quand on voit ce que permet un SGBD, je me demande comment le COBOL peut survivre. D’autant que la transition du COBOL au SGBD peut se faire facilement et rapidement. Enfin, c’est comme ça que je l’ai vécu. Il faut dire que je n’ai pas eu le choix. J’ai dû intégrer le SGBD Informix et Unix… en trois jours après six ans sans avoir développé.
12/12/2019, 20h16
escartefigue
Citation:
Envoyé par IFA2377
Oui, beaucoup de points mais je triche ! Je n’ai que ça à faire et je prépare mes interventions sous Word que je transpose ensuite dans un Billet de mon blog, que je mets en état de publication d’ébauche. Quand mon Billet est proche de la perfection, je n’ai plus qu’à faire un copier-coller du Billet vers le FORUM et je supprime mon Billet.
Ce n'est pas de la triche mais de la mise au point faite avec patience, donc rien à redire ;)
Citation:
Envoyé par IFA2377
SQL de création des tables :
Des montants de type integer sont des montants sans partie décimale, je suppose que c'est juste à titre d'exercice, sans quoi le type decimal (n,p) est en général plus adapté
Pourquoi faire des "lock table" sur des tables nouvellement créées ? le risque qu'un autre thread vienne modifier la table pendant la création des objets associés (index, alias, triger ou autre) est nul
Citation:
Envoyé par IFA2377
Les attributs les plus courants sont codifiés par un radical suivi du nom de la table à laquelle ils appartiennent ou du nom de leur table référente
J'aime bien ce type de norme que je pratique également, ça simplifie la vie de savoir, rien qu'avec le nom d'une colonne, de quelle table elle est issue (ou héritée pour les cas des clefs étrangères).
Citation:
Envoyé par IFA2377
J'ai adoré le COBOL mais très franchement, quand on voit ce que permet un SGBD, je me demande comment le COBOL peut survivre. D’autant que la transition du COBOL au SGBD peut se faire facilement et rapidement. Enfin, c’est comme ça que je l’ai vécu. Il faut dire que je n’ai pas eu le choix. J’ai dû intégrer le SGBD Informix et Unix… en trois jours après six ans sans avoir développé.
Mais ceci n'a aucun sens, COBOL est un langage de programmation, alors que les SGBD sont des gestionnaires de données, le rôle de l'un et de l'autre n'ont aucun rapport.
Le SGBD, comme son nom l'indique, gère les données et ce qui va avec (les droits, les accès concurrents, l'administration, l'intégrité, les performances et bien sûr l'accès aux données
Les programmes COBOL ou autre proposent des écrans, des états ou des fichiers à destination de l'utilisateur final.
L'un et l'autre sont nécessaires, ils ne sont en aucun cas concurrents.
12/12/2019, 21h21
Invité
Ma proposition SGBD/SQL n’est juste qu’un exercice de style
Citation:
Envoyé par escartefigue
Des montants de type integer sont des montants sans partie décimale, je suppose que c'est juste à titre d'exercice, sans quoi le type decimal (n,p) est en général plus adapté.
J’y ai réfléchi mais finalement, je me suis suis aligné sur le programme COBOL proposé par Obelix84 et son jeu d’essai. J’ai cherché à coller au plus près de son programme original pour voir ce que ça donnerait et si j’étais encore capable de le faire. On y retrouve tout ce que j’ai évoqué comme les MAJUSCULES/minuscules, les noms-tables, les noms-attributs, LCP, etc. Je me suis fait plaisir, quoi… Qu’est-ce que ça fait du bien !
Citation:
Envoyé par escartefigue
Pourquoi faire des "lock table" sur des tables nouvellement créées ?
Tout simplement parce que c’est du copier-coller de requêtes SQL que j’ai récupérées avant de prendre ma retraite.
Un LOCK était toujours prévu dans mes SQL, car je bidouillais mes tables pendant que les gestionnaires travaillaient. Quand elles étaient bloquées, elles patientaient un peu, se doutant que j’étais en train faire quelque chose. Quand le blocage durait un peu trop longtemps, elles venaient aux nouvelles. En fait, c’était un prétexte pour venir se ravitailler dans mon bocal de bonbons et chocolats. Elles arrivaient toutes en même temps en riant et en criant « on ne va pas bien, on a besoin de chocolat ! ». Tous les jeudi midi, je faisais mes courses pour la famille et je prévoyais de réalimenter mon bocal.
À côté de mon bocal, il y avait un poste de travail à leur disposition. C’est comme ça que mes applications évoluaient. Elles venaient, s’installaient et me racontaient ce qu’elles désiraient. J’intervenais en live et elles repartaient avec leur solution.
À l’origine, c’était un bocal pour mes deux poissons rouges quand j’étais responsable informatique. Ça calmait les excités de la hiérarchie. Et puis, je n’ai pas pu résister au besoin de développer. Responsable, c’est de la gestion comptable, de la gestion du personnel, c’est nul !
Mon SQL de création des tables n’est là que pour information.
Citation:
Envoyé par escartefigue
J'aime bien ce type de norme que je pratique également, ça simplifie la vie de savoir, rien qu'avec le nom d'une colonne, de quelle table elle est issue (ou héritée pour les cas des clefs étrangères).
Tu regardes vraiment tout ! C’est un commentaire que j’avais mis dans les SQL qui me permettaient de gérer mes BDD. il date de 1991 quand je ne savait pas encore que je pouvais utiliser les caractères semi-graphiques. Toujours du copier-coller. Pour tout te dire, pour ce SQL, j’ai pris une partie de mon SQL de création de mes tables et une autre partie de mon SQL de création des index. J’avais donc deux fichiers différents. L’objectif était de transposer en quelque sorte la FILE SECTION du programme COBOL et mieux faire comprendre le programme version SGBD/SQL.
Dans ce commentaire, "pec" signifie "personnel examens-concours" et "ec", "examens-concours" évidemment.
J'ai adopté ce concept dès mon premier programme COBOL. C'est ce que j'explique quelque part. Je ne renie pas du tout COBOL. Il a inspiré mes développements SGBD/SQL. Mes étiquettes logiques de fichiers COBOL sont devenues mes noms-de-tables et mes noms-de-données préfixés d'étiquettes logiques sont devenu mes noms-d'attributs préfixés des noms-de-tables. Quant-à l'algorithmie, j'ai conservé ma démarche LCP. C'est pourquoi je dis que j'ai fait du COBOL/SQL pendant toute ma carrière.
Citation:
Envoyé par escartefigue
Mais ceci n'a aucun sens, COBOL est un langage de programmation, alors que les SGBD sont des gestionnaires de données, le rôle de l'un et de l'autre n'ont aucun rapport.
Et le SQL, c’est bien un langage, non ? Et le programme que je propose, c’est bien un programme, non ?
Citation:
Envoyé par escartefigue
L'un et l'autre sont nécessaires, ils ne sont en aucun cas concurrents.
Sans doute, je ne suis pas en situation de juger et je ne juge pas, je m'interroge, c'est tout.
En 1977, j’avais développé un programme COBOL interactif de plus 8.000 lignes qui gérait un fichier séquentiel indexé, avec sauvegarde des transactions sur un fichier journal BEFORE et un fichier journal AFTER. C’était un début de SGBD. À l’époque, on commençait seulement à parler de DBase II et mes transactions se réalisaient sur des télétypes. Je pouvais accéder au fichier séquentiel indexé à partir d’une clé puis lire en consécutif. Je pense que les fichiers plats de cette application aurait pu tout-à-fait être transposés en tables d’un SGBD et mes programmes COBOL en écrans et programmes d’édition.
12/12/2019, 21h35
escartefigue
Citation:
Envoyé par IFA2377
En 1980, j’avais développé un programme COBOL interactif de plus 8.000 lignes qui gérait un fichier séquentiel indexé, avec sauvegarde des transactions sur un fichier journal BEFORE et un journal AFTER. C’était un début de SGBD. À l’époque, on commençait seulement à parler de DBase II et mes transactions se réalisaient sur des télétypes. Je pouvais accéder au fichier séquentiel indexé à partir d’une clé puis lire en consécutif. Je pense que les fichiers plats de cette application aurait pu tout-à-fait être transposés en tables d’un SGBD et mes programmes COBOL en écrans et programmes d’édition.
Ca remonte loin dans les archives tout ça :P
Je me souviens de la sortie de DbaseII puis Dbase3+ et enfin DbaseIV (je ne me souviens pas qu'il y ait eu d'autres versions ensuite)
Aucun des 3 n'était un vrai SGBD relationnel, mais c'était le début d'une ère et pas si mal pour l'époque ;)
16/12/2019, 00h42
Luc Orient
Bonjour,
Quelque chose m'échappe avec le programme de IFA2377 et sans doute ai je raté quelque chose d'important, mais où sont passés les ordres d'ouverture des fichiers et les ordres de lecture initiale ?
16/12/2019, 15h52
Invité
On devrait pouvoir lire un programme sans avoir besoin d’un GPS, non ?
Citation:
Envoyé par Luc Orient
Mais où sont passés les ordres d'ouverture des fichiers et les ordres de lecture initiale ?
Je suppose que tu fais référence à ma version SGBD/SQL. Tu n’as rien raté du tout. C’est géré par le compilateur. Étonnant, non ? Ça laisse perplexe ! J’ai oublié mes premiers pas avec ce SGBD/SQL et comment j’ai digéré ça. J’ai sans doute dû m’interroger également à l’époque. Mais j’ai dû m’adapter très vite, très très vite, en trois jours. Mon serveur préinstallé Unix/Informix est arrivé un matin de mi-mai 1991. J’étais dans les starting-blocks, mon expérience se limitait à une copie de fichier sous Unix, un programme d’édition Informix et une petite culture Unix/Informix qui restait d’un stage ou deux.
J’ai quand même bénéficié de trois jours d’assistance de la part d’un jeune d’une SSII, qui passait dans le coin et qui s’était donné comme mission de réaliser au moins un écran opérationnel. C’est tout. Le quatrième jour, je me suis retrouvé tout seul devant mon écran avec l'EDI et l'éditeur vi à découvrir.
J’ai écris ce source sans filet car je ne suis plus en activité mais j’ai confiance dans ce que j’ai programmé. J’ai développé plus de 1.000 programmes d’édition entre mi-mai 1991 et fin septembre 2007 (1.121 exactement).
Le source est suffixé par « .ace » et le compilateur crée un exécutable suffixé « .arc », suffixe que l’on ne précise pas à l’exécution dans le shell.
En intervenant dans cette discussion du forum COBOL, je ne pensais pas être « analysé » aussi finement et à minuit passé ! Mais c’est bien, au moins, je ne fais pas ça pour rien.
Trois approches, trois éclairages différents. Il est intéressant de regarder les statistiques de chaque version et d’en tirer des enseignements, notamment en termes de temps de développement et de temps de maintenance que l’on imagine facilement.
Un programme d’édition version SGBD/SQL peut se développer en moins d’une heure jusqu’à une petite semaine pour les plus importants. Mes plus gros programmes dépassaient les 3.000 lignes mais je ne pouvais guère aller au-delà. Une ligne de trop et le compilateur se mélangeait les crayons. Il ne disait rien à la compilation mais les résultats étaient faux. J’enlevais une ligne et les résultats étaient bons. J’ai vite compris qu’il ne fallait pas trop le titiller.
Mon premier programme d’édition faisait plus de 3.000 lignes, j’étais dans l’urgence, l’angoisse et le stress. Les utilisateurs, des enseignants, attendaient les éditions pour pouvoir partir en vacances. Je tente une exécution à 3 heures du matin et je me prends un message « out of bounds » en plein milieu de l’écran. Plus de 3.000 lignes à relire. Je suis rentré chez moi, déprimé.
Anecdote :Le lendemain matin, tout le quartier était bouclé par la police et les pompiers. Un quart d’heure après mon départ, les corses avaient fait sauter le standard où je garais mon vélo. Ils avaient attendu que je ferme ma boutique. Sans le savoir, je suis passé devant eux.
Quant au « out of bounds », il n’était pas prévu dans la documentation. Je ne savais même pas ce que ça voulais dire, j’ai dû demander à un prof d’anglais. Pas d’Abort où repérer par exemple, la raison d’un « TRAP A 45 » (transfert d’un caractère alphanumérique dans du numérique, pour ceux qui se souviennent). Ce genre d’aventures, ça calme tout de suite.
J’ai eu à écrire des programmes qui auraient nécessité bien plus de 3.000 lignes mais face au challenge, j’ai trouvé la parade. J’ai découvert une instruction fabuleuse à laquelle je ne m’étais jamais intéressé : « PRINT FILE chemin-fichier ». C’est comme ça que j’ai pu imprimer un formulaire, n’ayant plus qu'à imprimer les variables en surimpression. Génial ! J’ai dû être le seul à utiliser cette instruction car il faut savoir créer le formulaire. Et ça, c’est une autre histoire !
En comparant les données statistiques de la version d’Obelix84 avec celles de ma version SGBD/SQL, on a :
8 pages contre 2
508 lignes contre 115
6 Lectures contre aucune
2 Écritures contre une seule
32 PERFORM contre aucun
une gestion des erreurs fichiers contre rien
17 noms-paragraphes contre 3
336 lignes de procédure contre 46
4 structures itératives contre une seule
etc.
Vu comme ça et pour faire rigoureusement la même chose, ça interroge tout de même ! N’est-il pas ?
Rappel :
APP01P0
Obelix84
IFA2377
SGBD/SQL
Pages
Mots
Caractères (espaces non compris)
Caractères (espaces compris)
Paragraphes
Lignes
Lectures
Écritures
PERFORM
8
2415
16605
20480
508
508
6
2
32
8
1033
6003
9750
280
349
6
2
24
2
319
2979
4975
82
115
0
1
0
Si l’on prend le temps de jeter un œil attentif au programme SQL que j’ai proposé, je pense que n’importe qui peut le lire et le comprendre tel qu’il est, sans davantage de commentaires et sans avoir de connaissances particulières du SQL. De même d’ailleurs que ma version COBOL. Encore que j’aurais préféré programmer cette version avec des GO TO plutôt que des PERFORM. Les GO TO rendent la lecture plus fluide et pour moi, c’est ce qui importe. La profusion de PERFORM rassure peut-être mais c’est au détriment de la lisibilité. Indispensables, les noms-paragraphes du COBOL ou les clauses du SQL constituent à eux-seuls des commentaires suffisants.
Une précision tout de même concernant ma version SQL : dans la séquence « SELECT… FROM OUTER pmt… », l’option « OUTER » signifie au compilateur que la table pmt peut être vide.
Qu’un programme tourne et qu’on en parle plus n’est pas ma perception du développement et c’est ce que je ressens en décodant le programme d’Obelix84. Chaque fois que j’y retourne, je passe du temps à essayer de comprendre sans parvenir à fixer dans ma mémoire le peu que je viens de comprendre. Ainsi par exemple, j’ai voulu compter les lectures. Et bien, ce n’est pas si simple. J’en ai d’abord compté 5 alors que j’en compte 6 dans ma version COBOL. En principe, c’est le même programme, où donc est passée la sixième ? Finalement, en traçant les PERFORM, j’arrive à 6. Ça me rassure mais je me suis vu comme un enquêteur en train de borner le portable d’un malfrat.
On devrait pouvoir lire un programme sans avoir besoin d’un GPS. Son programme APP01P0 prévoit un trace ; cela révèle donc le besoin de parer une certaine difficulté à maitriser la complexité de tous ces PERFORM qui s’imbriquent les uns dans les autres.
Au risque de choquer, je n’ai vraiment eu recours à un trace que pour un shell de 500 lignes assez compliqué qui envoyait des convocations par courrier électronique. Une catégorie du personnel prétendait ne rien recevoir. Mes collègues du système ont tout épluché de leur côté et n’ont trouvé aucune faille. En fait, l’utilisation du courrier électronique était encore récente en 2002 quand j’ai mis en place cette procédure et ces personnes prétendaient ne rien recevoir parce que tout simplement, elles ne savaient pas ou ne voulaient pas l’utiliser. Pour la petite histoire, tous les chefs d’établissement d’un département ont décidé de faire grève car mes convocations par courrier électronique devaient évidemment être imprimées par leur secrétariat... Mais je raconte ma vie et je sors du sujet.
Non seulement, j’avais très rarement besoin de tracer mes programmes mais je n’avais pas besoin non plus de faire des tests unitaires. Je connais le terme mais je ne sais pas ce qu’il signifie concrètement. Là, je dois certainement en choquer plus d’un. Pourtant, c’est la réalité. Peut-être que mes outils de développements étaient simplistes, je ne sais pas. C’était du mode caractère. Internet est arrivé trop tard pour moi et je n’ai même pas eu le temps de me mettre au langage C. Alors, c’est vrai je n’ouvrais pas de boîtes de dialogue dans mes écrans et je ne transformais pas mes gestionnaires en cliqueurs.
Mes erreurs de compilation étaient généralement des erreurs de frappe facilement repérables. Je n’avais pas de temps à consacrer à rectifier des erreurs alors je m’arrangeais pour ne pas en faire et surtout pour ne pas contrarier le compilateur. Ce n’est pas plus compliqué que ça. C’est comme pour la conduite automobile, je n’ai tellement pas envie d’être confronté aux affres d’un accident que je fais ce qu’il faut pour ne pas en avoir.
Mais je parle, je parle, je ne pensais vraiment pas m’attarder dans cette discussion concernant le COBOL. J’espère ne pas vous avoir ennuyés avec mes anecdotes.
17/12/2019, 22h00
Luc Orient
Citation:
Envoyé par IFA2377
Je suppose que tu fais référence à ma version SGBD/SQL.
Oui. Effectivement.
Citation:
Tu n’as rien raté du tout. C’est géré par le compilateur. Étonnant, non ? Ça laisse perplexe !
A mon sens et selon la norme COBOL, ce programme ne peut pas fonctionner correctement ...
20/12/2019, 19h51
Invité
C’était un exercice de style ! Mais il donne à réfléchir, non ?
Rappel chronologique :
16/12/2019, 00h42
Citation:
Envoyé par Luc Orient
Quelque chose m'échappe avec le programme de IFA2377 et sans doute ai-je raté quelque chose d'important.
16/12/2019, 15h52
Citation:
Envoyé par IFA2377
Je suppose que tu fais référence à ma version SGBD/SQL.
17/12/2019, 22h00
Citation:
Envoyé par Luc Orient
Oui. Effectivement.
À mon sens et selon la norme COBOL, ce programme ne peut pas fonctionner correctement...
Je pense qu’effectivement tu as raté quelque chose.
Je disais le 10 décembre :
Citation:
Envoyé par IFA2377
Si j’en ai le courage, je me risquerais bien à transposer ce programme en Base de données et SQL.
Et le 12 décembre :
Citation:
Envoyé par IFA2377
J’avais proposé, si j’étais courageux, de transposer ce programme en Base de Données et SQL. Voilà le résultat…
Ayant pratiqué le COBOL pendant près de 15 ans, puis le SGBD/SQL Informix pendant 17 ans, j’ai expliqué comment j’ai facilement converti mes acquis COBOL en SGBD/SQL. C’est donc par curiosité qu’à partir du programme APP01P0.cbl d’Obelix84, j’ai développé cette version dans le langage à base de SQL proposé par l’EDI du SGBD Informix pour programmer des traitements batch, créer un état ou un fichier. C’est sûr que le compilateur COBOL aura du mal à digérer le langage d’Informix.
Les fichiers d’entrée et le fichier de sortie sont rigoureusement les mêmes que ceux du programme APP01P0.cbl d’Obelix84. Il n’y a donc que l’outil qui change.
Citation:
Envoyé par escartefigue
COBOL et SGBD sont nécessaires, ils ne sont en aucun cas concurrents.
Il ne s’agit pas de les mettre en concurrence, quoi que… C’était juste un exercice de style pour voir s’il était possible de faire très exactement la même chose en SGBD/SQL et de vous faire part de ma démarche. Ça n’allait pas plus loin que ça. J’en conclus que c’est tout-à-fait possible, mais visiblement, le message ne passe pas.
20/12/2019, 21h58
Luc Orient
Je parle bien du programme posté le 10/12/2019 à 20 h 00, qui se veut un programme COBOL, me semble-t-il, mais qui, à mon sens toujours, ne peut par marcher.
Qu'il y ait une solution Informix au problème posé, je veux bien, comme il y a sans doute une solution Java, une solution ADA, une solution C/C++ etc, mais nous sommes là sur le forum COBOL et on doit attendre des solution COBOL aux différents problèmes posés.
CQFD.
22/12/2019, 16h46
Invité
Petit problème de communication
Bonjour,
Désolé, mais tu m’avais dit que tu te référais à mon programme SQL. Je t’ai donc répondu en conséquence. Concernant ma version COBOL, je viens de comprendre, j’ai tout simplement oublié ou raté le copier-coller du paragraphe « Début Programme ».
SIMULATION
Fichier PMT (0,1) :
0004|AAMMJJ|0001000|0000300|
0025|AAMMJJ|0001111|0000333|
Fichier MVT (1,n) :
0005|1|00050|
0005|2|00150|
0005|1|01000|
0005|1|00050|
0005|2|00210|
0020|1|00500|
0020|2|00350|
0020|1|01000|
Fichier OUT :
0004|AAMMJJ|0001000|0000300|
0005|AAMMJJ|0001100|0000360|
0020|AAMMJJ|0001500|0000350|
0025|AAMMJJ|0001111|0000333|
┌───────┐ 1,n┌───────┐
│ PMT ├─────────────┤ MVT │
└───┬───┘0,1 └───┬───┘
┌─┴─────────────────────┴─┐
│ APP01P0 │
└────────────┬────────────┘
┌───┴───┐
│ OUT │
└───────┘
┌─────────────────────────┐
│ D-PROG │
│ │
P-010 │ │
│ READ PMT │
│ READ MVT │
└────────────┬────────────┘
├─────────────────────────────────────────────────────────┐
┌────────────┴────────────┐ │
│ D-INDICATIF │ │
P-020 │ │ │
│ PMT-INDIC :: MVT-INDIC │ │
└────────────┬────────────┘ │
┌─────────────────────────────────────◊─────────────────────────────────────┐ │
< │ > │ = │ │
│ ┌────────────┴────────────┐ ┌────────────┴────────────┐ │
│ P-040 │ D-MVT │ P-070 │ D-MVT-PMT │ │
│ └────────────┬────────────┘ └────────────┬────────────┘ │
│ ├───────────────┐ ├───────────────┐ │
┌────────────┴────────────┐ ┌────────────┴────────────┐ │ ┌────────────┴────────────┐ │ │
│ T-PMT │ │ T-C-MONTANT │ │ │ T-C-MONTANT │ │ │
P-030 │ WRITE OUT │ P-050 │ READ MVT │ │ P-080 │ READ MVT │ │ │
│ READ PMT │ │ MVT-INDIC :: OUT-INDIC │ = │ MVT-INDIC :: OUT-INDIC │ = │
└────────────┬────────────┘ └────────────┬────────────┘ │ └────────────┬────────────┘ │ │
│ ◊───────────────┘ ◊───────────────┘ │
│ ┌────────────┴────────────┐ ┌────────────┴────────────┐ │
│ │ F-MVT │ │ F-MVT-PMT │ │
│ P-060 │ WRITE OUT │ P-090 │ WRITE OUT │ │
│ │ │ │ READ PMT │ │
│ └────────────┬────────────┘ └────────────┬────────────┘ │
└─────────────────────────────────────◊─────────────────────────────────────┘ │
┌────────────┴────────────┐ │
P-100 │ F-INDICATIF │ │
└────────────┬────────────┘ non │
◊─────────────────────────────────────────────────────────┘
┌────────────┴────────────┐
P-110 │ F_PROG │
└─────────────────────────┘
IDENTIFICATION DIVISION.
PROGRAM-ID. APP01P0N.
AUTHOR. OBELIX84.
*OBJET. Création d’un OUT depuis le permanent PMT et le Mouvement MVT.
*==============================================================================*
* *
* - Sur PC (DOS) liens aux fichiers réels par variables envt *
* *
* Exemple : *
* *
* set FICPMT=E:\FIC\FICPMT1 *
* set FICMVT=E:\FIC\FICMVT1 *
* *
* rem appel au pgm (display sur E:\FIC\APP1.LST) *
* app01P0n > E:\FIC\APP1.LST *
* *
* - Gestion des erreurs fichiers par déclaratives *
* *
*==============================================================================*
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. PC WITH DEBUGGING MODE.
OBJECT-COMPUTER. PC.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT OPTIONAL
FICPMT ASSIGN TO EXTERNAL PMT
ORGANIZATION IS LINE SEQUENTIAL
FILE STATUS IS FS-PMT.
SELECT FICMVT ASSIGN TO EXTERNAL MVT
ORGANIZATION IS LINE SEQUENTIAL
FILE STATUS IS FS-MVT.
SELECT FICOUT ASSIGN TO EXTERNAL OUT
ORGANIZATION IS LINE SEQUENTIAL
FILE STATUS IS FS-OUT.
DATA DIVISION.
FILE SECTION.
FD PMT RECORD CONTAINS 24 CHARACTERS.
01 PMT-ART.
05 PMT-INDICATIF PIC X(04).
05 PMT-D-MAJ PIC 9(06).
05 PMT-MONTANT-1 PIC 9(07).
05 PMT-MONTANT-2 PIC 9(07).
FD MVT RECORD CONTAINS 10 CHARACTERS.
01 MVT-ART.
05 MVT-INDICATIF PIC X(04).
05 MVT-C-MONTANT PIC X(01).
05 MVT-MONTANT PIC 9(05).
FD OUT RECORD CONTAINS 24 CHARACTERS.
01 OUT-ART.
05 OUT-INDICATIF PIC X(04).
05 OUT-D-MAJ PIC 9(06).
05 OUT-MONTANT-1 PIC 9(07).
05 OUT-MONTANT-2 PIC 9(07).
WORKING-STORAGE SECTION.
01 FS-PMT PIC X(02) VALUE SPACES.
01 FS-MVT PIC X(02) VALUE SPACES.
01 FS-OUT PIC X(02) VALUE SPACES.
01 NOM-PMT PIC X(08) VALUE "FICPMT".
01 NOM-MVT PIC X(08) VALUE "FICMVT".
01 NOM-OUT PIC X(08) VALUE "FICOUT".
01 GESTFST PIC X(07) VALUE "GESTFST".
01 RC PIC S9(05) VALUE ZERO.
01 D-TODAY PIC 9(06) VALUE ZERO.
01 PMTLU-ART.
05 PMTLU-INDICATIF PIC X(04).
05 PMTLU-D-MAJ PIC 9(06).
05 PMTLU-MONTANT-1 PIC 9(07).
05 PMTLU-MONTANT-2 PIC 9(07).
01 MVTLU-ART.
05 MVTLU-INDICATIF PIC X(04).
05 MVTLU-C-MONTANT PIC X(01).
05 MVTLU-MONTANT PIC 9(05).
01 OUTWS-ART.
05 OUTWS-INDICATIF PIC X(04).
05 OUTWS-D-MAJ PIC 9(06).
05 OUTWS-MONTANT-1 PIC 9(07).
05 OUTWS-MONTANT-2 PIC 9(07).
01 NB_BILANS.
05 NB-PMT-LU PIC S9(06) COMP VALUE ZERO.
05 NB-PMT-ADD PIC S9(06) COMP VALUE ZERO.
05 NB-PMT-MAJ PIC S9(06) COMP VALUE ZERO.
05 NB-MVT-LU PIC S9(06) COMP VALUE ZERO.
05 NB-OUT PIC S9(06) COMP VALUE ZERO.
01 LIB-ERREUR.
05 C-ERREUR PIC 9(02).
05 FILLER PIC X(01).
05 L-ERREUR PIC X(70).
01 DSP-ERREUR.
05 DSP-ERREUR-1 PIC X(13).
05 FILLER PIC X(01) VALUE SPACE.
05 DSP-ERREUR-2 PIC X(70).
01 ERR-NAT.
05 ERR-NAT1 PIC X(13) VALUE "---APP01P0N--".
05 ERR-NAT9 PIC X(13) VALUE "***APP01P0N**".
PROCEDURE DIVISION.
DECLARATIVES.
ERREUR-PMT SECTION.
USE AFTER STANDARD ERROR PROCEDURE ON PMT.
IF FS-PMT NOT = ""
CALL GESTFST USING "PMT" FS-PMT RC
END-IF.
ERREUR-MVT SECTION.
USE AFTER STANDARD ERROR PROCEDURE ON MVT.
IF FS-MVT NOT = ""
CALL GESTFST USING "MVT" FS-MVT RC
END-IF.
ERREUR-OUT SECTION.
USE AFTER STANDARD ERROR PROCEDURE ON OUT.
IF FS-OUT NOT = ""
CALL GESTFST USING "OUT" FS-OUT RC
END-IF.
END DECLARATIVES.
MAIN-PROC SECTION.
P010-D-PROG.
MOVE ZERO TO RC.
ACCEPT D-TODAY FROM DATE.
OPEN INPUT PMT.
IF FS-PMT NOT = ""
MOVE "90 PROBLEME A L'OPEN PMT " TO L-ERREUR
PERFORM DISPLAY-ERR
END-IF.
OPEN INPUT MVT.
IF FS-MVT NOT = ""
MOVE "90 PROBLEME A L'OPEN MVT " TO L-ERREUR
PERFORM DISPLAY-ERR
END-IF.
OPEN OUTPUT OUT.
IF FS-OUT NOT = ""
MOVE "90 PROBLEME A L'OPEN OUT " TO L-ERREUR
PERFORM DISPLAY-ERR
END-IF.
PERFORM READ-PMT.
PERFORM READ-MVT.
P020-D-INDICATIF.
PERFORM WITH TEST BEFORE UNTIL PMTLU-INDICATIF = MVTLU-INDICATIF
AND PMTLU-INDICATIF = HIGH-VALUE
EVALUATE TRUE
*P030-T-PMTLU.
WHEN PMTLU-INDICATIF < MVTLU-INDICATIF
MOVE PMTLU-ART TO OUTWS-ART
PERFORM WRITE-OUT
PERFORM READ-PMT
*P040-D-MVTLU.
WHEN PMTLU-IDICATIF > MVTLU-INDICATIF
MOVE MVTLU-INDICATIF TO OUTWS-INDICATIF
MOVE D-TODAY TO OUTWS-D-MAJ
MOVE ZERO TO OUTWS-MONTANT-1
OUTWS-MONTANT-2
*P050-T-MVT-C-MONTANT.
PERFORM UNTIL MVTLU-INDICATIF = OUTWS-INDICATIF
EVALUATE MVTLU-C-MONTANT
WHEN "1" ADD MVTLU-MONTANT TO OUTWS-MONTANT-1
WHEN "2" ADD MVTLU-MONTANT TO OUTWS-MONTANT-2
END-EVALUATE
PERFORM READ-MVT
*P060-F-MVTLU.
ELSE
PERFORM WRITE-OUT
ADD 1 TO NB-PMT-ADD
END-IF
END-PERFORM.
*P070-D-PMTLU-ET-MVTLU.
WHEN PMTLU-INDICATIF = MVTLU-INDICATIF
MOVE PMTLU-ART TO OUTWS-ART
MOVE D-TODAY TO OUTWS-D-MAJ
*P080-T-MVT-C-MONTANT.
PERFORM UNTIL MVTLU-INDICATIF = OUTWS-INDICATIF
EVALUATE MVTLU-C-MONTANT
WHEN "1" ADD MVTLU-MONTANT TO OUTWS-MONTANT-1
WHEN "2" ADD MVTLU-MONTANT TO OUTWS-MONTANT-2
END-EVALUATE
PERFORM READ-MVT
*P090-F-PMTLU-ET-MVTLU.
ELSE
PERFORM WRITE-OUT
ADD 1 TO NB-PMT-MAJ
END-IF
END-PERFORM.
PERFORM READ-PMT.
*P100-F-INDICATIF.
END-EVALUATE
END-PERFORM.
P110-F-PROG.
MOVE ZERO TO RC.
CLOSE PMT.
IF FS-PMT NOT = ""
MOVE "91 PROBLEME AU CLOSE FICPMT " TO L-ERREUR
PERFORM DISPLAY-ERR
END-IF.
CLOSE MVT.
IF FS-MVT NOT = ""
MOVE "91 PROBLEME AU CLOSE FICMVT " TO L-ERREUR
PERFORM DISPLAY-ERR
END-IF.
CLOSE OUT.
IF FS-OUT NOT = ""
MOVE "91 PROBLEME AU CLOSE FICMVT " TO L-ERREUR
PERFORM DISPLAY-ERR
END-IF.
DISPLAY ERR-NAT1 " NB ENREG PMT LUS =" NB-PMT-LU.
DISPLAY ERR-NAT1 " NB ENREG PMT CREES =" NB-PMT-ADD.
DISPLAY ERR-NAT1 " NB ENREG PMT M-A-J =" NB-PMT-MAJ.
DISPLAY ERR-NAT1 " NB ENREG MVT LUS =" NB-MVT-LU.
DISPLAY ERR-NAT1 " NB ENREG PMT ECRITS =" NB-OUT.
GO TO RETOUR.
READ-PMT.
MOVE SPACES TO PMTLU-ART.
READ PMT INTO PMTLU-ART
AT END MOVE HIGH-VALUE TO PMTLU-INDICATIF.
IF FS-PMT NOT = "" AND NOT = "10"
MOVE "93 PROBLEME AU READ PMT " TO L-ERREUR
PERFORM DISPLAY-ERR
END-IF.
IF PMTLU-INDICATIF NOT = HIGH-VALUE
ADD 1 TO NB-PMT-LU
END-IF.
READ-MVT.
MOVE SPACES TO ART-MVT-LU.
READ FICMVT INTO ART-MVT-LU
AT END MOVE HIGH-VALUE TO MVTLU-INDIC.
IF FS-MVT NOT = "" AND NOT = "10"
MOVE "93 PROBLEME AU READ MVT " TO L-ERREUR
PERFORM DISPLAY-ERR
END-IF.
IF MVTLU-INDICATIF NOT = HIGH-VALUE
ADD 1 TO NB-MVTLU
END-IF.
WRITE-OUT.
WRITE OUT-ART FROM OUTWS-ART.
IF FS-OUT NOT = ""
MOVE "93 PROBLEME AU WRITE OUT " TO L-ERREUR
PERFORM DISPLAY-ERR
END-IF.
ADD 1 TO NB-OUT.
DISPLAY-ERR.
MOVE SPACES TO DSP-ERREUR.
MOVE L-ERREUR TO DSP-ERREUR-2.
EVALUATE C-ERREUR
*==============================================================================*
* *
* C-ERREUR (COD-ERR) est testé mais jamais renseigné. Est-ce normal ? *
* *
*==============================================================================*
WHEN 01 THRU 09
MOVE ERR-NAT1 TO DSP-ERREUR-1
DISPLAY DSP-ERREUR
MOVE SPACES TO DSP-ERREUR-1
DISPLAY DSP-ERREUR-1
"/ MVTLU-ART =" MVTLU-ART
WHEN 10 THRU 19
MOVE ERR-NAT9 TO DSP-ERREUR-1
DISPLAY DSP-ERREUR
MOVE SPACES TO DSP-ERREUR-1
DISPLAY DSP-ERREUR-1
"/MVTLU-ART =" MVTLU-ART
GO TO RETOUR
WHEN 20 THRU 29
MOVE ERR-NAT1 TO DSP-ERREUR-1
DISPLAY DSP-ERREUR
MOVE SPACES TO DSP-ERREUR-1
DISPLAY DSP-ERREUR-1
"/PMTLU-ART =" PMTLU-ART
WHEN 30 THRU 39
MOVE ERR-NAT9 TO DSP-ERREUR-1
DISPLAY DSP-ERREUR
MOVE SPACES TO DSP-ERREUR-1
DISPLAY DSP-ERREUR-1
"/PMTLU-ART =" PMTLU-ART
GO TO RETOUR
WHEN 40 THRU 49
MOVE ERR-NAT9 TO DSP-ERREUR-1
DISPLAY DSP-ERREUR
MOVE SPACES TO DSP-ERREUR-1
DISPLAY DSP-ERREUR-1
"/OUTWS-ART =" OUTWS-ART
GO TO RETOUR
WHEN OTHER
MOVE ERR-NAT9 TO DSP-ERREUR-1
DISPLAY DSP-ERREUR
GO TO RETOUR
END-EVALUATE.
RETOUR. GOBACK.
END PROGRAM APP01P0N.
Cela dit, mon objectif n’était pas de proposer une solution dans n’importe quel autre langage mais de montrer comment ma programmation COBOL avait opportunément impacté ma programmation SQL.
Peu importe que ma version COBOL fonctionne ou non. J’avais même dit avoir pu oublier un point ou mis un point où il ne fallait pas car j’ai perdu mes réflexes de coboliste. Ce qu’il faut retenir, c’est le nommage des étiquettes logiques et des noms de données ; c’est la structure LCP et la mise en page du programme ; c’est l’organigramme qui vaut à lui seul tous les commentaires.
Obelix84 voulait savoir ce que l’on pensait de son code, si ses techniques vieilles de 30 ans sont encore d'actualité et ce qu'il lui faudrait améliorer pour être crédible de nos jours comme développeur.
Le parallèle que j’ai fait avec une version SQL avait pour objectif d’être inspirant, d’argumenter mes choix pertinents de développement COBOL. Rien de plus.
26/12/2019, 12h50
Invité
En COBOL dans le texte !
Bonjour,
J’aime bien lire un programme directement via son langage source, sans être polué par des commentaires envahissant. Je préfère consacrer du temps à de la mise en page plutôt qu’à rédiger des commentaires.
■ Structure d’accueil
Même les langages structurés ne peuvent pas empêcher de programmer sans rigueur. Il appartient à chacun de créer ses propres bonnes pratiques de programmation. Ça n’est pas vraiment de la documentation mais des règles de mise en page, à l’instar des règles de mise en page des livres.
Une fois définies pour un langage, la difficulté réside dans son adaptation aux spécificités d'un nouveau langage. Personnellement, j’ai besoin d’un peu de pratique pour apprivoiser un nouveau langage, pour créer ce que j’appelle ma « Structure d’accueil ».
Une structure d'accueil n'a rien de contraignant car chaque nouveau programme s'écrit à partir d'une copie de programme(s) existant(s), et les éditeurs permettent de faire facilement des copier-coller. Certains développeurs pourraient cependant y voir un frein à leur créativité. Concevoir une structure d'accueil, n'est-ce pas précisément faire preuve d'imagination ? Certes, il s'agit de s'investir sur l'esthétique, la présentation, la lisibilité plutôt que sur les astuces de programmation, mais quel est l'intérêt de réinventer l'eau chaude à chaque nouveau programme ?
L'objectif de la structure d'accueil est de rendre le programme aussi lisible qu'un document écrit afin d'éviter le recours à tout dossier d’analyse ou de programmation, et même à tout organigramme.
La « Structure d'accueil » standardise les conventions adoptées, les règles d'écriture et de présentation des programmes :
squelette du programme, canevas
identification du programme,
méthodologie de programmation,
utilisation des majuscules et des minuscules,
indentation,
noms de variables communs à tous les programmes de l'application,
règle d'écriture des paramètres et variables spécifiques,
shell d'exécution, sous forme de commentaire, en fin de programme.
■ Règles de mise en page des programmes
Il ne s’agit rien d’autre que de concevoir un AGL minimaliste de développement, le moins contraignant possible, pour optimiser, standardiser la programmation, pour organiser la synergie des investissements.
Tous les programmes étant construits d'après la même architecture, il suffit à une tierce personne de saisir le fil conducteur, de comprendre la logique qui a régi l'un des programmes de l'application pour qu'elle « décode » tous les autres sans difficulté. Rien n'est plus décevant, angoissant, déprimant que d'intervenir dans un programme sans personnalité, sans trame décelable, sans repères susceptible d'en guider la lecture.
Certains artifices de forme ne sont pas à négliger. WINDEV, Delphi, les éditeurs utilisent la couleur pour distinguer instructions, données et variables. Je ne sais pas si tous les compilateurs l’acceptent, mais dans le même esprit sous UNIX, le seul fait d'utiliser des majuscules pour les instructions et des minuscules pour les données ou variables améliore considérablement la lecture des programmes (le compilateur Informix traite indifféremment les majuscules et les minuscules).
Ce n’est pas grand-chose mais cela apporte un peu de relief et je lis mieux mon code. Évidemment, toutes les données que je manipule sont préfixées. En rendant les instructions suffisamment compréhensibles, le code se passe de commentaires. En résumé, un programme est un tout, pas seulement un cocktail de codes commentés, mais un véritable document lisible, digeste qui se suffit à lui-même.
J’ai lu sur un site que le compilateur COBOL n’interprétait que les colonnes 7 à 72. Dans mes précédentes versions du programme, j’avais supprimé les 6 premières colonnes « numéros de ligne » du programme d’Obelix84 pour en améliorer la lisibilité. Puisqu’elles existent toujours, autant les exploiter visuellement. Les numéros de ligne sont un vestige de la carte perforée.
L’effet visuel peut surprendre et vous n’êtes pas obligés d’aimer.
┌───── IDENTIFICATION DIVISION.
│
│ PROGRAM-ID. APP01P0N.
│ AUTHOR. OBELIX84.
│ *OBJET. Création d’un OUT depuis le permanent PMT et le Mouvement MVT.
│
│ *==============================================================================*
│ * *
│ * - Sur PC (DOS) liens aux fichiers réels par variables envt *
│ * *
│ * Exemple : *
│ * *
│ * set FICPMT=E:\FIC\FICPMT1 *
│ * set FICMVT=E:\FIC\FICMVT1 *
│ * *
│ * rem appel au pgm (display sur E:\FIC\APP1.LST) *
│ * app01P0n > E:\FIC\APP1.LST *
│ * *
│ * - Gestion des erreurs fichiers par déclaratives *
│ * *
│ *==============================================================================*
└─────*───────────────────────────────────────────────────────────────────────────────
┌───── ENVIRONMENT DIVISION.
│
│ CONFIGURATION SECTION.
│ SOURCE-COMPUTER. PC WITH DEBUGGING MODE.
│ OBJECT-COMPUTER. PC.
│
│ INPUT-OUTPUT SECTION.
│
│ FILE-CONTROL.
│
│ SELECT OPTIONAL
│ FICPMT ASSIGN TO EXTERNAL PMT
│ ORGANIZATION IS LINE SEQUENTIAL
│ FILE STATUS IS FS-PMT.
│
│ SELECT FICMVT ASSIGN TO EXTERNAL MVT
│ ORGANIZATION IS LINE SEQUENTIAL
│ FILE STATUS IS FS-MVT.
│
│ SELECT FICOUT ASSIGN TO EXTERNAL OUT
│ ORGANIZATION IS LINE SEQUENTIAL
│ FILE STATUS IS FS-OUT.
└─────*───────────────────────────────────────────────────────────────────────────────
┌───── DATA DIVISION.
│
├───── FILE SECTION.
│
│ FD PMT RECORD CONTAINS 24 CHARACTERS.
│ 01 PMT-ART.
│ 05 PMT-INDICATIF PIC X(04).
│ 05 PMT-D-MAJ PIC 9(06).
│ 05 PMT-MONTANT-1 PIC 9(07).
│ 05 PMT-MONTANT-2 PIC 9(07).
│
│ FD MVT RECORD CONTAINS 10 CHARACTERS.
│ 01 MVT-ART.
│ 05 MVT-INDICATIF PIC X(04).
│ 05 MVT-C-MONTANT PIC X(01).
│ 05 MVT-MONTANT PIC 9(05).
│
│ FD OUT RECORD CONTAINS 24 CHARACTERS.
│ 01 OUT-ART.
│ 05 OUT-INDICATIF PIC X(04).
│ 05 OUT-D-MAJ PIC 9(06).
│ 05 OUT-MONTANT-1 PIC 9(07).
│ 05 OUT-MONTANT-2 PIC 9(07).
└─────*───────────────────────────────────────────────────────────────────────────────
┌───── WORKING-STORAGE SECTION.
│
│ 01 FS-PMT PIC X(02) VALUE SPACES.
│ 01 FS-MVT PIC X(02) VALUE SPACES.
│ 01 FS-OUT PIC X(02) VALUE SPACES.
│
│ 01 NOM-PMT PIC X(08) VALUE "FICPMT".
│ 01 NOM-MVT PIC X(08) VALUE "FICMVT".
│ 01 NOM-OUT PIC X(08) VALUE "FICOUT".
│
│ 01 GESTFST PIC X(07) VALUE "GESTFST".
│ 01 RC PIC S9(05) VALUE ZERO.
│ 01 D-TODAY PIC 9(06) VALUE ZERO.
│
│ 01 PMTLU-ART.
│ 05 PMTLU-INDICATIF PIC X(04).
│ 05 PMTLU-D-MAJ PIC 9(06).
│ 05 PMTLU-MONTANT-1 PIC 9(07).
│ 05 PMTLU-MONTANT-2 PIC 9(07).
│
│ 01 MVTLU-ART.
│ 05 MVTLU-INDICATIF PIC X(04).
│ 05 MVTLU-C-MONTANT PIC X(01).
│ 05 MVTLU-MONTANT PIC 9(05).
│
│ 01 MVTST-ART.
│ 05 MVTST-INDICATIF PIC X(04).
│ 05 MVTST-C-MONTANT PIC X(01).
│ 05 MVTST-MONTANT PIC 9(05).
│
│ 01 OUTWS-ART.
│ 05 OUTWS-INDICATIF PIC X(04).
│ 05 OUTWS-D-MAJ PIC 9(06).
│ 05 OUTWS-MONTANT-1 PIC 9(07).
│ 05 OUTWS-MONTANT-2 PIC 9(07).
│
│ 01 NB_BILANS.
│ 05 NB-PMT-LU PIC S9(06) COMP VALUE ZERO.
│ 05 NB-PMT-ADD PIC S9(06) COMP VALUE ZERO.
│ 05 NB-PMT-MAJ PIC S9(06) COMP VALUE ZERO.
│ 05 NB-MVT-LU PIC S9(06) COMP VALUE ZERO.
│ 05 NB-OUT PIC S9(06) COMP VALUE ZERO.
│
│ 01 LIB-ERREUR.
│ 05 C-ERREUR PIC 9(02).
│ 05 FILLER PIC X(01).
│ 05 L-ERREUR PIC X(70).
│
│ 01 DSP-ERREUR.
│ 05 DSP-ERREUR-1 PIC X(13).
│ 05 FILLER PIC X(01) VALUE SPACE.
│ 05 DSP-ERREUR-2 PIC X(70).
│
│ 01 ERR-NAT.
│ 05 ERR-NAT1 PIC X(13) VALUE "---APP01P0N--".
│ 05 ERR-NAT8 PIC X(13) VALUE "...........LU".
│ 05 ERR-NAT9 PIC X(13) VALUE "***APP01P0N**".
└─────*───────────────────────────────────────────────────────────────────────────────
┌───── PROCEDURE DIVISION.
│
├───── DECLARATIVES.
│
│ ERREUR-PMT SECTION.
│ USE AFTER STANDARD ERROR PROCEDURE ON PMT.
│ IF FS-PMT NOT = ""
│
│ CALL GESTFST USING "PMT" FS-PMT RC
│ END-IF.
│
│ ERREUR-MVT SECTION.
│ USE AFTER STANDARD ERROR PROCEDURE ON MVT.
│ IF FS-MVT NOT = ""
│ CALL GESTFST USING "MVT" FS-MVT RC
│ END-IF.
│
│ ERREUR-OUT SECTION.
│ USE AFTER STANDARD ERROR PROCEDURE ON OUT.
│ IF FS-OUT NOT = ""
│ CALL GESTFST USING "OUT" FS-OUT RC
│ END-IF.
│
│ END DECLARATIVES.
└─────*───────────────────────────────────────────────────────────────────────────────
┌───── MAIN-PROC SECTION.
│
├───── P010-D-PROG.
│ MOVE ZERO TO RC.
│ ACCEPT D-TODAY FROM DATE.
│
│ OPEN INPUT PMT.
│ IF FS-PMT NOT = ""
│ MOVE "90 PROBLEME A L'OPEN PMT " TO L-ERREUR
│ PERFORM DISPLAY-ERR
│ END-IF.
│
│ OPEN INPUT MVT.
│ IF FS-MVT NOT = ""
│ MOVE "90 PROBLEME A L'OPEN MVT " TO L-ERREUR
│ PERFORM DISPLAY-ERR
│ END-IF.
│
│ OPEN OUTPUT OUT.
│ IF FS-OUT NOT = ""
│ MOVE "90 PROBLEME A L'OPEN OUT " TO L-ERREUR
│ PERFORM DISPLAY-ERR
│ END-IF.
│
│ PERFORM READ-PMT.
│ PERFORM READ-MVT.
└─────*───────────────────────────────────────────────────────────────────────────────
┌───── P020-D-INDICATIF.
│ PERFORM WITH TEST BEFORE UNTIL PMTLU-INDICATIF = MVTLU-INDICATIF
│ AND PMTLU-INDICATIF = HIGH-VALUE
│ EVALUATE TRUE
└─────*───────────────────────────────────────────────────────────────────────────────
┌─────*P030-T-PMTLU.
│ WHEN PMTLU-INDICATIF < MVTLU-INDICATIF
│ MOVE PMTLU-ART TO OUTWS-ART
│ PERFORM WRITE-OUT
│ PERFORM READ-PMT
└─────*───────────────────────────────────────────────────────────────────────────────
┌─────*P040-D-MVTLU.
│ WHEN PMTLU-IDICATIF > MVTLU-INDICATIF
│ MOVE MVTLU-INDICATIF TO OUTWS-INDICATIF
│ MOVE D-TODAY TO OUTWS-D-MAJ
│ MOVE ZERO TO OUTWS-MONTANT-1
│ OUTWS-MONTANT-2
└─────*───────────────────────────────────────────────────────────────────────────────
┌─────*P050-T-MVT-C-MONTANT.
│ PERFORM UNTIL MVTLU-INDICATIF = OUTWS-INDICATIF
│ EVALUATE MVTLU-C-MONTANT
│ WHEN "1" ADD MVTLU-MONTANT TO OUTWS-MONTANT-1
│ WHEN "2" ADD MVTLU-MONTANT TO OUTWS-MONTANT-2
│ END-EVALUATE
│ PERFORM READ-MVT
└─────*───────────────────────────────────────────────────────────────────────────────
┌─────*P060-F-MVTLU.
│ ELSE
│ PERFORM WRITE-OUT
│ ADD 1 TO NB-PMT-ADD
│ END-IF
│
│ END-PERFORM.
└─────*───────────────────────────────────────────────────────────────────────────────
┌─────*P070-D-PMTLU-ET-MVTLU.
│ WHEN PMTLU-INDICATIF = MVTLU-INDICATIF
│ MOVE PMTLU-ART TO OUTWS-ART
│ MOVE D-TODAY TO OUTWS-D-MAJ
└─────*───────────────────────────────────────────────────────────────────────────────
┌─────*P080-T-MVT-C-MONTANT.
│ PERFORM UNTIL MVTLU-INDICATIF = OUTWS-INDICATIF
│ EVALUATE MVTLU-C-MONTANT
│ WHEN "1" ADD MVTLU-MONTANT TO OUTWS-MONTANT-1
│ WHEN "2" ADD MVTLU-MONTANT TO OUTWS-MONTANT-2
│ END-EVALUATE
│ PERFORM READ-MVT
└─────*───────────────────────────────────────────────────────────────────────────────
┌─────*P090-F-PMTLU-ET-MVTLU.
│ ELSE
│ PERFORM WRITE-OUT
│ ADD 1 TO NB-PMT-MAJ
│ END-IF
│ END-PERFORM.
│
│ PERFORM READ-PMT.
└─────*───────────────────────────────────────────────────────────────────────────────
┌─────*P100-F-INDICATIF.
│ END-EVALUATE
│ END-PERFORM.
└─────*───────────────────────────────────────────────────────────────────────────────
┌───── P110-F-PROG.
│ MOVE ZERO TO RC.
│
│ CLOSE PMT.
│ IF FS-PMT NOT = ""
│ MOVE "91 PROBLEME AU CLOSE FICPMT " TO L-ERREUR
│ PERFORM DISPLAY-ERR
│ END-IF.
│
│ CLOSE MVT.
│ IF FS-MVT NOT = ""
│ MOVE "91 PROBLEME AU CLOSE FICMVT " TO L-ERREUR
│ PERFORM DISPLAY-ERR
│ END-IF.
│
│ CLOSE OUT.
│ IF FS-OUT NOT = ""
│ MOVE "91 PROBLEME AU CLOSE FICMVT " TO L-ERREUR
│ PERFORM DISPLAY-ERR
│ END-IF.
│
│ DISPLAY ERR-NAT1 " NB ENREG PMT LUS =" NB-PMT-LU.
│ DISPLAY ERR-NAT1 " NB ENREG PMT CREES =" NB-PMT-ADD.
│ DISPLAY ERR-NAT1 " NB ENREG PMT M-A-J =" NB-PMT-MAJ.
│ DISPLAY ERR-NAT1 " NB ENREG MVT LUS =" NB-MVT-LU.
│ DISPLAY ERR-NAT1 " NB ENREG PMT ECRITS =" NB-OUT.
│
│ GO TO RETOUR.
└─────*───────────────────────────────────────────────────────────────────────────────
┌───── READ-PMT.
│ MOVE SPACES TO PMTLU-ART.
│ READ PMT INTO PMTLU-ART
│ AT END MOVE HIGH-VALUE TO PMTLU-INDICATIF.
│ IF FS-PMT NOT = "" AND NOT = "10"
│ MOVE "93 PROBLEME AU READ PMT " TO L-ERREUR
│ PERFORM DISPLAY-ERR
│ END-IF.
│ IF PMTLU-INDICATIF NOT = HIGH-VALUE
│ ADD 1 TO NB-PMT-LU
│ END-IF.
└─────*───────────────────────────────────────────────────────────────────────────────
┌───── READ-MVT.
│ MOVE SPACES TO ART-MVT-LU.
│ READ FICMVT INTO ART-MVT-LU
│ AT END MOVE HIGH-VALUE TO MVTLU-INDIC.
│ IF FS-MVT NOT = "" AND NOT = "10"
│ MOVE "93 PROBLEME AU READ MVT " TO L-ERREUR
│ PERFORM DISPLAY-ERR
│ END-IF.
│ IF MVTLU-INDICATIF NOT = HIGH-VALUE
│ ADD 1 TO NB-MVTLU
│ END-IF.
└─────*───────────────────────────────────────────────────────────────────────────────
┌───── WRITE-OUT.
│ WRITE OUT-ART FROM OUTWS-ART.
│ IF FS-OUT NOT = ""
│ MOVE "93 PROBLEME AU WRITE OUT " TO L-ERREUR
│ PERFORM DISPLAY-ERR
│ END-IF.
│ ADD 1 TO NB-OUT.
└─────*───────────────────────────────────────────────────────────────────────────────
┌─────DISPLAY-ERR.
│ MOVE SPACES TO DSP-ERREUR.
│ MOVE L-ERREUR TO DSP-ERREUR-2.
│
│ EVALUATE C-ERREUR
│
│ *==============================================================================*
│ * *
│ * C-ERREUR (COD-ERR) est testé mais jamais renseigné. Est-ce normal ? *
│ * *
│ *==============================================================================*
│
│ WHEN 01 THRU 09
│ MOVE ERR-NAT1 TO DSP-ERREUR-1
│ DISPLAY DSP-ERREUR
│ MOVE SPACES TO DSP-ERREUR-1
│ DISPLAY DSP-ERREUR-1
│ "/ MVTLU-ART =" MVTLU-ART
│
│ WHEN 10 THRU 19
│ MOVE ERR-NAT9 TO DSP-ERREUR-1
│ DISPLAY DSP-ERREUR
│ MOVE SPACES TO DSP-ERREUR-1
│ DISPLAY DSP-ERREUR-1
│ "/MVTLU-ART =" MVTLU-ART
│ GO TO RETOUR
│
│ WHEN 20 THRU 29
│ MOVE ERR-NAT1 TO DSP-ERREUR-1
│ DISPLAY DSP-ERREUR
│ MOVE SPACES TO DSP-ERREUR-1
│ DISPLAY DSP-ERREUR-1
│ "/PMTLU-ART =" PMTLU-ART
│
│ WHEN 30 THRU 39
│ MOVE ERR-NAT9 TO DSP-ERREUR-1
│ DISPLAY DSP-ERREUR
│ MOVE SPACES TO DSP-ERREUR-1
│ DISPLAY DSP-ERREUR-1
│ "/PMTLU-ART =" PMTLU-ART
│ GO TO RETOUR
│
│ WHEN 40 THRU 49
│ MOVE ERR-NAT9 TO DSP-ERREUR-1
│ DISPLAY DSP-ERREUR
│ MOVE SPACES TO DSP-ERREUR-1
│ DISPLAY DSP-ERREUR-1
│ "/OUTWS-ART =" OUTWS-ART
│ GO TO RETOUR
│
│ WHEN OTHER
│ MOVE ERR-NAT9 TO DSP-ERREUR-1
│ DISPLAY DSP-ERREUR
│ GO TO RETOUR
│
│ END-EVALUATE.
└─────*───────────────────────────────────────────────────────────────────────────────
┌───── RETOUR. GOBACK.
│ END PROGRAM APP01P0N.
└─────*───────────────────────────────────────────────────────────────────────────────
03/01/2020, 21h34
Invité
Lire, comprendre et réapprendre un petit peu le COBOL
Encore un petit mot
J’ai eu du mal à m’y mettre mais j’ai quand même fini par revisiter à ma façon le programme « EXO » proposé par Obelix84 dans la discussion qu’il a initiée le 26/11/2019 « Un exercice complet ».
Je me suis heurté à deux difficultés :
D’abord, tel qu’il est, je ne peux pas lire le programme. Ce programme est certes conçu pour tourner mais pas pour être lu, donc pas pour être maintenu. Enfin, c'est mon ressenti. Cette programmation à tiroirs PERFORM imbriqués est franchement dissuasive. J’ai l’impression d’entendre sans arrêt mon GPS me dire : « Faites demi-tour ».
La structure du fichier en entrée d’elosam782 est une aberration conceptuelle. Chaque attribut est traité comme étant une entité.
… J’ai un fichier en entrée contenant des élèves avec leurs options de sport ainsi que le nombre d’heures de sport pour le sport pratiqué, s’ils en ont pratiqué un, le mois dernier.
01
02
03
04
10nom de l’élève
11date de naissance
de l’élève
12sports choisis en option
13sport pratiqué le mois
dernier et nombre d’heures
09fin de fichier EOF
Je me suis demandé quel était l’intérêt de mener une réflexion cobolistique sur un fichier qui ne respecte pas les règles de déontologie professionnelle ? Programmer en COBOL aujourd’hui implique-t-il d’ignorer la modélisation conceptuelle Entités-Relations ?
De mémoire, parce que je n’ai pas fait ça depuis longtemps, le schéma conceptuel entités-relations devrait ressembler à ça :
Code:
1 2 3 4 5 6 7 8 9 10 11 12
┌┤el├─────────────┐ ┌┤os├─────────────┐ ┌┤ls├─────────────┐
│ Élèves │1,n 1 │ Options sport │1,1 3 │ Libellés sport │
├─────────────────┼──────O──────┼─────────────────┼──────O──────┼─────────────────┤
│ el.identifiant │ 2 0,n│ el.identifiant │ 4 1,n│ ls.c_sport │
│ el.nom │ │ ls.c_sport │ │ ls.l_sport │
│ el.d_naissance │ │ os.nb_heures │ │ │
└─────────────────┘ └─────────────────┘ └─────────────────┘
En Merise, on identifierait les relations par une locution verbale du genre :
Élève choisit (1,n)
Option sport est choisie par (0,n)
Option sport est dénommée (1,1)
Libellé sport est lié à (1,n)
À partir de là, le fichier en entrée qu’elosam782 propose aurait dû traduire cette approche, ce qui n’est pas le cas. Je prends donc cet exercice comme un exercice d’algorithmique spécifique au COBOL en regrettant qu’il transmette insidieusement de mauvaises pratiques conceptuelles.
000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. EXO.
000300 AUTHOR. OBELIX84.
000400
000500*---------------------
000600* V1.0 du 25/11/2019 -
000700*-----------------------------------------------------------------
000800* - EXERCICE PROPOSE PAR ELOSAM782 -
000900*
001000*-----------------------------------------------------------------
001100* Infos programme
001200*
001300* - Sur PC (DOS) liens aux fichiers reels par variables envt
001400* Par exemple:
001500* set FICIPT=E:\FIC\EXO01.IPT
001600* set FICOPT=E:\FIC\EXO01.OPT
001700* rem appel au pgm (display sur E:\FIC\EXO01.LST)
001800* exo > E:\FIC\EXO01.LST
001900*
002000* - Gestion des erreurs fichiers par declaratives
002100* - GO TO uniquement vers sortie programme (GOBACK)
002200*
002300*-----------------------------------------------------------------
002400
002500 ENVIRONMENT DIVISION.
002600 CONFIGURATION SECTION.
002700*=====================
002800 SOURCE-COMPUTER. PC.
002900 OBJECT-COMPUTER. PC.
003000*-----------------------------------------------------------------
003100 INPUT-OUTPUT SECTION.
003200*====================
003300*----------------------------------------------------------------
003400* Les fichiers entree et sortie ont une structure variable
003500* et sont aisement manipulables sous windows
003600* a adapter sur MAINFRAME ou autre
003700*----------------------------------------------------------------
003800 FILE-CONTROL.
003900 SELECT FICIPT ASSIGN TO EXTERNAL FICIPT
004000 ORGANIZATION IS LINE SEQUENTIAL
004100 FILE STATUS IS FS-IPT.
004200 SELECT FICOPT ASSIGN TO EXTERNAL FICOPT
004300 ORGANIZATION IS LINE SEQUENTIAL
004400 FILE STATUS IS FS-OPT.
004500*-----------------------------------------------------------------
004600
004700 DATA DIVISION.
004800
004900 FILE SECTION.
005000*============
005100
005200 FD FICIPT
005300 RECORD VARYING 0 TO 256 DEPENDING ON LG-IPT.
005400 01 ART-IPT.
005500 05 C-IPT PIC X(01) OCCURS 0 TO 256 DEPENDING ON LG-IPT.
005600*
005700 FD FICOPT
005800 RECORD VARYING 0 TO 256 DEPENDING ON LG-OPT.
005900 01 ART-OPT.
006000 05 C-OPT PIC X(01) OCCURS 0 TO 256 DEPENDING ON LG-OPT.
006100
006200
006300 WORKING-STORAGE SECTION.
006400*=======================
006500 01 FS-IPT PIC X(02) VALUE ZERO.
006600 01 FS-OPT PIC X(02) VALUE ZERO.
006700 01 LG-IPT PIC 9(05) COMP VALUE ZERO.
006800 01 LG-OPT PIC 9(05) COMP VALUE ZERO.
006900 01 NOM-IPT PIC X(08) VALUE "FICIPT".
007000 01 NOM-OPT PIC X(08) VALUE "FICOPT".
007100 01 RC PIC S9(05) VALUE ZERO.
007200 01 NB-LU PIC S9(06) COMP VALUE ZERO.
007300 01 NB-OUT PIC S9(06) COMP VALUE ZERO.
007400 01 PTR-OUT PIC S9(05) COMP VALUE ZERO.
007500*----------------------------------------------------------------
007600* zones articles fichiers lu et stock
007700* lu = enregistrement lu (actualise par unstring pour 13)
007800* Taille de Z2-LU fixee arbitrairement a 20 caracteres maxi
007900* et nombre de sports fixes arbitrairement a 10 maxi
008000* a modifier si different
008100*
008200* En cas de modifs de longueur de zones il faut modifier Z2-LU
008300* - Z2-LU et ses REDEFINES
008400* - PART1-W (sert au controle de longueur)
008500* - Zones de stockage NOM-ELEVE NOM-SPORT
008600*
008700* Concernant la taille des heures au-dela de 999 par mois
008800* on serait hors sujet (1 mois fait 744 heures maxi)
008900*----------------------------------------------------------------
009000 01 ART-LU.
009100 05 INDICATIF-LU PIC X(02).
009200 05 Z2-LU PIC X(20).
009300 05 NOM-ELEVE-LU REDEFINES Z2-LU PIC X(20).
009400 05 SPORT-CHOISI-LU REDEFINES Z2-LU PIC X(20).
009500 05 SPORT-PRATIQ-LU REDEFINES Z2-LU PIC X(20).
009600 05 DATE-NAISSANCE-LU REDEFINES Z2-LU.
009700 10 JJ-LU PIC 9(02).
009800 10 MM-LU PIC 9(02).
009900 10 AA-LU PIC 9(04).
010000 05 FILLER PIC X(01).
010100 05 NOMBRE-HEURES-LU PIC 9(03).
010200 01 ART-W.
010300 05 FILLER PIC X(02).
010400 05 Z2-W PIC X(254).
010500 01 PART1-W PIC X(20).
010600 01 PART2-WX PIC X(03).
010700 01 PART2-W9 PIC 9(03).
010800 01 CT1-W PIC 9(03).
010900 01 CT2-W PIC 9(03).
011000 01 NBZ-W PIC 9(02).
011100
011200*----------------------------------------------------------------
011300* Donnees concernant un eleve remplies avec 10 11 12 et 13
011400* Le CODE-SPORT sera flagge avec
011500* - "C" Choisi en option (12)
011600* - "P" Pratique (13) Dans cas les heures sont remplies
011700*----------------------------------------------------------------
011800 01 INDICATIF PIC X(02).
011900 01 NOM-ELEVE PIC X(20).
012000 01 DATE-NAISSANCE.
012100 05 DATE-JJ PIC 9(02).
012200 05 DATE-MM PIC 9(02).
012300 05 DATE-AA PIC 9(04).
012400 01 TAB-SPORTS.
012500 05 SPORT OCCURS 0 TO 10 DEPENDING ON NB-SPORT
012600 INDEXED BY IDXS.
012700 10 CODE-SPORT PIC X(01).
012800 10 NOM-SPORT PIC X(20).
012900 10 HEURES-SPORT PIC 9(03).
013000 10 FILLER REDEFINES HEURES-SPORT.
013100 15 H1-SPORT PIC X(01).
013200 15 H2-SPORT PIC X(01).
013300 15 H3-SPORT PIC X(01).
013400 01 NB-SPORT PIC S9(05) COMP.
013500 01 MAX-SPORT PIC S9(05) COMP VALUE 10.
013600 01 MAX-LG-NOM PIC 9(02) VALUE 20.
013700 01 XX PIC S9(05) COMP.
013800
013900*----------------------------------------------------------------
014000* Gestion de l'affichage des libelles d'erreurs
014100*----------------------------------------------------------------
014200 01 LIB-ERR.
014300 05 COD-ERR PIC 9(02).
014400 05 FILLER PIC X(01).
014500 05 TXT-ERR PIC X(70).
014600 01 DSP-ERR.
014700 05 DSP1-ERR PIC X(13).
014800 05 FILLER PIC X(01) VALUE SPACES.
014900 05 DSP2-ERR PIC X(70).
015000 01 NAT1-ERR PIC X(13) VALUE "-----EXO-----".
015100 01 NAT8-ERR PIC X(13) VALUE "...........LU".
015200 01 NAT9-ERR PIC X(13) VALUE "*****EXO*****".
015300
015400 PROCEDURE DIVISION.
015500*===================
015600
015700*----------------------------------------------------------------
015800* La gestion des erreurs fichiers se fait par DECLARATIVES
015900* Le module GESTFST ne fait que decortiquer le FILE STATUS
016000* informe de l'erreur par un display et renvoie un RC
016100* Voir ce programme pour la nature du RC
016200*
016300* Dans ce programme en sortie de DECLARATIVES on retourne
016400* systematiquement au traitement appelant (FILE SATUS inchange)
016500* Il faut donc tester le FILE-STATUS en retour
016600* - OPEN/CLOSE erreur si FS autre que "00"
016700* - READ erreur si FS autre que "00" ou "10"
016800* - WRITE erreur si FS autre que "00"
016900*
017000* Les declaratives sont appelees s'il y a un incident sur une
017100* operation I/O (OPEN/CLOSE/READ/WRITE).
017200*
017300*----------------------------------------------------------------
017400 DECLARATIVES.
017500 ERREUR-FICIPT SECTION.
017600 USE AFTER STANDARD ERROR PROCEDURE ON FICIPT.
017700 IF FS-IPT NOT = "00"
017800 CALL "GESTFST" USING "FICIPT" FS-IPT RC
017900 END-IF.
018000*----------------------------------------------------------------
018100 ERREUR-FICOPT SECTION.
018200 USE AFTER STANDARD ERROR PROCEDURE ON FICOPT.
018300 IF FS-OPT NOT = "00"
018400 CALL "GESTFST" USING "FICOPT" FS-OPT RC
018500 END-IF.
018600 END DECLARATIVES.
018700
018800*-----------------------------------------------------------------
018900
019000 MAIN-PROC SECTION.
019100*================================================================
019200* Cinematique generale
019300*================================================================
019400 DEBUT.
019500 PERFORM INITIALISATIONS-DEBUT-PGM.
019600 PERFORM TRAITEMENT-PGM.
019700 PERFORM TRAITEMENT-FINAL-PGM.
019800 FIN. GO TO RETOUR.
019900
020000*================================================================
020100* Initialisations de debut de programme
020200* - Ouverture des fichiers
020300* - Lire le fichier entree jusqu'a l'indicatif 01
020400* - Puis recherche du premier indicatif 10
020500* - Erreur pour toute autre configuration
020600*================================================================
020700 INITIALISATIONS-DEBUT-PGM.
020800 MOVE ZERO TO RC.
020900
021000 OPEN INPUT FICIPT.
021100 IF FS-IPT NOT = "00"
021200 MOVE "90 PROBLEME A L'OPEN FICIPT " TO LIB-ERR
021300 PERFORM DISPLAY-ERR
021400 END-IF.
021500
021600 OPEN OUTPUT FICOPT.
021700 IF FS-OPT NOT = "00"
021800 MOVE "90 PROBLEME A L'OPEN FICOPT " TO LIB-ERR
021900 PERFORM DISPLAY-ERR
022000 END-IF.
022100
022200*----Recherche enregistrement debut de fichier (01)-----------
022300 PERFORM WITH TEST AFTER UNTIL INDICATIF-LU = "01"
022400 PERFORM READ-FICIPT
022500 IF FS-IPT = "10"
022600 MOVE "92 FICHIER VIDE OU 01 ABSENT" TO LIB-ERR
022700 PERFORM DISPLAY-ERR
022800 END-IF
022900 MOVE LG-IPT TO LG-IPT MOVE ART-IPT TO ART-LU
023000 END-PERFORM.
023100
023200*----Recherche du 1er enregistrement 10 (debut du fichier)--------
023300 PERFORM WITH TEST AFTER UNTIL INDICATIF-LU = "10"
023400 PERFORM READ-FICIPT
023500 IF FS-IPT = "10"
023600 MOVE "92 FICHIER VIDE (MANQUE 10)" TO LIB-ERR
023700 PERFORM DISPLAY-ERR
023800 END-IF
023900 MOVE LG-IPT TO LG-IPT MOVE ART-IPT TO ART-LU
024000 END-PERFORM.
024100
024200*================================================================
024300* Traitement principal
024400* La 1ere fois l'enregistrement lu(10) attend d'etre traite
024500* En cas d'absence de 09EOF ce sera simule en fin de fichier
024600* On ne sortira de la boucle qu'en fin de fichier
024700*================================================================
024800 TRAITEMENT-PGM.
024900 PERFORM WITH TEST BEFORE UNTIL FS-IPT = "10" OR
025000 INDICATIF-LU = "09"
025100 PERFORM RECUP-LU
025200 PERFORM TRAITEMENT-LU
025300 PERFORM READ-FICIPT
025400 IF FS-IPT = "10"
025500 MOVE 5 TO LG-IPT
025600 MOVE "09EOF" TO ART-IPT
025700 MOVE "16 09EOF MANQUANT SIMULATION" TO LIB-ERR
025800 PERFORM DISPLAY-ERR
025900 ELSE
026000 MOVE LG-IPT TO LG-IPT
026100 MOVE ART-IPT TO ART-LU
026200 END-IF
026300 IF INDICATIF-LU = "10" OR "09"
026400 PERFORM TRAITEMENT-OUT
026500 END-IF
026600 END-PERFORM.
026700
026800*================================================================
026900* Traitement sortie de programme
027000* (Fin PGM, fermetures, statistiques, etc.)
027100*================================================================
027200 TRAITEMENT-FINAL-PGM.
027300 MOVE ZERO TO RC.
027400
027500 CLOSE FICIPT.
027600 IF FS-IPT NOT = "00"
027700 MOVE "91 PROBLEME AU CLOSE FICIPT " TO LIB-ERR
027800 PERFORM DISPLAY-ERR
027900 END-IF.
028000
028100 CLOSE FICOPT.
028200 IF FS-IPT NOT = "00"
028300 MOVE "91 PROBLEME AU CLOSE FICOPT " TO LIB-ERR
028400 PERFORM DISPLAY-ERR
028500 END-IF.
028600
028700 DISPLAY NAT1-ERR " NB ENREGISTREMENTS LUS =" NB-LU.
028800 DISPLAY NAT1-ERR " NB ENREGISTREMENTS ECRITS =" NB-OUT.
028900
029000*----------------------------------------------------------------
029100* Recuperation enregistrement lu en working
029200* Puis controles
029300*----------------------------------------------------------------
029400 RECUP-LU.
029500 MOVE LG-IPT TO LG-IPT.
029600 MOVE ART-IPT TO ART-LU ART-W.
029700 MOVE SPACES TO PART1-W PART2-WX.
029800 MOVE ZERO TO CT1-W CT2-W NBZ-W.
029900 UNSTRING Z2-W DELIMITED BY ALL SPACES
030000 INTO PART1-W COUNT CT1-W
030100 PART2-WX COUNT CT2-W
030200 TALLYING NBZ-W
030300 ON OVERFLOW PERFORM ZONE-OVERFLOW
030400 END-UNSTRING.
030500 PERFORM CONTROLES-ENTREE.
030600
030700*----------------------------------------------------------------
030800* Par cet unstring on separe l'enregistrement lu en 2 morceaux
030900* via un delimiteur constitue par des blancs
031000* Dans les compteurs CT-W1 et 2 on trouvera la taille des zones
031100* Dans NBZ-W le nombre de zones
031200* Dans PART1 on trouvera suivant le code indicatif
031300* - Nom de l'eleve (10)
031400* - Date de naissance (11)
031500* - Sport choisi (12)
031600* - Sport pratique (13)
031700* - EOF (09)
031800* Dans PART2-WX on trouvera
031900* - Heures pratiquees (13)
032000*
032100* En retour de controle ART-LU sera correctement renseigne
032200*
032300* La condition OVERFLOW apparaitra s'il y avait au moins 2 blancs
032400* c'est a dire plus de 2 zones dans la zone emettrice.
032500* On signale mais on ignore on ne conserve que les 2 premieres
032600*
032700*----------------------------------------------------------------
032800 ZONE-OVERFLOW.
032900 MOVE "02 PLUS DE 2 ZONES DETECTEES" TO LIB-ERR.
033000 PERFORM DISPLAY-ERR.
033100
033200*----------------------------------------------------------------
033300* Controles validite des zones suivant le code 10 11 12 13 09
033400* En sortie ART-LU est correctement renseigne
033500*----------------------------------------------------------------
033600 CONTROLES-ENTREE.
033700 EVALUATE INDICATIF-LU
033800 WHEN "10"
033900 IF NBZ-W > 1
034000 MOVE "03 PLUS DE 1 ZONE DANS 10" TO LIB-ERR
034100 PERFORM DISPLAY-ERR
034200 END-IF
034300 IF CT1-W > MAX-LG-NOM
034400 MOVE SPACES TO LIB-ERR
034500 STRING "04 NOM ELEVE > " MAX-LG-NOM
034600 DELIMITED BY SIZE INTO LIB-ERR
034700 PERFORM DISPLAY-ERR
034800 END-IF
034900 MOVE PART1-W TO NOM-ELEVE-LU
035000
035100 WHEN "11"
035200 IF NBZ-W > 1
035300 MOVE "05 PLUS DE 1 ZONE DANS 11" TO LIB-ERR
035400 PERFORM DISPLAY-ERR
035500 END-IF
035600 IF CT1-W > 8
035700 MOVE "06 DATE DE NAISSANCE > 8" TO LIB-ERR
035800 PERFORM DISPLAY-ERR
035900 END-IF
036000 MOVE PART1-W TO DATE-NAISSANCE-LU
036100
036200 WHEN "12"
036300 IF NBZ-W > 1
036400 MOVE "07 PLUS DE 1 ZONE DANS 12" TO LIB-ERR
036500 PERFORM DISPLAY-ERR
036600 END-IF
036700 IF CT1-W > MAX-LG-NOM
036800 MOVE SPACES TO LIB-ERR
036900 STRING "08 NOM SPORT CHOISI > " MAX-LG-NOM
037000 DELIMITED BY SIZE INTO LIB-ERR
037100 PERFORM DISPLAY-ERR
037200 END-IF
037300 MOVE PART1-W TO SPORT-CHOISI-LU
037400
037500 WHEN "13"
037600 INSPECT PART2-WX CONVERTING "0123456789" TO SPACES
037700 IF PART2-WX NOT = SPACES
037800 MOVE SPACES TO LIB-ERR
037900 STRING "09 HEURES NON NUMERIQUES "
038000 "FORCEES A ZERO "
038100 DELIMITED BY SIZE INTO LIB-ERR
038200 PERFORM DISPLAY-ERR
038300 MOVE ZERO TO PART2-W9
038400 ELSE
038500 MOVE SPACES TO PART1-W PART2-WX
038600 MOVE ZERO TO CT1-W CT2-W
038700 UNSTRING Z2-W DELIMITED BY ALL SPACES
038800 INTO PART1-W COUNT CT1-W
038900 PART2-W9 COUNT CT2-W
039000 END-UNSTRING
039100 END-IF
039200 IF NBZ-W > 2
039300 MOVE "10 PLUS DE 2 ZONES DANS 13" TO LIB-ERR
039400 PERFORM DISPLAY-ERR
039500 END-IF
039600 IF CT1-W > MAX-LG-NOM
039700 MOVE SPACES TO LIB-ERR
039800 STRING "11 NOM SPORT PRATIQUE > " MAX-LG-NOM
039900 DELIMITED BY SIZE INTO LIB-ERR
040000 PERFORM DISPLAY-ERR
040100 END-IF
040200 MOVE PART1-W TO SPORT-PRATIQ-LU
040300 MOVE PART2-W9 TO NOMBRE-HEURES-LU
040400
040500 WHEN "09"
040600 IF PART1-W NOT = "EOF"
040700 MOVE "12 ENREGISTREMENT 09 ANORMAL" TO LIB-ERR
040800 PERFORM DISPLAY-ERR
040900 END-IF
041000 WHEN OTHER
041100 MOVE "01 ENREGISTREMENT INCONNU" TO LIB-ERR
041200 PERFORM DISPLAY-ERR
041300 END-EVALUATE.
041400
041500*----------------------------------------------------------------
041600* Traitements a faire sachant qu'en working on dispose d'un
041700* enregistrement lu. (Pour chaque nouvel eleve ce sera un 10)
041800* On va ventiler chaque enregistrement dans les zones de stockage
041900*----------------------------------------------------------------
042000 TRAITEMENT-LU.
042100 EVALUATE INDICATIF-LU
042200* Nom de l'eleve (initialisation eleve)-------------
042300 WHEN "10"
042400 MOVE INDICATIF-LU TO INDICATIF
042500 MOVE NOM-ELEVE-LU TO NOM-ELEVE
042600 MOVE "00000000" TO DATE-NAISSANCE
042700 MOVE ZERO TO NB-SPORT
042800* Date de naissance---------------------------------
042900 WHEN "11"
043000 MOVE DATE-NAISSANCE-LU TO DATE-NAISSANCE
043100* Sport choisis en option---------------------------
043200 WHEN "12"
043300 SET IDXS TO 1
043400 IF NB-SPORT = ZERO
043500 PERFORM ADD-SPORT-CHOISI
043600 ELSE
043700 SEARCH SPORT VARYING IDXS
043800 AT END PERFORM ADD-SPORT-CHOISI
043900 WHEN SPORT-CHOISI-LU = NOM-SPORT(IDXS)
044000 PERFORM 12-EN-DOUBLE
044100 END-SEARCH
044200 END-IF
044300* Sport pratique avec nombre d'heures---------------
044400 WHEN "13"
044500 SET IDXS TO 1
044600 SEARCH SPORT VARYING IDXS
044700 AT END PERFORM 13-SANS-12
044800 WHEN SPORT-PRATIQ-LU = NOM-SPORT(IDXS)
044900 PERFORM ADD-SPORT-PRATIQUE
045000 END-SEARCH
045100* PERFORM VOIR-TAB-SPORTS
045200* Fin du fichier------------------------------------
045300 WHEN "09"
045400 MOVE "10" TO FS-IPT
045500* Inconnu (deja signale aux controles) -------------
045600* WHEN OTHER
045700 END-EVALUATE.
045800
045900*---Voir table des sports (debugging)----------------------------
046000 VOIR-TAB-SPORTS.
046100 DISPLAY "INDICATIF=" INDICATIF
046200 "/NOM-ELEVE=" NOM-ELEVE
046300 "/DATE-NAISSANCE=" DATE-NAISSANCE
046400 "/SPORT-PRATIQ-LU=" SPORT-PRATIQ-LU.
046500 PERFORM VARYING XX FROM 1 BY 1 UNTIL XX > NB-SPORT
046600 DISPLAY "SPORT " XX
046700 "/CODE-SPORT=" CODE-SPORT (XX)
046800 "/NOM-SPORT=" NOM-SPORT (XX)
046900 "/HEURES-SPORT=" HEURES-SPORT (XX)
047000 END-PERFORM.
047100
047200*---Ranger un sport choisi en table------------------------------
047300 ADD-SPORT-CHOISI.
047400 IF IDXS > MAX-SPORT
047500 MOVE SPACES TO LIB-ERR
047600 STRING "13 TROP DE SPORT AUGMENTER TAB-SPORT "
047700 "ENREGISTREMENT 12 IGNORE"
047800 DELIMITED BY SIZE INTO LIB-ERR
047900 PERFORM DISPLAY-ERR
048000 ELSE
048100 ADD 1 TO NB-SPORT
048200 MOVE "C" TO CODE-SPORT(IDXS)
048300 MOVE SPORT-CHOISI-LU TO NOM-SPORT(IDXS)
048400 MOVE ZERO TO HEURES-SPORT(IDXS)
048500 END-IF.
048600
048700*---Ranger un sport pratique en table----------------------------
048800 ADD-SPORT-PRATIQUE.
048900 MOVE "P" TO CODE-SPORT(IDXS).
049000 MOVE NOMBRE-HEURES-LU TO HEURES-SPORT(IDXS).
049100
049200*----------------------------------------------------------------
049300* Serie de traitement a faire dans diverses conditions
049400* AT END SEARCH ou WHEN SEARCH etc.
049500* ou on n'a droit qu'a une seule instruction dans le scope...
049600*----------------------------------------------------------------
049700 12-EN-DOUBLE.
049800 MOVE "14 12 EN DOUBLE IGNORE" TO LIB-ERR.
049900 PERFORM DISPLAY-ERR.
050000
050100 13-SANS-12.
050200 MOVE "15 13 SANS 12 IGNORE" TO LIB-ERR.
050300 PERFORM DISPLAY-ERR.
050400
050500*----------------------------------------------------------------
050600* Traitement de sortie pour un eleve
050700*----------------------------------------------------------------
050800 TRAITEMENT-OUT.
050900 PERFORM VARYING IDXS FROM 1 BY 1 UNTIL IDXS > NB-SPORT
051000 MOVE 256 TO LG-OPT
051100 MOVE SPACES TO ART-OPT
051200 MOVE 1 TO PTR-OUT
051300 STRING NOM-ELEVE DELIMITED BY " " INTO ART-OPT
051400 WITH POINTER PTR-OUT
051500 STRING NOM-SPORT(IDXS) DELIMITED BY " " INTO ART-OPT
051600 WITH POINTER PTR-OUT
051700 IF H1-SPORT(IDXS) NOT = "0"
051800 MOVE H1-SPORT(IDXS) TO C-OPT(PTR-OUT)
051900 ADD 1 TO PTR-OUT
052000 MOVE H2-SPORT(IDXS) TO C-OPT(PTR-OUT)
052100 ADD 1 TO PTR-OUT
052200 MOVE H3-SPORT(IDXS) TO C-OPT(PTR-OUT)
052300 ELSE
052400 IF H2-SPORT(IDXS) NOT = "0"
052500 MOVE H2-SPORT(IDXS) TO C-OPT(PTR-OUT)
052600 ADD 1 TO PTR-OUT
052700 MOVE H3-SPORT(IDXS) TO C-OPT(PTR-OUT)
052800 ELSE
052900 MOVE H3-SPORT(IDXS) TO C-OPT(PTR-OUT)
053000 END-IF
053100 END-IF
053200 MOVE PTR-OUT TO LG-OPT
053300 PERFORM WRITE-FICOPT
053400 END-PERFORM.
053500
053600*---Lecture physique de FICIPT
053700 READ-FICIPT.
053800 READ FICIPT.
053900 IF FS-IPT NOT = "00" AND NOT = "10"
054000 MOVE "93 PROBLEME AU READ FICIPT " TO LIB-ERR
054100 PERFORM DISPLAY-ERR
054200 END-IF.
054300 ADD 1 TO NB-LU.
054400
054500*----Pour debbuging a commenter en fonctionnement reel-----------
054600* DISPLAY NAT8-ERR " ARTICLE LU... "
054700* "/NOM-IPT=>" NOM-IPT "<= "
054800* "/LG-IPT=>" LG-IPT "<= "
054900* "/ART-IPT=>" ART-IPT "<= "
055000* "/FS-IPT=>" FS-IPT "<= ".
055100
055200*---Ecriture physique de FICOPT
055300 WRITE-FICOPT.
055400 WRITE ART-OPT.
055500 IF FS-OPT NOT = "00"
055600 MOVE "80 PROBLEME AU WRITE FICOPT " TO LIB-ERR
055700 PERFORM DISPLAY-ERR
055800 END-IF.
055900 ADD 1 TO NB-OUT
056000
056100*----Pour debbuging a commenter en fonctionnement reel-----------
056200 DISPLAY NAT1-ERR " ARTICLE ECRIT "
056300 "/NOM-OPT=>" NOM-OPT "<= "
056400 "/LG-OPT=>" LG-OPT "<= "
056500 "/ART-OPT=>" ART-OPT "<= ".
056600
056700*----------------------------------------------------------------
056800* Gestion des erreurs
056900* Le libelle des erreur est dans la zone LIB-ERR
057000* Si ce libelle commence par
057100* - 01-49 Display du lib erreur + article lu mais on continue
057200* - 50-79 Display du lib erreur + article lu mais on s'arrete
057300* - 80-89 Display du lib erreur + article sortie et on s'arrete
057400* - 90-99 Display du lib erreur seul et on s'arrete
057500*----------------------------------------------------------------
057600 DISPLAY-ERR.
057700 MOVE SPACES TO DSP-ERR.
057800 MOVE TXT-ERR TO DSP2-ERR.
057900 EVALUATE COD-ERR
058000 WHEN 01 THRU 49 MOVE NAT1-ERR TO DSP1-ERR
058100 MOVE NAT1-ERR TO DSP1-ERR
058200 DISPLAY DSP-ERR
058300 MOVE SPACES TO DSP1-ERR
058400 DISPLAY DSP1-ERR
058500 "/NOM-IPT=>" NOM-IPT "<= "
058600 "/LG-IPT=>" LG-IPT "<= "
058700 "/ART-IPT=>" ART-IPT "<= "
058800 "/NOM-ELEVE=" NOM-ELEVE "<= "
058900
059000 WHEN 50 THRU 79
059100 MOVE NAT9-ERR TO DSP1-ERR
059200 DISPLAY DSP-ERR
059300 MOVE SPACES TO DSP1-ERR
059400 DISPLAY DSP1-ERR
059500 "/NOM-IPT=>" NOM-IPT "<= "
059600 "/LG-IPT=>" LG-IPT "<= "
059700 "/ART-IPT=>" ART-IPT "<= "
059800 "/NOM-ELEVE=" NOM-ELEVE "<= "
059900 GO TO RETOUR
060000
060100 WHEN 80 THRU 89
060200 MOVE NAT9-ERR TO DSP1-ERR
060300 DISPLAY DSP-ERR
060400 MOVE SPACES TO DSP1-ERR
060500 DISPLAY DSP1-ERR
060600 "/NOM-OPT=>" NOM-OPT "<= "
060700 "/LG-OPT=>" LG-OPT "<= "
060800 "/ART-OPT=>" ART-OPT "<= "
060900 "/NOM-ELEVE=" NOM-ELEVE "<= "
061000 GO TO RETOUR
061100
061200 WHEN OTHER
061300 MOVE NAT9-ERR TO DSP1-ERR
061400 DISPLAY DSP-ERR
061500 GO TO RETOUR
061600 END-EVALUATE.
061700*
061800*--- Il est bien que RETOUR soit la derniere ligne du programme
061900*
062000 RETOUR. STOP RUN.
L’unité de traitement et l’organigramme
Je cite la décomposition en accolades pour information. C’est une étape pédagogique de la méthode Warnier qui précède la réalisation de l’organigramme. On souligne les éléments qui ne sont pas décomposés et qui feront donc l’objet d’un « Pavé » dans l’organigramme, lesquels deviendront des Paragraphes dans le programme.
Je cite également l’organigramme dans un objectif pédagogique. Je n’en ai fait que deux (une mise-à-jour et une édition), voire peut-être trois, au début de ma carrière, qui m’ont permis de formater ma mémoire procédurale. Il m’est quand même arrivé depuis d’y avoir recours quelques fois pour résoudre certains cas peu évidents. Cela se concrétise généralement par un bout d’organigramme crayonné sur un coin de mon bureau.
Mon COBOL datant d’un certain temps, je ne garantis pas la fiabilité de ma version. Je maitrise mal l’instruction EVALUATE, je ne comprends pas la clause ON OVERFLOW et je dois avoir des problèmes de points aux endroits où j’ai remplacé certains PERFORM par leur contenu, etc. Ça fait beaucoup, mais il s’agit juste de montrer comment se serait présenté mon COBOL dans les années 70. On y retrouve la démarche LCP et les différents nommages évoqués dans mes messages précédents.
Nouveautés :
J’ai traité la table à ma façon, comme au bon vieux temps. Table TA-SPORT (SPORT) avec l’index courant I-TA (IDXS), l’index borne de la table remplie J-TA (NB-SPORT) et l’index maximum de la table K-TA (MAX-SPORT). C’est classique, c’est standard, c’est immédiatement compréhensible, c’est imparable.
J’ai décomposé les niveaux O1 de 1 en 1. Décomposer de 5 en 5 avait un intérêt du temps de la carte perforée, lorsque les éditeurs n’existaient pas.
J’ai introduis deux GO TO, c’est peut-être un sacrilège de nos jours, je ne sais pas. Personnellement, ça ne me gêne absolument pas, bien au contraire. Je privilégie la lisibilité avant tout. Et si le GO TO présente un risque lorsqu’il est mal maitrisé, c’est une instruction COBOL que je lis plus facilement qu’un EVALUATE ou un PERFORM.
Le GO TO présentait un risque aux temps ancestraux où la programmation était dite « sauvage ». Avec la programmation structurée telle que Jean-Dominique Warnier nous l’a enseignée, le GO TO ne présente aucun risque.
Ma version n’est juste que du relooking. Avec un peu de pratique, je pourrais certainement encore améliorer la présentation (à ma façon). Pour ce qui est de la programmation, je me suis contenté de faire du copier-coller et de respecter au mieux ce qu’a fait Obelix84, qui devrait donc y retrouver ses petits… sauf ses séquences de debugging. Ayant perdu ma compétence cobolistique, je ne suis plus en capacité de programmer des séquences de code, là où elles doivent être.
Peut-être que ma version va en heurter plus d’un. Mais peut-être apporte-t-elle tout de même quelques petites choses et donne-t-elle envie d’être lue. En tout cas, je la lis plus facilement que la version originale. Il me reste à vérifier la fiabilité de mes copier-coller… après un peu de recul.
Pour information, en termes de lignes, ma version fait 635 lignes et celle d’Obélix84, 620 lignes.
J’ai bien conscience d’avoir beaucoup perdu et donc d’avoir beaucoup à réapprendre.
┌───── IDENTIFICATION DIVISION.
│
│ PROGRAM-ID. EXO.
│ AUTHOR. OBELIX84.
│
│ *OBJET. EXERCICE PROPOSE PAR ELOSAM782
│ *
│ * V1.0 du 25/11/2019 d’Obelix84 modifiée IFA2377 le 03/01/2020
│ *
│ *-----------------------------------------------------------------
│ *
│ * - Sur PC (DOS) liens aux fichiers reels par variables envt
│ * Par exemple:
│ * set IPT=E:\FIC\EXO01.IPT
│ * set OPT=E:\FIC\EXO01.OPT
│ * rem appel au pgm (display sur E:\FIC\EXO01.LST)
│ * exo > E:\FIC\EXO01.LST
│ *
│ * - Gestion des erreurs fichiers par declaratives
│ *
│ * - Les GO TO sont repérés par des ────► comme ci-dessous
│ *
├────►* - GO TO : Fin P030-T-INDICATIF ─► P030-T-INDICATIF
├────►* - GO TO : Fin P040-F-ELEVE ─► P020-D-ELEVE
├────►* - GO TO : sortie programme ─► RETOUR. STOP RUN.
│ *
└─────*───────────────────────────────────────────────────────────────────────────────
┌───── ENVIRONMENT DIVISION.
│
│ CONFIGURATION SECTION.
│
│ SOURCE-COMPUTER. PC WITH DEBUGGING MODE.
│ OBJECT-COMPUTER. PC.
│
│ INPUT-OUTPUT SECTION.
│
│ FILE-CONTROL.
│
│ SELECT IPT ASSIGN TO EXTERNAL IPT
│ ORGANIZATION IS LINE SEQUENTIAL
│ FILE STATUS IS FS-IPT.
│
│ SELECT OPT ASSIGN TO EXTERNAL OPT
│ ORGANIZATION IS LINE SEQUENTIAL
│ FILE STATUS IS FS-OPT.
└─────*───────────────────────────────────────────────────────────────────────────────
┌───── DATA DIVISION.
│
├───── FILE SECTION.
│
│ FD IPT
│ RECORD VARYING 0 TO 256 DEPENDING ON LG-IPT.
│
│ 01 IPT-ART.
│ 02 C-IPT PIC X(01) OCCURS 0 TO 256 DEPENDING ON LG-IPT.
│
│ FD OPT
│ RECORD VARYING 0 TO 256 DEPENDING ON LG-OPT.
│
│ 01 OPT- ART.
│ 02 C-OPT PIC X(01) OCCURS 0 TO 256 DEPENDING ON LG-OPT.
│
├───── WORKING-STORAGE SECTION.
│
│ 01 FS-IPT PIC X(02) VALUE ZERO.
│ 01 FS-OPT PIC X(02) VALUE ZERO.
│
│ 01 LG-IPT PIC 9(05) COMP VALUE ZERO.
│ 01 LG-OPT PIC 9(05) COMP VALUE ZERO.
│
│ *----------------------------------------------------------------
│ * zones articles fichiers lu et stock
│ * lu = enregistrement lu (actualise par unstring pour 13)
│ * Taille de IPT-Z2 fixee arbitrairement a 20 caracteres maxi
│ * et nombre de sports fixes arbitrairement a 10 maxi
│ * a modifier si different
│ *
│ * En cas de modifs de longueur de zones il faut modifier IPT-Z2
│ * - IPT-Z2 et ses REDEFINES
│ * - WS-PART1 (sert au controle de longueur)
│ * - Zones de stockage NOM-ELEVE NOM-SPORT
│ *
│ * Concernant la taille des heures au-dela de 999 par mois
│ * on serait hors sujet (1 mois fait 744 heures maxi)
│ *----------------------------------------------------------------
│
│ 01 IPT-LU.
│ 02 IPT-INDICATIF PIC X(02).
│ 02 IPT-Z2 PIC X(20).
│ 02 IPT-NOM-ELEVE REDEFINES IPT-Z2 PIC X(20).
│ 02 IPT-SPORT-CHOISI REDEFINES IPT-Z2 PIC X(20).
│ 02 IPT-SPORT-PRATIQUE REDEFINES IPT-Z2 PIC X(20).
│ 02 IPT-D-NAISSANCE REDEFINES IPT-Z2.
│ 03 IPT-JJ-NAISSANCE PIC 9(02).
│ 03 IPT-MM-NAISSANCE PIC 9(02).
│ 03 IPT-AA-NAISSANCE PIC 9(04).
│ 02 FILLER PIC X(01).
│ 02 IPT-NOMBRE-HEURES PIC 9(03).
│
│ *----------------------------------------------------------------
│ * Donnees concernant un eleve remplies avec 10 11 12 et 13
│ *
│ * Le C-SPORT sera flague avec
│ * - "C" Choisi en option (12)
│ * - "P" Pratique (13) Dans cas les heures sont remplies
│ *----------------------------------------------------------------
│
│ 01 OPT-INDICATIF PIC X(02).
│ 01 OPT-NOM-ELEVE PIC X(20).
│ 01 OPT-D-NAISSANCE.
│ 02 OPT-JJ-NAISSANCE PIC 9(02).
│ 02 OPT-MM-NAISSANCE PIC 9(02).
│ 02 OPT-AA-NAISSANCE PIC 9(04).
│
│ 01 ZT-SPORTS.
│ 02 TA-SPORT OCCURS 0 TO 10 DEPENDING ON J-TA
│ INDEXED BY I-TA.
│ 03 TA-C-SPORT PIC X(01).
│ 03 TA-NOM-SPORT PIC X(20).
│ 03 TA-HEURES-SPORT PIC 9(03).
│ 03 FILLER REDEFINES TA-HEURES-SPORT.
│ 04 TA-H1-SPORT PIC X(01).
│ 04 TA-H2-SPORT PIC X(01).
│ 04 TA-H3-SPORT PIC X(01).
│
│ 01 J-TA PIC S9(05) COMP.
│ 01 K-TA PIC S9(05) COMP VALUE 10.
│ 01 MAX-NOM-ELEVE PIC 9(02) VALUE 20.
│
│ 01 WS-ART.
│ 02 FILLER PIC X(02).
│ 02 WS-Z2 PIC X(254).
│
│ 01 WS-PART1 PIC X(20).
│ 01 WS-PART2 PIC X(03).
│ 01 WS-PART9 PIC 9(03).
│
│ 01 WS-CT1 PIC 9(03).
│ 01 WS-CT2 PIC 9(03).
│ 01 WS-NBZ PIC 9(02).
│
│ 01 NOM-IPT PIC X(04) VALUE "IPT".
│ 01 NOM-OPT PIC X(04) VALUE "OPT".
│
│ 01 RC PIC S9(05) VALUE ZERO.
│ 01 NB-LU PIC S9(06) COMP VALUE ZERO.
│ 01 NB-OUT PIC S9(06) COMP VALUE ZERO.
│ 01 PTR-OUT PIC S9(05) COMP VALUE ZERO.
│
├─────* Gestion de l'affichage des libelles d'erreurs
│
│ 01 LIB-ERR.
│ 02 COD-ERR PIC 9(02).
│ 02 FILLER PIC X(01).
│ 02 TXT-ERR PIC X(70).
│
│ 01 DSP-ERR.
│ 02 DSP1-ERR PIC X(13).
│ 02 FILLER PIC X(01) VALUE SPACES.
│ 02 DSP2-ERR PIC X(70).
│
│ 01 NAT1-ERR PIC X(13) VALUE "-----EXO-----".
│ 01 NAT8-ERR PIC X(13) VALUE "...........LU".
│ 01 NAT9-ERR PIC X(13) VALUE "*****EXO*****".
└─────*───────────────────────────────────────────────────────────────────────────────
┌───── PROCEDURE DIVISION.
│
├───── DECLARATIVES.
│
│ *----------------------------------------------------------------
│ * La gestion des erreurs fichiers se fait par DECLARATIVES
│ * Le module GESTFST ne fait que decortiquer le FILE STATUS
│ * informe de l'erreur par un display et renvoie un RC
│ * Voir ce programme pour la nature du RC
│ *
│ * Dans ce programme en sortie de DECLARATIVES
│ * on retourne systematiquement au traitement appelant (FILE SATUS inchange)
│ *
│ * Il faut donc tester le FILE-STATUS en retour
│ * - OPEN/CLOSE erreur si FS autre que "00"
│ * - READ erreur si FS autre que "00" ou "10"
│ * - WRITE erreur si FS autre que "00"
│ *
│ * Les declaratives sont appelees s'il y a un incident sur une
│ * operation I/O (OPEN/CLOSE/READ/WRITE).
│ *----------------------------------------------------------------
│
│ ERREUR-IPT SECTION.
│ USE AFTER STANDARD ERROR PROCEDURE ON IPT.
│ IF FS-IPT NOT = "00"
│ CALL "GESTFST" USING "IPT" FS-IPT RC
│ END-IF.
│
│ ERREUR-OPT SECTION.
│ USE AFTER STANDARD ERROR PROCEDURE ON OPT.
│ IF FS-OPT NOT = "00"
│ CALL "GESTFST" USING "OPT" FS-OPT RC
│ END-IF.
│
│ END DECLARATIVES.
└─────*───────────────────────────────────────────────────────────────────────────────
┌───── MAIN-PROC SECTION.
│
├───── P010-D-PROG.
│
│ MOVE ZERO TO RC.
│
│ OPEN INPUT IPT.
│ IF FS-IPT NOT = "00"
│ MOVE "90 PROBLEME A L'OPEN IPT " TO LIB-ERR
│ PERFORM DISPLAY-ERR
│ END-IF.
│
│ OPEN OUTPUT OPT.
│ IF FS-OPT NOT = "00"
│ MOVE "90 PROBLEME A L'OPEN OPT " TO LIB-ERR
│ PERFORM DISPLAY-ERR
│ END-IF.
│
│ *----Recherche enregistrement debut de fichier (01)-----------
│
│ PERFORM WITH TEST AFTER UNTIL IPT-INDICATIF = "01"
│ PERFORM READ-IPT
│ IF FS-IPT = "10"
│ MOVE "92 FICHIER VIDE OU 01 ABSENT" TO LIB-ERR
│ PERFORM DISPLAY-ERR
│ END-IF
│ MOVE LG-IPT TO LG-IPT MOVE IPT-ART TO IPT-LU
│ END-PERFORM.
│
│ *----Recherche du 1er enregistrement 10 (debut du fichier)--------
│
│ PERFORM WITH TEST AFTER UNTIL IPT-INDICATIF = "10"
│ PERFORM READ-IPT
│ IF FS-IPT = "10"
│ MOVE "92 FICHIER VIDE (MANQUE 10)" TO LIB-ERR
│ PERFORM DISPLAY-ERR
│ END-IF
│ MOVE LG-IPT TO LG-IPT MOVE IPT-ART TO IPT-LU
│ END-PERFORM.
└─────*───────────────────────────────────────────────────────────────────────────────
┌───── P020-D-ELEVE.
│
│ *PERFORM WITH TEST BEFORE UNTIL FS-IPT = "10"
│ * OR INDICATIF-LU = "09"
│
│ MOVE SPACES TO OPT-INDICATIF.
│ MOVE SPACES TO OPT-NOM-ELEVE.
│ MOVE SPACES TO OPT-D-NAISSANCE.
│ MOVE SPACES TO ZT-SPORTS.
│ MOVE SPACES TO WS-ART.
└─────*───────────────────────────────────────────────────────────────────────────────
┌───── P030-T-INDICATIF.
│
│ MOVE LG-IPT TO LG-IPT.
│ MOVE IPT-ART TO IPT-LU WS-ART.
│ MOVE SPACES TO WS-PART1 WS-PART2.
│ MOVE ZERO TO WS-CT1 WS-CT2 WS-NBZ.
│
│ UNSTRING WS-Z2 DELIMITED BY ALL SPACES
│ INTO WS-PART1 COUNT WS-CT1
│ WS-PART2 COUNT WS-CT2
│ TALLYING WS-NBZ
│ ON OVERFLOW PERFORM ZONE-OVERFLOW
│ END-UNSTRING.
│
│ *----------------------------------------------------------------
│ * Par cet unstring on separe l'enregistrement lu en 2 morceaux
│ * via un delimiteur constitue par des blancs
│ *
│ * WS-CT1 et WS-CT2 = la taille des zones
│ *
│ * WS-NBZ = nombre de zones
│ *
│ * WS-PART1 et WS-PART2 = le code indicatif
│ *
│ * WS-PART1 = 10 : Nom de l'eleve
│ * WS-PART1 = 11 : Date de naissance
│ * WS-PART1 = 12 : Sport choisi
│ * WS-PART1 = 13 : Sport pratique
│ * WS-PART1 = 09 : EOF
│ *
│ * WS-PART2 = 13 : Heures pratiquees
│ *
│ * En retour de contrôle, IPT-LU sera correctement renseigne
│ *----------------------------------------------------------------
│
├───── CONTROLES-ENTREE.
│
│ *----------------------------------------------------------------
│ * Controles validite des zones suivant le code 10 11 12 13 09
│ * En sortie IPT-LU est correctement renseigne
│ *----------------------------------------------------------------
│
│ EVALUATE IPT-INDICATIF
│ WHEN "10"
│ IF WS-NBZ > 1
│ MOVE "03 PLUS DE 1 ZONE DANS 10" TO LIB-ERR
│ PERFORM DISPLAY-ERR
│ END-IF
│ IF WS-CT1 > MAX-NOM-ELEVE
│ MOVE SPACES TO LIB-ERR
│ STRING "04 NOM ELEVE > " MAX-NOM-ELEVE
│ DELIMITED BY SIZE INTO LIB-ERR
│ PERFORM DISPLAY-ERR
│ END-IF
│ MOVE WS-PART1 TO IPT-NOM-ELEVE
│
│ WHEN "11"
│ IF WS-NBZ > 1
│ MOVE "05 PLUS DE 1 ZONE DANS 11" TO LIB-ERR
│ PERFORM DISPLAY-ERR
│ END-IF
│ IF WS-CT1 > 8
│ MOVE "06 DATE DE NAISSANCE > 8" TO LIB-ERR
│ PERFORM DISPLAY-ERR
│ END-IF
│ MOVE WS-PART1 TO IPR-DATE-NAISSANCE
│
│ WHEN "12"
│ IF WS-NBZ > 1
│ MOVE "07 PLUS DE 1 ZONE DANS 12" TO LIB-ERR
│ PERFORM DISPLAY-ERR
│ END-IF
│ IF WS-CT1 > MAX-NOM-ELEVE
│ MOVE SPACES TO LIB-ERR
│ STRING "08 NOM SPORT CHOISI > " MAX-NOM-ELEVE
│ DELIMITED BY SIZE INTO LIB-ERR
│ PERFORM DISPLAY-ERR
│ END-IF
│ MOVE WS-PART1 TO IPR-SPORT-CHOISI
│
│ WHEN "13"
│ INSPECT WS-PART2 CONVERTING "0123456789" TO SPACES
│ IF WS-PART2 NOT = SPACES
│ MOVE SPACES TO LIB-ERR
│ STRING "09 HEURES NON NUMERIQUES "
│ "FORCEES A ZERO "
│ DELIMITED BY SIZE INTO LIB-ERR
│ PERFORM DISPLAY-ERR
│ MOVE ZERO TO WS-PART9
│ ELSE
│ MOVE SPACES TO WS-PART1 WS-PART2
│ MOVE ZERO TO WS-CT1 WS-CT2
│ UNSTRING Z2-W DELIMITED BY ALL SPACES
│ INTO WS-PART1 COUNT WS-CT1
│ WS-PART9 COUNT WS-CT2
│ END-UNSTRING
│ END-IF
│ IF WS-NBZ > 2
│ MOVE "10 PLUS DE 2 ZONES DANS 13" TO LIB-ERR
│ PERFORM DISPLAY-ERR
│ END-IF
│ IF WS-CT1 > MAX-NOM-ELEVE
│ MOVE SPACES TO LIB-ERR
│ STRING "11 NOM SPORT PRATIQUE > " MAX-NOM-ELEVE
│ DELIMITED BY SIZE INTO LIB-ERR
│ PERFORM DISPLAY-ERR
│ END-IF
│ MOVE WS-PART1 TO IPT-SPORT-PRATIQUE
│ MOVE WS-PART9 TO IPT-NOMBRE-HEURES
│
│ WHEN "09"
│ IF WS-PART1 NOT = "EOF"
│ MOVE "12 ENREGISTREMENT 09 ANORMAL" TO LIB-ERR
│ PERFORM DISPLAY-ERR
│ END-IF
│ WHEN OTHER
│ MOVE "01 ENREGISTREMENT INCONNU" TO LIB-ERR
│ PERFORM DISPLAY-ERR
│ END-EVALUATE.
│
├───── TRAITEMENT-LU.
│
│ *----------------------------------------------------------------
│ * Traitements a faire sachant qu'en working on dispose d'un
│ * enregistrement lu. (Pour chaque nouvel eleve ce sera un 10)
│ * On va ventiler chaque enregistrement dans les zones de stockage
│ *----------------------------------------------------------------
│
│ EVALUATE IPT-INDICATIF
│
│ * Nom de l'eleve (initialisation eleve)-------------
│
│ WHEN "10"
│ MOVE IPT-INDICATIF TO OPT-INDICATIF
│ MOVE IPT-NOM-ELEVE TO OPT-NOM-ELEVE
│ MOVE "00000000" TO OPT-DATE-NAISSANCE
│ MOVE ZERO TO J-TA
│
│ * Date de naissance---------------------------------
│
│ WHEN "11"
│ MOVE IPT-DATE-NAISSANCE TO OPT-DATE-NAISSANCE
│
│ * Sport choisis en option---------------------------
│
│ WHEN "12"
│ SET I-TA TO 1
│ IF J-TA = ZERO
│ PERFORM ADD-SPORT-CHOISI
│ ELSE
│ SEARCH SPORT VARYING I-TA
│ AT END PERFORM ADD-SPORT-CHOISI
│ WHEN SPORT-CHOISI-LU = TA-NOM-SPORT(I-TA)
│ MOVE "14 12 EN DOUBLE IGNORE" TO LIB-ERR
│ PERFORM DISPLAY-ERR
│ END-SEARCH
│ END-IF
│
│ * Sport pratique avec nombre d'heures---------------
│
│ WHEN "13"
│ SET I-TA TO 1
│ SEARCH SPORT VARYING I-TA
│ AT END MOVE "15 13 SANS 12 IGNORE" TO LIB-ERR
│ PERFORM DISPLAY-ERR
│ WHEN IPT-SPORT-PRATIQUE = TA-NOM-SPORT(I-TA)
│ PERFORM ADD-SPORT-PRATIQUE
│ END-SEARCH
│
│ * Fin du fichier------------------------------------
│
│ WHEN "09"
│ MOVE "10" TO FS-IPT
│
│ * Inconnu (deja signale aux controles) -------------
│ *
│ * WHEN OTHER
│
│ END-EVALUATE.
│
├─────*───────────────────────────────────────────────────────────────────────────────
│
│ PERFORM READ-IPT
│
│ IF FS-IPT = "10"
│ MOVE 5 TO LG-IPT
│ MOVE "09EOF" TO ART-IPT
│ MOVE "16 09EOF MANQUANT SIMULATION" TO LIB-ERR
│ PERFORM DISPLAY-ERR
│ ELSE
│ MOVE LG-IPT TO LG-IPT
│ MOVE IPT-ART TO IPT-LU
│ END-IF
│
│ IF IPT-INDICATIF NOT = "10" AND NOT = "09"
├────► THEN GO TO P030-T-INDICATIF.
│
└─────*───────────────────────────────────────────────────────────────────────────────
┌───── P040-F-ELEVE.
│
│ PERFORM VARYING I-TA FROM 1 BY 1 UNTIL I-TA > J-TA
│ MOVE 256 TO LG-OPT
│ MOVE SPACES TO OPT-ART
│ MOVE 1 TO PTR-OUT
│ STRING OPT-NOM-ELEVE DELIMITED BY " " INTO ART-OPT
│ WITH POINTER PTR-OUT
│ STRING TA-NOM-SPORT(I-TA) DELIMITED BY " " INTO ART-OPT
│ WITH POINTER PTR-OUT
│
│ IF TA-H1-SPORT(I-TA) NOT = "0"
│ MOVE TA-H1-SPORT(I-TA) TO C-OPT(PTR-OUT)
│ ADD 1 TO PTR-OUT
│ MOVE TA-H2-SPORT(I-TA) TO C-OPT(PTR-OUT)
│ ADD 1 TO PTR-OUT
│ MOVE TA-H3-SPORT(I-TA) TO C-OPT(PTR-OUT)
│ ELSE
│ IF TA-H2-SPORT(I-TA) NOT = "0"
│ MOVE TA-H2-SPORT(I-TA) TO C-OPT(PTR-OUT)
│ ADD 1 TO PTR-OUT
│ MOVE TA-H3-SPORT(I-TA) TO C-OPT(PTR-OUT)
│ ELSE
│ MOVE TA-H3-SPORT(I-TA) TO C-OPT(PTR-OUT)
│ END-IF
│ END-IF
│
│ MOVE PTR-OUT TO LG-OPT
│ PERFORM WRITE-OPT
│ END-PERFORM.
│
├─────*───────────────────────────────────────────────────────────────────────────────
│
│ * END-PERFORM.
│
│ IF FS-IPT NOT = "10"
│ AND INDICATIF-LU NOT = "09"
├────► THEN GO TO P020-D-ELEVE.
│
└─────*───────────────────────────────────────────────────────────────────────────────
┌───── P050-F-PROG.
│
│ MOVE ZERO TO RC.
│
│ CLOSE IPT.
│ IF FS-IPT NOT = "00"
│ MOVE "91 PROBLEME AU CLOSE IPT " TO LIB-ERR
│ PERFORM DISPLAY-ERR
│ END-IF.
│
│ CLOSE OPT.
│ IF FS-IPT NOT = "00"
│ MOVE "91 PROBLEME AU CLOSE OPT " TO LIB-ERR
│ PERFORM DISPLAY-ERR
│ END-IF.
│
│ DISPLAY NAT1-ERR " NB ENREGISTREMENTS LUS =" NB-LU.
│ DISPLAY NAT1-ERR " NB ENREGISTREMENTS ECRITS =" NB-OUT.
│
├────► FIN. GO TO RETOUR.
│
└─────*───────────────────────────────────────────────────────────────────────────────
┌───── ADD-SPORT-CHOISI.
│ IF I-TA > K-TA
│ MOVE SPACES TO LIB-ERR
│ STRING "13 TROP DE SPORT AUGMENTER TA-SPORT "
│ "ENREGISTREMENT 12 IGNORE"
│ DELIMITED BY SIZE INTO LIB-ERR
│ PERFORM DISPLAY-ERR
│ ELSE
│ ADD 1 TO J-TA
│ MOVE "C" TO TA-C-SPORT(I-TA)
│ MOVE IPT-SPORT-CHOISI TO TA-NOM-SPORT(I-TA)
│ MOVE ZERO TO TA-HEURES-SPORT(I-TA)
│ END-IF.
└─────*───────────────────────────────────────────────────────────────────────────────
┌───── ADD-SPORT-PRATIQUE.
│ MOVE "P" TO TA-C-SPORT(I-TA).
│ MOVE IPT-NOMBRE-HEURES TO TA-HEURES-SPORT(I-TA).
└─────*───────────────────────────────────────────────────────────────────────────────
┌───── READ-IPT.
│ READ IPT.
│ IF FS-IPT NOT = "00" AND NOT = "10"
│ MOVE "93 PROBLEME AU READ IPT " TO LIB-ERR
│ PERFORM DISPLAY-ERR
│ END-IF.
│ ADD 1 TO NB-LU.
└─────*───────────────────────────────────────────────────────────────────────────────
┌───── WRITE-OPT.
│ WRITE ART-OPT.
│ IF FS-OPT NOT = "00"
│ MOVE "80 PROBLEME AU WRITE OPT " TO LIB-ERR
│ PERFORM DISPLAY-ERR
│ END-IF.
│ ADD 1 TO NB-OUT
└─────*───────────────────────────────────────────────────────────────────────────────
┌───── ZONE-OVERFLOW.
│
│ *----------------------------------------------------------------
│ * La condition OVERFLOW apparaitra s'il y avait au moins 2 blancs
│ * c'est a dire plus de 2 zones dans la zone emettrice.
│ * On signale mais on ignore on ne conserve que les 2 premieres
│ *----------------------------------------------------------------
│
│ MOVE "02 PLUS DE 2 ZONES DETECTEES" TO LIB-ERR.
│ PERFORM DISPLAY-ERR.
└─────*───────────────────────────────────────────────────────────────────────────────
┌───── DISPLAY-ERR.
│
│ * Gestion des erreurs --------------------------------------------
│ * Le libelle des erreurs est dans la zone LIB-ERR
│ * Si ce libelle commence par :
│ * - 01-49 Display du lib erreur + article lu mais on continue
│ * - 50-79 Display du lib erreur + article lu mais on s'arrete
│ * - 80-89 Display du lib erreur + article sortie et on s'arrete
│ * - 90-99 Display du lib erreur seul et on s'arrete
│ *----------------------------------------------------------------
│
│ MOVE SPACES TO DSP-ERR.
│ MOVE TXT-ERR TO DSP2-ERR.
│ EVALUATE COD-ERR
│ WHEN 01 THRU 49 MOVE NAT1-ERR TO DSP1-ERR
│ MOVE NAT1-ERR TO DSP1-ERR
│ DISPLAY DSP-ERR
│ MOVE SPACES TO DSP1-ERR
│ DISPLAY DSP1-ERR
│ "/NOM-IPT=>" NOM-IPT "<= "
│ "/LG-IPT=>" LG-IPT "<= "
│ "/ART-IPT=>" ART-IPT "<= "
│ "/NOM-ELEVE=" NOM-ELEVE "<= "
│
│ WHEN 50 THRU 79
│ MOVE NAT9-ERR TO DSP1-ERR
│ DISPLAY DSP-ERR
│ MOVE SPACES TO DSP1-ERR
│ DISPLAY DSP1-ERR
│ "/NOM-IPT=>" NOM-IPT "<= "
│ "/LG-IPT=>" LG-IPT "<= "
│ "/ART-IPT=>" ART-IPT "<= "
│ "/NOM-ELEVE=" NOM-ELEVE "<= "
├────► GO TO RETOUR
│
│ WHEN 80 THRU 89
│ MOVE NAT9-ERR TO DSP1-ERR
│ DISPLAY DSP-ERR
│ MOVE SPACES TO DSP1-ERR
│ DISPLAY DSP1-ERR
│ "/NOM-OPT=>" NOM-OPT "<= "
│ "/LG-OPT=>" LG-OPT "<= "
│ "/ART-OPT=>" ART-OPT "<= "
│ "/NOM-ELEVE=" NOM-ELEVE "<= "
├────► GO TO RETOUR
│
│ WHEN OTHER
│ MOVE NAT9-ERR TO DSP1-ERR
│ DISPLAY DSP-ERR
├────► GO TO RETOUR
│ END-EVALUATE.
└─────*───────────────────────────────────────────────────────────────────────────────
┌───── RETOUR. STOP RUN.
│ *END PROGRAM EXO.
└─────*───────────────────────────────────────────────────────────────────────────────
Merci aux adhérents et aux invités qui me font l’honneur de s’intéresser à mes bêtises.
16/01/2020, 20h35
Invité
Méthode des puits ou méthode des lacs ?
J’espère qu’Obelix84 ne m’en voudra pas de me référer à sa programmation pour argumenter ma réflexion sur le développement.
Ce post s’inspire d’un échange au début de cette discussion entre Obelix84 et moi-même. Mon analyse n’est pas spécifique au COBOL :
Citation:
Envoyé par IFA2377
1ères réactions
Préfixer « FIC » toutes les étiquettes logiques de fichier ne sert strictement à rien, ça coûte inutilement 3 caractères.
Les étiquettes logiques du COBOL deviennent les noms des tables de la BDD.
La norme SQL veut que les noms d’attributs soient préfixés du nom de la table.
nom-table.nom-attribut
Dans cet esprit, je propose non pas de suffixer les noms de données de l’étiquette logique mais l’inverse, de les préfixer de cette étiquette logique. C’est également vrai pour la Working. Je travaillais déjà comme ça en COBOL.
Citation:
Envoyé par Obelix84
Que l'on désire passer par une normalisation des noms d'étiquettes est certainement une bonne chose, mais ma "normalisation" personnelle permet de m'y retrouver... et elle est suffisamment explicite pour de la maintenance. Maintenant avec un bon éditeur et une rafale de CHANGE ALL on normalise comme on veut.
« Puits/Lacs », C’est une métaphore empruntée à un ouvrage des années 80 sur la conception d’un système d’information. Elle convient bien à ce que je veux exprimer à propos de développement (programmation).
La métaphore « Verticalité/Horizontalité » convient davantage à la compréhension des flux d’informations, la verticalité représentant l’axe hiérarchique et l’horizontalité, le processus de production.
Méthode des puits
Dans sa réponse, Obelix84 dit : « ma "normalisation" personnelle permet de m'y retrouver... ».
Autrement dit, Obelix84 programme pour lui-même. Lorsqu’il commente, il s’adresse à lui-même et voit donc son programme comme une entité indépendante, un puits.
Cette démarche n’empêche pas de respecter une forme de "normalisation" et certainement de ressentir du plaisir à programmer. Mais ce plaisir ne correspond-il pas au plaisir ludique de la programmation par conditionnement ?
Méthode des lacs
À l’inverse, mes 1ères réactions avaient pour objectif de faire passer un autre message : programmer non pas pour se comprendre mais pour être compris, pour que n’importe qui puisse s’y retrouver, pour faciliter la lecture en faisant preuve d’empathie cognitive. Et cela change tout. Cela suppose la conception et le respect de normes de programmation pour l’ensemble de tous les programmes, un lac.
Cette démarche n’impacte pas seulement les différentes sortes de nommage mais également la structure du programme. Il ne s’agit plus de ressentir le plaisir ludique d’une programmation par conditionnement mais de respecter la Logique de Construction de Programme. On ne programme plus avec une vision séquentielle jubilatoire mais avec une maitrise du raisonnement qui génère sans doute une certaine frustration créative. On programme les instructions là où elles doivent être.
Un argument ?
Dans mon message précédent, j’évoque nos façons différentes d’utiliser une table :
Citation:
Envoyé par IFA2377
J’ai traité la table à ma façon, comme au bon vieux temps. Table TA-SPORT (SPORT) avec l’index courant I-TA (IDXS), l’index borne de la table remplie J-TA (NB-SPORT) et l’index maximum de la table K-TA (MAX-SPORT). C’est classique, c’est standard, c’est immédiatement compréhensible, c’est imparable.
Dans la version d’Obelix84 (noms barrés), on voit clairement que la table et ses index sont spécifiques au programme. Selon moi, ces choix de nommage singularisent la programmation (puits) et satisfont vraisemblablement une forme de pulsion créative illusoire.
À l’inverse, dans la version que je propose, la table et ses index répondent à une norme de programmation. Dans un autre programme utilisant une autre table, on retrouvera une table TA-… avec ses index I-TA, J-TA, K-TA… (lac).
Méthode des puits ou méthode des lacs ?
Alors, vous êtes quoi ? Puits ou Lac ?
Vous programmez pour vous comprendre ou pour vous faire comprendre ?
Vous réinventez chaque nouveau programme ou vous respectez des normes de programmation ?
Vous êtes addicts à la programmation pour son côté ludique et illusoirement créatif ou votre créativité s’exprime-t-elle dans l’analyse conceptuelle, l’adoption d’une mise en page et de normes de programmation ?
Vous pensez par conditionnement ou par traitement ?
07/02/2020, 17h19
Invité
Petit problème d’algorithmique avec une table
Vous êtes toujours là ?
Les exercices d’Obelix84 et d’elosam782 qui traitent de la gestion d’une table me rappellent ce programme de mes débuts en 1971. À cette époque, les disques de 600 millions de caractères venaient de faire leur apparition. Une unité de disque ressemblait à un sèche-linge avec un tambour horizontal. Le disc-pack ressemblait à dix vinyles 33 tours superposés.
L’accès aux informations n’était pas encore très performant. Afin d’optimiser les traitements, il était préférable que le programme aille d’abord chercher l’information en mémoire avant d’aller la chercher sur disque. Il y avait de grandes chances que cette information ait été lue récemment. J’ai oublié le nombre d’items de la table, disons une douzaine pour la compréhension de l’algorithme. Lorsque le programme avait besoin de l’information, l’objectif était donc de parcourir cette table de l’item le plus récemment lu jusqu’au plus ancien avant de se résoudre à faire un accès disque et remplacer l’information de l’item le plus ancien de la table (lorsque la table était remplie) par l’information lue sur disque.
La table peut être vue comme le cadran d’une pendule et les heures comme les items. Au début de l’exécution du programme, la table doit être progressivement alimentée jusqu’à douze. Lorsqu’il n’y a donc que six items renseignés, par exemple, le programme parcoure la table du sixième item vers le premier et s’il ne trouve pas l’information, un accès disque renseignera le septième item qui deviendra l’item le plus récent à partir duquel la prochaine recherche commencera.
Les douze items renseignés, le prochain accès disque nécessaire viendra remplacer l’information du premier item. La recherche en table suivante partira par conséquent de l’item N° 1 et remontera la table à l’envers jusqu’à l’item N° 2. Etc. etc.
Algorithme intéressant, non ?
… C’était pour vous donner de quoi lire car je continue de surveiller cette discussion et je m’étonne qu’il y ait toujours au moins une dizaine de connexions chaque jour.
