program MAINT c c MAINT.COM contains the following commands c display ^$[2J ^$[1;1H c display ^I^ICAFFIN'S DIRECTORY MAINTENANCE UTILITY c display c display Please be patient: I'm working hard. c dir/col:1/block/out:maint.zzz ^1 c ru ld:maint c c This may be invoked thus: c maint *.rno c or just c maint c c The third line will create a directory file of *.rno c The fourth line will read in maint.zzz, display each file and c ask for directions as to deletions. Certain special cases exist c for which sources will be sought and flagged. c c EXT'N bin rno fortran macro c .SAV y y y c .OBJ y y y c .TSX y c .DOC y c .BAK y y y c .LST y y c .MAP y y c .CAL y c c c RNC 10-Feb-88 c byte filstr(40) !Complete line from DIR operation byte fils(12) !Trimmed file name (no spaces) integer*2 dot !Position of dot in file name byte string(200) !Buffer for line from file byte ans !"Answer Y/N" logical*1 bin,rno,fort,mac,specl !Flags for searching byte atime(10) !For time display byte ext(4) !Convenience definitions real*4 rext equivalence (ext,rext) integer*2 nfile !Number of files in directory integer*2 ndone !Number of files dealt with integer*2 fil(4) !RAD50 file name for deletes data fil(1)/3RDK / integer*2 size,deletd,ndel character*40 last1 !2nd last line in directory character*40 last2 !last line call tthclr() type 1000 1000 format('+',T16,'Caffin''s Directory Maintenance Utility') type * type *,'Working ...' open(unit=1,name='MAINT.ZZZ',type='OLD',err=10) !Get directory file do 4,i=1,202 read(1,1010,end=6) !Read a line 1010 format() 4 continue type 1180 1180 format(/,x,'There are over 200 files in your selected category.', 1 /,x,'How about starting again and being a bit more discriminatory?') call exit 6 nfile=i-4 !Number of files in category if(nfile.le.1)then rewind 1 !If possibly zero files, read(1,1010) ! skip back to count line read(1,1010) ! and read(1,1020) nQ,(filstr(i),i=1,nQ) ! read it here if(filstr(2).eq.'0')then !Then check for 0 type 1190 1190 format(/,x,'There were no files in that category.',/) call exit endif endif rewind 1 !Go back to beginning of file read(1,1010) !Blow off header size=0 !Init variables ndone=0 deletd=0 ndel=0 ichan=igetc() !Get a channel number for deletes if(ichan.lt.0)stop 'MAINT-F-No channels available for operations.' call isleep(0,0,1,0) !Read commercial c Start of main loop c Read in next file from directory listing 10 read(1,1020,end=100,err=100) nQ,(filstr(i),i=1,nQ) !Get file name etc 1020 format(Q,200a1) if(filstr(1).eq.' ')goto 100 !Check for last line (also nQ=<33) ndone=ndone+1 call scopy(filstr(8),ext,3) !Get extension ext(4)=0 call ltpos(1,1) call ttdclr() c call time(atime) !Get time c type 1040,(filstr(i),i=1,33),(atime(i),i=1,8) c1040 format('+','File ',33a1,T60,8a1) type 1040,(filstr(i),i=1,33),ndone,nfile 1040 format('+','File ',33a1,T60,'File ',I3,' of ',I3) decode(5,1030,filstr(12)) size 1030 format(I5) c Check for special extensions specl=.false. bin=.false. rno=.false. fort=.false. mac=.false. if(scomp(ext,'SAV').eq.0)then bin=.true. fort=.true. mac=.true. specl=.true. elseif(scomp(ext,'OBJ').eq.0)then bin=.true. fort=.true. mac=.true. specl=.true. elseif(scomp(ext,'TSX').eq.0)then bin=.true. elseif(scomp(ext,'DOC').eq.0)then rno=.true. specl=.true. elseif(scomp(ext,'MAP').eq.0)then fort=.true. mac=.true. specl=.true. elseif(scomp(ext,'LST').eq.0)then fort=.true. mac=.true. specl=.true. elseif(scomp(ext,'BAK').eq.0)then rno=.true. fort=.true. mac=.true. specl=.true. elseif(scomp(ext,'CAL').eq.0)then bin=.true. specl=.true. endif c Create usable version of file name for searching call scopy(filstr,fils,6) !Get working version of name fils(7)=0 !Temp end of string at dot call trim(fils) !Remove trailing blanks call concat(fils,'.',fils) !Put dot at end call concat(fils,ext,fils) !Add extension to end c If file has a special extension see if a source version exists if(specl)then call ltpos(2,1) call find(fils,'RNO') !Search for source versions call find(fils,'FOR') ! and display results (only) call find(fils,'MAC') endif c Now display file contents if possible call ltpos(3,1) if(bin)then type 1050 1050 format('+','Binary files are not displayed.') else open(unit=2,name=fils,type='OLD') !Not a binary file do 20 j=1,16 read(2,1020,end=30,err=30)nQ,(string(i),i=1,nQ) if(string(1).eq."014)then !Convert FF to graphics character call ttxg type 1060 1060 format(x,'c') call ttxa else if(nQ.gt.80)nQ=80 !Limit no of characters type 1070,(string(i),i=1,nQ) !Type first 16 lines of file 1070 format(x,80a1) endif 20 continue 30 close(unit=2) !Close file if opened endif !to bin/notbin choice c Now see if file is to be deleted 50 call ltpos(22,2) type 1080 1080 format('+','Do you want to delete this file? (Y/N/E/): ',$) accept 1090,ans 1090 format(a) if(ans.eq.'e'.or.ans.eq.'E')then call tthclr call exit endif if(ans.eq.'y'.or.ans.eq.'Y')then n=irad50(6,filstr,fil(2)) !Put file name into RAD50 n=irad50(3,ext,fil(4)) ! and extension if(filstr(17).eq.'P')then !Check for protected status call ltpos(23,10) call ttxclr() type 1100 1100 format('+','MAINT-Q-File is protected: are you sure?',$) accept 1090,ans if(ans.eq.'y'.or.ans.eq.'Y')then n=ifprot(ichan,fil,0) !Optional unprotect if(n.ne.0)stop 'MAINT-F-unprotect failure?' else goto 60 !Can't delete if protected endif !to unprotect query endif n=idelet(ichan,fil) !Delete the file if required if(n.eq.0) then ndel=ndel+1 !Collect statistics deletd=deletd+size goto 60 elseif(n.eq.1)then type *,'MAINT-F-Delete failed: Channel is already in use?' elseif(n.eq.2)then type *,'MAINT-W-Delete failed: File was not found?' elseif(n.eq.3)then type *,'MAINT-W-Delete failed: Device is in use.' elseif(n.eq.4)then type *,'MAINT-W-Delete failed: File is still protected.' endif !to scan of delete error codes endif !to delete query 60 goto 10 c Finished all files: summarise statistics 100 continue call scopy(filstr,last1,nQ) read(1,1090) last2 call tthclr type 1000 type 1120 1120 format(//,x,'That''s all there was in the directory listing.') type 1130,last1(1:nQ) 1130 format(//,x,'There were',a,$) type 1140,last2 1140 format('+',' and',a) call index(last2,'F',1,n) !calculate integer length for decode n=n-2 decode(n,1150,last2) i !Original number of empty blocks 1150 format(I6) type 1160,ndel,deletd,deletd+i !Display stats 1160 format(/,x,'We deleted',I5,' files and ',I6,' blocks,', 1 ' giving',I6,' blocks free space.') type 1170 1170 format(/,x,'Do you want the disk squeezed before we finish? ',$) accept 1090,ans if(ans.eq.'y'.or.ans.eq.'Y')then call setcmd('SQUEEZE/NOQ DK:') endif call tthclr call exit end subroutine find(filin,ext) byte filin(10) !Incoming file name byte ext(4) !Incoming extension integer*2 dot !Position of dot in file name byte file(12) !Scratchpad c dot=index(filin,'.',1) !Note position of dot call index(filin,'.',1,dot) !Note position of dot call scopy(filin,file,dot) !Copy main filename + dot call scopy(ext,file(dot+1),3) !Overlay extension file(dot+4)=0 !Force end of string open(unit=3,name=file,type='OLD',err=100) !Can we open it? do 10 i=dot+4,10 file(i)=' ' 10 continue type 1000,(file(i),i=1,10) !If here, can open it, 1000 format('+',2x,10a1,' exists',$) ! so it exists. close(unit=3) 100 continue return end