C TD 23/05/85  V 1.1  MODIF COMMANDE SPAWN, MODIF DANS /AJOUT
C
C
	BYTE NAME_LISTE(60)	! nom de la liste des fichiers
C
C  description des enregistrements
	CHARACTER NAME_LU*60	! nom du fichier 
	CHARACTER LIBRE*1	! R SI RESERVE , L SI LIBRE
	CHARACTER PROPRIO*12	! nom du reservataire		
	CHARACTER DATE_R*9	! date de la reservation
C
	CHARACTER BLANC*76
	CHARACTER*6 CAR_RECORD
	INTEGER*2 I,RECORD,NB_RECORD,NUM_RECORD_VIDE
	INTEGER*4 RET_STATUS,ERREUR
	LOGICAL*1 TROUVE,FIN,LIGNE_VIDE
	CHARACTER LIGNE_CDE*130,RECUP_FICH*30,NAME*60
C
	INTEGER CLI$GET_VALUE,CLI$PRESENT,LIB$SPAWN
	EXTERNAL CLI$_PRESENT,CLI$_DEFAULTED,CLI$_ABSENT,CLI$_NEGATED
C
C	INTEGER SYS$GETJPI
C	EXTERNAL JPI$_TERMINAL,SS$_NORMAL
C	INTEGER*2 IOSB(4),SIZETERM
C	CHARACTER*7 TERM
C	INTEGER*4 ITMLST(3)
C	INTEGER*2 ITEM(2)
C	EQUIVALENCE (ITMLST(1),ITEM(1))
C
C
C   initialisations diverses
C
	NUM_RECORD_VIDE = 0
C
C   acquisition du nom de la liste passe avec la commande
C
	RET_STATUS = CLI$GET_VALUE ('PROJET',%DESCR(NAME_LISTE))
	IF (.NOT. RET_STATUS) THEN
		TYPE 1003
		GOTO 90000
	END IF
C
C
C
C		COMMANDE : /CREATION nom_liste
C		******************************
C
	IF (CLI$PRESENT('CREATION')) THEN
