C PROGRAM UPDATE 8-May-80 C C This program is used for maintaining file documentation C In the form of annotated and updatable disk file directories. C it requests from the user the names of three files: C (1) old tagged directory - this is a directory previously created C by this program which one wishes to update (or if creating a new C tagged file, this can be most anything). Previously C assigned tags are transferred from here to the new tagged direct- C ory. C (2) pip directory - this is a disk directory produced by pip. C This directory is used to update the old tagged directory by C reflecting added or deleted files and newer versions of old ones. C (3) new tagged directory - this is the updated tagged directory C produced by tagfil. C C For every file in the pip directory, the old tagged directory C is searched. If a tag exists for the file, it is copied into the n C new tagged directory. If not, a tag for the file is requested from C the terminal. If you dont wish to tag a file, just hit . C Modifications to old tags and similar operations can best be C performed using edit. C =============================================== C C This program has been modified to update a tagged directory file C on device DK: automatically using the command file UPDATE.COM C C This program is only slightly modified from the program TAGFIL C C =============================================== C COMMON /IODEV/ IOLD,IDIR,INEW,ITI,ITO COMMON IBL,IDOT,ICNT,JNAM(10),FILE(3) COMMON /ENTRY/ INAM(10),ICOD(24),ITAG(80) COMMON /SIZES/ NAMSIZ,ICDSZ,ITGSZ C DATA IOLD,IDIR,INEW,ITI,ITO/1,2,3,5,5/ DATA IBL,IDOT,ICNT/1H ,1H.,0/ NAMSIZ=10 ICDSZ=24 ITGSZ=80 C ALLOW LOWER CASE INPUT.... CALL IPOKE("44,"40000.OR.IPEEK("44)) C C INTRODUCE YOURSELF, KID.... WRITE(ITO,790) C GET LOGICAL UNIT FILE ASSIGNMENTS... c WRITE(ITO,810) CALL ASSIGN(1,'SY:DIR.OLD') c WRITE(ITO,820) CALL ASSIGN(2,'SY:DIR.NEW') c WRITE(ITO,830) CALL ASSIGN(3,'DK:DIR.TAG') C 790 FORMAT(' UPDATE - (MAY-80)') 810 FORMAT(' OLD TAGGED DIRECTORY FILE?',$) 820 FORMAT(' PIP DIRECTORY FILE?',$) 830 FORMAT(' NEW TAGGED DIRECTORY FILE?',$) C C MAIN LOOP - READ NEXT LINE FROM IDIR... 10 READ(IDIR,700,END=500)(INAM(I),I=1,NAMSIZ),(ICOD(I),I=1,ICDSZ) C IS IT A DIRECTORY ENTRY? (LOOK FOR PERIOD IN COL 7) IF(INAM(7).NE.IDOT) GOTO 200 C ITS AN ENTRY, LOOK FOR IT IN IOLD... CALL SEARCH(IFOUND) IF(IFOUND.GE.0) GOTO 100 C IF NOT TAGGED IN IOLD, REQUEST TAG FROM TERMINAL. WRITE(ITO,710) (INAM(I),I=1,NAMSIZ),(ICOD(I),I=1,ICDSZ) READ(ITI,700) (ITAG(I),I=1,ITGSZ) 100 CONTINUE IRT=ITGSZ 110 IF(ITAG(IRT).NE.IBL) GOTO 120 IRT=IRT-1 IF(IRT.GT.1) GOTO 110 120 CONTINUE WRITE(INEW,700) (INAM(I),I=1,NAMSIZ),(ICOD(I),I=1,ICDSZ), 1 (ITAG(I),I=1,IRT) GOTO 10 C IT ISNT AN ENTRY... JUST COPY IT OVER... 200 WRITE(INEW,700)(INAM(I),I=1,NAMSIZ),(ICOD(I),I=1,ICDSZ) WRITE(ITO,720) (INAM(I),I=1,NAMSIZ),(ICOD(I),I=1,ICDSZ) GOTO 10 500 END FILE INEW WRITE(ITO,730) STOP C 700 FORMAT(114A1) 710 FORMAT(1X,34A1,/,2H$?) 720 FORMAT(1X,114A1) 730 FORMAT(13H END - UPDATE) END C SEARCH - A SUBROUTINE FOR UPDATE (& TAGFILE). SUBROUTINE SEARCH(IFOUND) C C THIS ROUTINE SEARCHES THE OLD TAGGED DIRECTORY FOR C A TAGGED ENTRY CORRESPONDING TO THE CURRENT LINE OF C IDIR (THE PIP DIRECTORY) AND RETURNS IFOUND=1 IF THE C TAG IS FOUND, IFOUND=-1 IF IT IS NOT. C C BY ROBERT WELLS AND ROBERT FEINSTEIN C MARINE BIOMEDICAL INSTITUTE C UNIVERSITY OF TEXAS MEDICAL BRANCH, C GALVESTON, TEXAS, 77550. WRITTEN 29-JULY-75. C COMMON /IODEV/ IOLD,IDIR,INEW,ITI,ITO COMMON IBL,IDOT,ICNT,JNAM(10),FILE(3) COMMON /ENTRY/ INAM(10),ICOD(24),ITAG(80) COMMON /SIZES/ NAMSIZ,ICDSZ,ITGSZ C DIMENSION ITRSH(24) IPLACE=ICNT GOTO 15 10 IF(ICNT.EQ.IPLACE) GOTO 100 15 READ(IOLD,700,END=50) (JNAM(I),I=1,NAMSIZ),(ITRSH(I),I=1,24), 1(ITAG(I),I=1,ITGSZ) ICNT=ICNT+1 DO 20 I=1,NAMSIZ IF(INAM(I).NE.JNAM(I)) GOTO 10 20 CONTINUE C ENTRY FOUND; IS TAG THERE? DO 30 I=1,ITGSZ IF(ITAG(I).NE.IBL)GOTO 40 30 CONTINUE GOTO 100 C TAG FOR ENTRY IS FOUND; RETURN... 40 IFOUND=1 RETURN C END OF IOLD REACHED; START OVER ... 50 REWIND IOLD ICNT=0 GOTO 10 C GIVE UP, NO TAGGED ENTRY FOR IT. 100 IFOUND=-1 700 FORMAT(114A1) RETURN END