[AS400] Supprimer dans un fichier indexé

[alex2746]

Bonjour,
J'ai un fichier indexé contenant des Voyages entre 2 villes.
Dans ce fichiers on retrouve un format d'enregistrement VOYAGER divisé en:

Code :

1
2
3
DEPART     PIC X(5) 
ARRIVEE    PIC X(5)

L'identifiant de ce fichier est le couple DEPART ARRIVEE.

Je voudrais écrire un petit programme Cobol qui supprime tous les enregistrements dont DEPART vaut une certaine valeur (disons PARIS). Je pensais faire une lecture séquentielle de tout le fichier et avec un IF vérifier si pour l'enregistrement DEPART = PARIS, si c'est le cas supprimer l'enregistrement, passer à l'enregistrement suivant, vérifier... etc. Mais ca me semble très long.

Avez-vous une meilleure solution? Peut-être avec un start, etc mais je n'y arrive pas...

Merci d'avance.

[Hédhili Jaïdane]

Bonjour.

Comme ton fichier est indexé sur (DEPART, ARRIVEE), tu fais un START avec DEPART = PARIS et ARRIVEE = Spaces/Low-value et tu enchaines par une lecture séquentielle jusqu'à la fin du fichier ou DEPART <> PARIS en faisant un DELETE.

[alex2746]

Bonjour,
Merci pour la réponse.

Je ne connais pas bien le fonctionnement d'un start.
Je pense donc faire:

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
   MOVE 'PARIS' TO DEPART 
   MOVE SPACES TO ARRIVEE
   START monFichier 
       KEY IS ...
       INVALID KEY "Pas de PARIS"
       NOT INVALID KEY PERFORM TRT UNTIL EOF or DEPART <> 'PARIS'
   END-START. 

TRT.
   DELETE
     ...
   END-DELETE. 
   READ 
     ...
     AT END SET EOF TO TRUE
   END-READ.

Est ce que ce morceau de code vous semble correcte? Que dois je mettre dans le KEY IS... du start?

Encore merci !

[Hédhili Jaïdane]

Code :

1
2
3
4
KEY NOT LESS clé (ou NOT <)
INVALID PERFORM INVALID-EXIT
NOT INVALID PERFORM TRT....

et dans TRT tu commences par un READ et lorsque c'est concluant (pas de at end ni différent de PARIS) tu fais le DELETE.

- Le START ne fait que pointer l'enregistrement répondant au critère (clé et opérateur), il ne réalise pas de lecture.

- si tu as une description externe, il suffit de mettre EXTERNALLY-DESCRIBED-KEY à la place de clé

- Si dans le SELECT tu as prévu un accès DYNAMIC tu dois faire un READ NEXT.

[alex2746]

Merci.
Donc comme ceci si j'ai bien compris:

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
   dans mon select je suis en dynamic

   dans les déclarations: 
   01 cle
       03 DEPART PIC X(5)
       03 ARRIVEE PIC X(5)

   MOVE 'PARIS' TO DEPART OF cle
   MOVE SPACES TO ARRIVEE OF cle
   START monFichier 
       KEY NOT LESS cle
       INVALID KEY DISPLAY "Pas de PARIS"
       NOT INVALID KEY PERFORM TRT UNTIL EOF or DEPART <> 'PARIS'
   END-START. 

TRT.
   READ monFichier
     ...
     AT END SET EOF TO TRUE
   END-READ.
   DELETE
     ...
   END-DELETE. 
   READ monFichier NEXT
     ...
     AT END SET EOF TO TRUE
   END-READ.

C'est bien comme ca? Surtout pour les points suivant:
1/cle
2/premier read dans trt
3/deuxième read dans trt

[Hédhili Jaïdane]

- si tu as ACCESS is DYNAMIC, tu dois faire du READ monfichier NEXT
- il faudrait arranger le NOT INVALID du START autrement, parce que sinon il va te supprimer le premier enregistrement lu après PARIS. Tant qu'il n'y a pas de lecture réussie, il ne peut pas comparer DEPART en provenance du fichier à PARIS. Soit que tu fais une lecture initiale soit tu dissocies les critères de la condition de fin.

[alex2746]

Encore merci pour l'aide

Pour la clé c'est bien si je déclare une petite structure comme j'ai fait?

Voici mon code modifié:

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
dans les déclarations: 
   01 cle
       03 DEPART PIC X(5)
       03 ARRIVEE PIC X(5)
------------------------------------------------------------

   MOVE 'PARIS' TO DEPART OF cle
   MOVE SPACES TO ARRIVEE OF cle
   START monFichier 
       KEY NOT LESS cle
       INVALID KEY DISPLAY "Pas de PARIS"
       NOT INVALID KEY PERFORM TRT-1 UNTIL EOF
   END-START. 

TRT-1.
   READ monFichier NEXT
     ...
     AT END SET EOF TO TRUE
   END-READ.
   PERFORM TRT-2 UNTIL DEPART <> 'PARIS'.

TRT-2.
   DELETE
     ...
   END-DELETE.

Qu'en pensez vous?

Merci d'avance.

[Hédhili Jaïdane]

- le 01 de la clé est mauvais, il est réservé au buffer du fichier :

Code :

