C
C TD 23/05/85 T.DUQUESNAY V1.1 corrections
	INCLUDE 'ACCESS.ENT/LIST'
C
	CHARACTER NAME*60	! nom du fichier demande
	BYTE NAME_LISTE(60)	! nom de la liste des fichiers
C
C  description des enregistrements
	CHARACTER NAME_LU*60	! nom du fichier 
	CHARACTER LIBRE		! R SI RESERVE , L SI LIBRE
	CHARACTER PROPRIO*12	! nom du reservataire		
	CHARACTER DATE_R*9	! date de la reservation
C
	CHARACTER SPAWN_LIGNE*130
	CHARACTER*6 CAR_RECORD
	INTEGER*2 I,RECORD,NB_RECORD
	INTEGER*4 RET_STATUS,ERREUR
	LOGICAL*1 TROUVE,FIN
C
	INTEGER CLI$GET_VALUE,CLI$PRESENT
	INTEGER SYS$GETJPI,LIB$SPAWN,LIB$STOP
	EXTERNAL JPI$_USERNAME,SS$_NORMAL
	EXTERNAL CLI$_PRESENT,CLI$_DEFAULTED,CLI$_ABSENT,CLI$_NEGATED
C
	INTEGER*4 ITEMLIST(3)
	INTEGER*2 ITEM2(2)
	EQUIVALENCE (ITEMLIST(1),ITEM2(1))
	CHARACTER USERNAME*12
	INTEGER RETURN_LENGTH
	INTEGER*2 IOSB(4)
C
C
	CALL DATE (DATE_R)
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   ouverture du fichier controlant les acces
C
	OPEN (UNIT=2,NAME=NAME_LISTE,STATUS='OLD',ACCESS='DIRECT',
     1         ORGANIZATION='RELATIVE',RECL=82,FORM='FORMATTED',
     2         ERR=299,IOSTAT=ERREUR)
	IF (ERREUR .NE. 0) THEN
		TYPE 1002
		GOTO 90000
	END IF
C
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
C   recherche en comparant les noms de fichier
C
	TROUVE = .FALSE.
	READ (2'1,7001,ERR=399) CAR_RECORD
7001	FORMAT (A6)
7000	FORMAT (A60,A1,A12,A9)
	DECODE (6,1202,CAR_RECORD) NB_RECORD
1202	FORMAT (I6)
	RECORD = 1
	DO WHILE (.NOT. TROUVE)
C
	    RECORD = RECORD + 1
	    IF (RECORD .GT. NB_RECORD+1) GOTO 400
	    READ (2'RECORD,7000,ERR=399) NAME_LU,LIBRE,PROPRIO
C
C	   comparaison
C
	    FIN = .FALSE.
	    I = 1
	    DO WHILE ((.NOT. FIN) .AND. 
     1		((NAME_LU(I:I).NE.' ')).AND.(NAME_LU(I:I).NE.CHAR(0)))
	        TROUVE = .TRUE.	   !on suppose avoir trouve
		IF (NAME_LU(I:I) .NE. NAME(I:I)) THEN
		    FIN = .TRUE.
		    TROUVE = .FALSE.
		END IF
		I = I + 1
		IF (I .GT. 60) FIN = .TRUE.
	    END DO
	END DO
C
C   on a trouve sinon on serait en 400 (fin de fichier)
C
	IF (LIBRE .EQ. 'R') THEN
C	  fichier reserve
		TYPE 1001,PROPRIO
		GOTO 90000
	ELSE
C
C	  reservation du fichier
C
	    IF (CLI$PRESENT('BLOQUAGE') .EQ. %LOC(CLI$_NEGATED)) THEN
		LIBRE = 'L'
	    ELSE
		LIBRE = 'R'
	    END IF
	    ITEM2(1) = 12
	    ITEM2(2) = %LOC(JPI$_USERNAME)
            ITEMLIST(2) = %LOC(USERNAME)
	    ITEMLIST(3) = %LOC(RETURN_LENGTH)
	    ERREUR = SYS$GETJPI (,,,%REF(ITEMLIST),IOSB,,)
	    IF (ERREUR .NE. %LOC(SS$_NORMAL)) THEN
		TYPE 1009,ERREUR,(IOSB(I),I=1,4)
		GOTO 90000
	    ELSE 
	        IF (IOSB(1) .NE. %LOC(SS$_NORMAL)) THEN
	  	    TYPE 1009,ERREUR,(IOSB(I),I=1,4)
	 	END IF
	    END IF
C
	    WRITE (2'RECORD,7000,ERR=499) NAME_LU,LIBRE,USERNAME,DATE_R
C
C	  execution de la commande COPY correspondante a la reservation
C
C	   on ne prend que le nom de fichier et 
C	   pas le nom de directory qui peut preceder
	    I = INDEX(NAME_LU,':')
	    J = INDEX(NAME_LU,']')
	    IF (J .GT. I) I = J
C
	    SPAWN_LIGNE = '$COPY/LOG '//NAME//' '//NAME_LU(I+1:)
C
	    ERREUR = LIB$SPAWN (%DESCR(SPAWN_LIGNE))
	    IF (.NOT. ERREUR) ERREUR = LIB$STOP (%VAL(ERREUR))
C
	    CALL EXIT (1)
	END IF
C
400	CONTINUE
C   fichier inexistant dans la liste
	TYPE 1005
	CALL EXIT (1)
C
299	CONTINUE
	TYPE 1009,ERREUR,(IOSB(I),I=1,4)
	TYPE 1002
	GOTO 90000
399	CONTINUE
	TYPE 1004
	GOTO 90000
499	CONTINUE
	TYPE 1006
	GOTO 90000
C
C
1001	FORMAT (1X,' ce fichier est deja reserve par : ',A12)
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
90000	CONTINUE
	CALL EXIT (0)
	END
