cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c
c SIMDIF -- compare two SIMTEL20 index files and list differences.
c
c
c Author:
c
c Gregory D. Flint, Purdue University Computing Center, 1990.
c
c
c Warranty notice:
c
c Purdue University Computing Center (PUCC) warrants only
c that PUCC testing has been applied to this code. No other
c warranty, expressed or implied, is applicable.
c
c
c Description:
c
c The program reads two input files as follows:
c
c old - previous simtel20 index file,
c new - current simtel20 index file.
c
c It compares the two files and generates five report files as
c follows:
c
c add - a list of files whose entries were added to the new
c index,
c chg - a list of files whose entries were changed in the
c new index (version, size, date, desc, etc.),
c del - a list of files whose entries were deleted from the
c new index,
c ftp - the contents of the add & chg files formatted for
c use by the autoftp program (available from
c SIMTEL20), and
c lst - statistics about the run.
c
c
c Notes:
c
c Should the format of the index file change, the parameter
c statements that appear in each routine will need to be
c changed.
c
c Do not try to compare index files across a format change
c after changing the parameter statements as the old file
c will fail to parse properly.
c
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c-----------------------------------------------------------------------
c parameters:
c
c flds = number of fields (+1) in the index files.
c
c ldrv, ldir, ... = length of a field (+1 if data near max size)
c pdrv, pdir, ... = position of an output field
c
c linp = length of an input line (including quote marks)
c
c add, chg, ... = unit numbers for the seven input/output files
c-----------------------------------------------------------------------
c-----------------------------------------------------------------------
c /chars/ -- character variable common block
c
c ascii = symbol in the index indicating an ascii file
c inline = input line (from old or new file)
c outnew = parsed input line from new file
c outold = parsed output line from old file
c-----------------------------------------------------------------------
c-----------------------------------------------------------------------
c /intgrs/ -- integer variable common block
c
c added = number of entries added to the new file
c chged = number of entries changed in the new file
c deled = number of entries deleted from the new file
c haderr = if non-zero, indicates the file with a parse error
c nlines = number of entries read from the new file
c olines = number of entries read from the old file
c-----------------------------------------------------------------------
common / intgrs / added, chged, deled, haderr, nlines, olines
c-----------------------------------------------------------------------
c /fields/ -- field related data
c
c flen() = array containing the length of each field
c fpos() = array containing the starting position of each field
c fptr = integer pointer to field being processed
c fquo() = logical array indicating whether or not the field is
c bracketed by quote marks
c-----------------------------------------------------------------------
common / fields / flen(flds), fpos(flds), fptr, fquo(flds)
logical fquo
c-----------------------------------------------------------------------
c /eoflag/ -- end of file detected flags
c
c ndone = true if eof detected on old file
c odone = true if eof detected on new file
c-----------------------------------------------------------------------
common / eoflag / ndone, odone
logical ndone, odone
c
c open the files and prime the pumps.
c
open (old, file="simold")
open (new, file="simnew")
open (del, file="simdel")
open (add, file="simadd")
open (chg, file="simchg")
open (lst, file="simlst")
open (ftp, file="simftp")
c
read (old, 10, end=50) inline
10 format (a)
olines = olines + 1
call split (old)
if (haderr .ne. 0) go to 90
read (new, 10, end=70) inline
nlines = nlines + 1
call split (new)
if (haderr .ne. 0) go to 110
c
c main loop
c
20 if (outold(pdrv:pver-1) .lt. outnew(pdrv:pver-1)) then
call dels
else if (outold(pdrv:pver-1) .gt. outnew(pdrv:pver-1)) then
call adds
else
call chgs
endif
if (haderr .eq. old) go to 90
if (haderr .eq. new) go to 110
if (.not.(odone.and.ndone)) go to 20
c
write (lst, 30) olines, nlines
30 format (1x,i6," lines read from old file."/
* 1x,i6," lines read from new file.")
write (lst, 40) added, chged, deled
40 format (/1x,i6," files added."/
* 1x,i6," files changed."/
* 1x,i6," files deleted.")
c
stop "simdif -- normal termination"
c
c error processing
c
c
50 write (lst, 60)
60 format (1x,"Empty ""old"" file."/)
go to 130
c
70 write (lst, 80)
80 format (1x,"Empty ""new"" file."/)
go to 130
c
90 write (lst, 100) fptr
100 format (1x,"Parse of ""old"" file failed at field",i2/)
go to 130
c
110 write (lst, 120) fptr
120 format (1x,"Parse of ""new"" file failed at field",i2/)
c go to 130
c
130 write (lst, 30) olines, nlines
stop "simdif -- errors detected."
c
end
subroutine adds
implicit integer (a-z)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c adds -- process entries added to the new index file
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c-----------------------------------------------------------------------
c
c 1) list the addition.
c 2) add it to the autoftp file.
c 3) increment the count.
c 4) get and split another line from the new file.
c 5) if end of file, set parsed new line to all [upper case] Z's.
c
c-----------------------------------------------------------------------
write (add, 10) (outnew(fpos(i):fpos(i)+flen(i)-1),i=1,flds-1)
10 format (1x,3("""",a,""","),4(a,","),"""",a,"""")
c
write (ftp, 20) outnew(pdrv:pdrv+ldrv-1), outnew(pdir:pdir+ldir-1)
20 format ("-d ",2a)
if (outnew(ptyp:ptyp) .eq. ascii) then
write (ftp, 30) outnew(pnam:pnam+lnam-1)
30 format ("-a ",a)
else
write (ftp, 40) outnew(pnam:pnam+lnam-1)
40 format ("-8 ",a)
endif
c
added = added + 1
c
read (new, 50, end=60) inline
50 format (a)
nlines = nlines + 1
call split (new)
return
c
60 ndone = .true.
do 70 i = 1, pend
outnew(i:i) = "Z"
70 continue
return
c
end
subroutine blckda
implicit integer (a-z)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c blckda -- preset labeled common block data
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c-----------------------------------------------------------------------
c note that not all fields in each block are preset
c-----------------------------------------------------------------------
data ascii / "7" /
c
data flen / ldrv, ldir, lnam, lver, lsiz, ltyp, ldat, ldes, lend /
data fpos / pdrv, pdir, pnam, pver, psiz, ptyp, pdat, pdes, pend /
data fquo / 3*.true., 4*.false., .true., .false. /
c
data added, chged, deled, haderr, nlines, olines / 6*0 /
c
data ndone, odone / .false., .false. /
c
end
subroutine chgs
implicit integer (a-z)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c chgs -- process entries that changed from the old to the new file
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c-----------------------------------------------------------------------
c
c 1) if there is no change, skip to 5) below
c 2) list the change.
c 3) add it to the autoftp file.
c 4) increment the count.
c 5) get and split another line from both files.
c 6) if end of file, set parsed new/old line to all Z's.
c
c-----------------------------------------------------------------------
if (outold .eq. outnew) go to 50
c
write (chg, 10) olines, nlines,
* (outold(fpos(i):fpos(i)+flen(i)-1),i=1,flds-1),
* (outnew(fpos(i):fpos(i)+flen(i)-1),i=1,flds-1)
10 format (1x,"old: ",i6," new: ",i6/
* 1x,"< ",3("""",a,""","),4(a,","),"""",a,""""/
* 1x,"> ",3("""",a,""","),4(a,","),"""",a,""""/
* 1x,25("-"))
c
c
write (ftp, 20) outnew(pdrv:pdrv+ldrv-1), outnew(pdir:pdir+ldir-1)
20 format ("-d ",2a)
if (outnew(ptyp:ptyp) .eq. ascii) then
write (ftp, 30) outnew(pnam:pnam+lnam-1)
30 format ("-a ",a)
else
write (ftp, 40) outnew(pnam:pnam+lnam-1)
40 format ("-8 ",a)
endif
chged = chged + 1
c
50 read (new, 60, end=70) inline
60 format (a)
nlines = nlines + 1
call split (new)
if (haderr .ne. 0) return
go to 90
c
70 ndone = .true.
do 80 i = 1, pend
outnew(i:i) = "Z"
80 continue
c
90 read (old, 60, end=100) inline
olines = olines + 1
call split (old)
return
c
100 odone = .true.
do 110 i = 1, pend
outold(i:i) = "Z"
110 continue
return
c
end
subroutine dels
implicit integer (a-z)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c dels -- process entries deleted from the new index file
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c-----------------------------------------------------------------------
c
c 1) list the deletion.
c 2)
increment the count.
c 3) get and split another line from the old file.
c 4) if end of file, set parsed old line to all [upper case] Z's.
c
c-----------------------------------------------------------------------
write (del, 10) (outold(fpos(i):fpos(i)+flen(i)-1),i=1,flds-1)
10 format (1x,3("""",a,""","),4(a,","),"""",a,"""")
c
deled = deled + 1
c
read (old, 20, end=30) inline
20 format (a)
olines = olines + 1
call split (old)
return
c
30 odone = .true.
do 40 i = 1, pend
outold(i:i) = "Z"
40 continue
return
c
end
subroutine split (newold)
implicit integer (a-z)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c split -- parse the input line and set the new/old output line
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c-----------------------------------------------------------------------
c
c 1) preset the input pointer and result string
c 2) loop for each field
c a) build a temporary string from it
c b) right justify the field if it is not quote-mark-bracketed
c c) move the temporary string into the result string
c 3) move the result string into the appropriate output string
c
c-----------------------------------------------------------------------
inptr = 1
splits = " "
c
do 20 fptr = 1, flds-1
if (fquo(fptr)) inptr = inptr + 1
temptr = 1
10 if ((fquo(fptr).and.inline(inptr:inptr).ne."""") .or.
* (.not.fquo(fptr).and.inline(inptr:inptr).ne.",")) then
if (temptr .gt. flen(fptr)) then
haderr = newold
return
endif
temp(temptr:temptr) = inline(inptr:inptr)
temptr = temptr + 1
inptr = inptr + 1
go to 10
endif
if (fquo(fptr)) then
inptr = inptr + 2
splits(fpos(fptr):fpos(fptr)+temptr-1-1) = temp(1:temptr-1)
else
inptr = inptr + 1
splits(fpos(fptr+1)-temptr+1:fpos(fptr+1)-1) =
* temp(1:temptr-1)
endif
20 continue
c
if (newold .eq. old) then
outold = splits
else
outnew = splits
endif
return
c
end