1
2
3
4
5
6
0026   FD  MONFICHIER LABEL RECORD STANDARD.
0027   01  MONFICHIER-RD.
0028       03 CLE.
0028          05 DEPART   PIC X(5).
0028          05 ARRIVEE  PIC X(5).
0000       03...

- le PERFORM TRT-2 doit être protégé par un IF NOT EOF ou un NOT AT END en déplaçant le END-READ.

[alex2746]

Comme ceci tout vous semble bien?

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
   MOVE 'PARIS' TO DEPART OF cle
   MOVE SPACES TO ARRIVEE OF cle
   START monFichier 
       KEY NOT LESS cle
       INVALID KEY DISPLAY "Pas de PARIS"
       NOT INVALID KEY PERFORM TRT-1 UNTIL EOF
   END-START. 

TRT-1.
   READ monFichier NEXT
     AT END SET EOF TO TRUE
   END-READ.
   PERFORM TRT-2 UNTIL EOF or DEPART <> 'PARIS'.

TRT-2.
   DELETE
     ...
   END-DELETE.

Comme ceci tout vous semble bien?

Encore merci pour votre aide!

[Hédhili Jaïdane]

Bonjour.

Il suffit de tester pour voir si c'est bon

[alex2746]

C'est en ordre, merci pour votre aide

[Hédhili Jaïdane]

Maintenant que tu as fait ton programme, un petit dernier pour la route.
C'est pas top top, mais ça peut servir.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
0002   IDENTIFICATION DIVISION. 
0003  ****************************************************************** 
0004  *   SUPPRESSION ENREGISTREMENTS CONTENANT UEN VALEUR PARTICULIERE 
0004  *   DE LA PARTIE MAJEURE DE LA CLE 
0005  * 
0006  ****************************************************************** 
0007   PROGRAM-ID. DELVOY. 
0008   ENVIRONMENT DIVISION. 
0009   CONFIGURATION SECTION. 
0010   SOURCE-COMPUTER. IBM-AS400. 
0011   OBJECT-COMPUTER. IBM-AS400. 
0012   SPECIAL-NAMES. 
0013       REQUESTOR IS MONTERMINAL. 
0014   INPUT-OUTPUT SECTION. 
0015   FILE-CONTROL. 
0016       SELECT MONFICHIER ASSIGN TO DISK-MONFICHIER 
0017          ORGANIZATION IS INDEXED 
0018          ACCESS IS DYNAMIC 
0019          RECORD KEY IS CLE. 
0024   DATA DIVISION. 
0025   FILE SECTION. 
0026   FD  MONFICHIER LABEL RECORD STANDARD. 
0027  01  MONFICHIER-RD. 
0028      03 CLE. 
0028         05 DEPART   PIC X(7). 
0028         05 ARRIVEE  PIC X(7). 
0028      03 FILLER      PIC X(61). 
0032   WORKING-STORAGE SECTION. 
0033   77  WDEPART        PIC X(7). 
0000   77  EOT            PIC X. 
0000   77  EOF            PIC X. 
0000   77  REP            PIC X. 
       77  NBR            PIC 9(7). 
       77  ZNBR           PIC Z(6)9. 
0039   PROCEDURE DIVISION. 
0040   DEBUT SECTION. 
0041   D1. 
0042       OPEN I-O MONFICHIER. 
0033       MOVE0 TO EOT. 
0000       PERFORM TRAITEMENT UNTIL EOT = 1. 
0000       CLOSE MONFICHIER. 
0000       STOP RUN. 
0000   TRAITEMENT. 
0043       DISPLAY " " UPON MONTERMINAL. 
0044       DISPLAY "DONNER LA VILLE DE DEPART A SUPPRIMER SUR 5c"   
0045               UPON MONTERMINAL. 
0046       ACCEPT WDEPART FROM MONTERMINAL. 
0000       IF WDEPART = SPACES OR LOW-VALUE 
0000          MOVE 1 TO EOT 
0000       ELSE PERFORM SUPPRESSION. 
0000   SUPPRESSION. 
0000       MOVE WDEPART TO DEPART. 
0000       MOVE SPACES TO ARRIVEE. 
0000       MOVE0 TO EOF. 
0000       MOVE0 TO NBR. 
0000       START MONFICHIER KEY NOT < CLE 
0000             INVALID DISPLAY "AUCUN DEPART A PARTIR DE : " WDEPART 
0000                     UPON MONTERMINAL 
0000                     ACCEPT REP FROM MONTERMINAL 
0000                     MOVE 1 TO EOF 
0000             NOT INVALID PERFORM SUPPR-READ UNTIL EOF = 1. 
0000       MOVE NBR TO ZNBR. 
0000       DISPLAY ZNBR " VOYAGES A PARTIR DE " WDEPART 
0000               " ONT ETE SUPPRIMES" UPON MONTERMINAL. 
0000       ACCEPT REP FROM MONTERMINAL. 
0000   SUPPR-READ. 
0000       READ MONFICHIER NEXT AT END MOVE 1 TO EOF. 
0000       IF EOF NOT = 1 PERFORM SUPPR-DELETE. 
0000   SUPPR-DELETE. 
0000       IF DEPART NOT = WDEPART MOVE 1 TO EOF 
0000       ELSE DELETE MONFICHIER INVALID CONTINUE 
0000            NOT INVALID ADD 1 TO NBR.