C
	    OPEN (UNIT=2,NAME=NAME_LISTE,STATUS='NEW',ACCESS='DIRECT',
     1           ORGANIZATION='RELATIVE',RECL=82,
     2		 FORM='FORMATTED',ERR=299,IOSTAT=ERREUR)
	    IF (ERREUR .NE. 0) THEN
		TYPE 1002
		GOTO 90000
	    END IF
	    NB_RECORD = 0
	    ENCODE (6,1202,CAR_RECORD) NB_RECORD
	    WRITE (2'1,7001,ERR=499) CAR_RECORD,BLANC
7001	    FORMAT (A6,A76)
7000	    FORMAT (A60,A1,A12,A9)
	    LIBRE = 'L'
	    PROPRIO = '            '
	    NAME_LU = PROPRIO
	    DATE_R = '         '
	    WRITE (2'2,7000,ERR=499) NAME_LU,LIBRE,PROPRIO,DATE_R
	    CLOSE (UNIT=2)
	    CALL EXIT (1)
	END IF
C
C
C
C		COMMANDE : /INIT nom_liste
C		**************************
C
	IF (CLI$PRESENT('INIT')) THEN
C
	    OPEN (UNIT=2,NAME=NAME_LISTE,STATUS='OLD',ACCESS='DIRECT',
     1           ORGANIZATION='RELATIVE',RECL=82,
     2		 FORM='FORMATTED',ERR=299,IOSTAT=ERREUR)
	    IF (ERREUR .NE. 0) THEN
		TYPE 1002
		GOTO 90000
	    END IF
	    READ (2'1,7001,ERR=399) CAR_RECORD,BLANC
	    DECODE (6,1202,CAR_RECORD) NB_RECORD
	    NB_RECORD = NB_RECORD + 1
	    RECORD = 1
	    DO RECORD = 2,NB_RECORD
C
	    	READ (2'RECORD,7000,ERR=399) NAME_LU,LIBRE,PROPRIO
C
		LIBRE = 'L'
		PROPRIO = '            '
		DATE_R = '         '
C
		WRITE (2'RECORD,7000,ERR=499) NAME_LU,LIBRE,PROPRIO,DATE_R
C
	    END DO
	    CLOSE (UNIT=2)
	    CALL EXIT (1)
	END IF
C
C
C
C		COMMANDES : /AJOUT [/RECUPERE=nom_fich] nom_liste nom_fich
C		*********   /LIBERE [/RECUPERE=nom_fich] nom_liste nom_fich
C			    /DELETE nom_liste nom_fich
C		
C   acquisition du nom de fichier passe avec la commande
C
	RET_STATUS = CLI$GET_VALUE ('P2',%DESCR(NAME))
	IF (.NOT. RET_STATUS) THEN
		TYPE 1003
		GOTO 90000
	END IF
C
C   ouverture du fichier controlant les acces
C
	OPEN (UNIT=2,NAME=NAME_LISTE,STATUS='OLD',ACCESS='DIRECT',
     1           ORGANIZATION='RELATIVE',RECL=82,
     2		 FORM='FORMATTED',ERR=299,IOSTAT=ERREUR)
	IF (ERREUR .NE. 0) THEN
		TYPE 1002
		GOTO 90000
	END IF
C
C
C
C   acquisition du nom du terminal utilise (necessaire pour les SPAWNS)
C
C	ITEM(1) = 12
C	ITEM(2) = %LOC(JPI$_TERMINAL)
C	ITMLST(2)= %LOC(TERM)
C	ITMLST(3)= %LOC(SIZETERM)
C	TERM = '      '
C	ERREUR = SYS$GETJPI (,,,ITMLST,IOSB,,)
C	IF (ERREUR .NE. %LOC(SS$_NORMAL)) THEN
C		TYPE 1200,ERREUR
C1200		FORMAT (1X,'ERREUR "GETJPI" ',I6)
C		GOTO 90000
C	END IF
C
C	TYPE 1201,TERM
C1201	FORMAT (1X,' TERM = ',A7)
C
C
C   recherche en comparant les noms de fichier
C
	LIGNE_VIDE = .FALSE.
	TROUVE = .FALSE.
	READ (2'1,7001,ERR=399) CAR_RECORD,BLANC
	DECODE (6,1202,CAR_RECORD) NB_RECORD
1202	FORMAT (I6)
	NB_RECORD = NB_RECORD + 1
	RECORD = 1
	DO WHILE (.NOT. TROUVE)
C
	    RECORD = RECORD + 1
	    IF (RECORD .GT. NB_RECORD) GOTO 400
	    READ (2'RECORD,7000,ERR=399) NAME_LU,LIBRE,PROPRIO
C
	    IF (.NOT. LIGNE_VIDE) THEN
	      IF ((NAME_LU(1:1).EQ.' ').OR.(ICHAR(NAME_LU(1:1)).EQ.0)) THEN
C		 c'est la premiere ligne vide rencontree
		NUM_RECORD_VIDE = RECORD
		LIGNE_VIDE = .TRUE.
	      END IF
	    END IF
C
C	 comparaison
C
	    FIN = .FALSE.
	    I = 1
	    TROUVE = .TRUE.     	!on suppose avoir trouve
	    DO WHILE ((.NOT. FIN) .AND. (I .LE. 60))
		IF (NAME_LU(I:I) .NE. NAME(I:I)) THEN
		    FIN = .TRUE.
		    TROUVE = .FALSE.
		END IF
		I = I + 1
	    END DO
	END DO
C
C   on a trouve sinon on serait en 400 (fin de fichier)
C
	IF (CLI$PRESENT('LIBERE')) THEN
C
	    LIBRE = 'L'
	    PROPRIO = '            '
	    DATE_R = '         '
	    WRITE (2'RECORD,7000,ERR=499) NAME_LU,LIBRE,PROPRIO,DATE_R
	    CLOSE (UNIT=2)
C
	    IF (CLI$PRESENT('RECUPERE')) THEN
C
		RET_STATUS = CLI$GET_VALUE ('RECUPERE',%DESCR(RECUP_FICH))
		IF (.NOT. RET_STATUS) THEN
		    TYPE 1003
		    GOTO 90000
		END IF
C
C 		LIGNE_CDE='$ACCESS$REC '//RECUP_FICH//' '//NAME//' '//TERM
 		LIGNE_CDE='$ACCESS$REC '//RECUP_FICH//' '//NAME
C	    	TYPE 88,LIGNE_CDE
88	    	FORMAT (1X,A130)
	    	ERREUR = LIB$SPAWN (LIGNE_CDE)
	    	IF (.NOT. ERREUR) CALL EXIT (ERREUR)
C
	    END IF
C
	    CALL EXIT (1)
	END IF
C
	IF (CLI$PRESENT('DELETE')) THEN
C
	    LIBRE = 'L'
	    PROPRIO = '            '
	    NAME_LU = PROPRIO
	    DATE_R = '         '
	    WRITE (2'RECORD,7000,ERR=499) NAME_LU,LIBRE,PROPRIO,DATE_R
	    CLOSE (UNIT=2)
	    CALL EXIT (1)
	END IF
C
	IF (CLI$PRESENT('AJOUT')) THEN
C
	    TYPE 1010,NAME
1010	    FORMAT (1X,'le fichier ',A60,' existe deja')
	    GOTO 90000
C
	END IF
C
	CLOSE (UNIT=2)
	CALL EXIT (1)
C
C
400	CONTINUE
C   fichier inexistant dans la liste
C
	IF (CLI$PRESENT('AJOUT')) THEN
C
	    IF (.NOT. LIGNE_VIDE) THEN
C		  pas de lignes vides donc ajout en fin de fichier
		NUM_RECORD_VIDE = NB_RECORD + 1
		ENCODE (6,1202,CAR_RECORD) NB_RECORD
		WRITE (2'1,7001,ERR=499) CAR_RECORD,BLANC
	    END IF
	    LIBRE = 'L'
	    PROPRIO = '            '
	    DATE_R = '         '
	    WRITE (2'NUM_RECORD_VIDE,7000,ERR=499) NAME,LIBRE,PROPRIO,DATE_R
	    CLOSE (UNIT=2)
C
	    IF (CLI$PRESENT('RECUPERE')) THEN
C
		RET_STATUS = CLI$GET_VALUE ('RECUPERE',%DESCR(RECUP_FICH))
		IF (.NOT. RET_STATUS) THEN
		    TYPE 1003
		    GOTO 90000
		END IF
C
C 		LIGNE_CDE='$ACCESS$REC '//RECUP_FICH//' '//NAME//' '//TERM
 		LIGNE_CDE='$ACCESS$REC '//RECUP_FICH//' '//NAME
C	    	TYPE 88,LIGNE_CDE
	    	ERREUR = LIB$SPAWN (%DESCR(LIGNE_CDE))
	    	IF (.NOT. ERREUR) CALL EXIT (ERREUR)
C
	    END IF
C
	    CALL EXIT (1)
C
	ELSE
	    TYPE 1005
	    GOTO 90000
	END IF
C
299	CONTINUE
	TYPE 1002
	GOTO 90000
399	CONTINUE
	TYPE 1004
	GOTO 90000
499	CONTINUE
	TYPE 1006
	GOTO 90000
C
C
1002	FORMAT (1X,' je n''ai pas reussi a ouvrir le fichier liste')
1003	FORMAT (1X,' erreur dans le parametre')
1004	FORMAT (1X,' erreur de lecture de la liste')
1005	FORMAT (1X,' ce fichier ne fait pas partie de la liste')
1006	FORMAT (1X,' probleme d''ecriture dans le fichier')
1009	FORMAT (1X, 'ERREUR=',I9,'  IOSB(1,4)=',4(I9))
C
C
90000	CONTINUE
	CLOSE (UNIT=2)
	CALL EXIT (0)
	END
