program verifypasstwo (input, output, direcfile, devone, devtwo, list);

  {**************************************************************}
  {                                                              }
  { Copyright (c) 1982, 1984      Bob Schor                      }
  {                               Rockefeller University         }
  {                               1230 York Ave                  }
  {                               New York, NY   10021           }
  {                                                              }
  { All rights reserved.  May not be copied without this notice. }
  {                                                              }
  {**************************************************************}

  { second pass of program to compare two devices }

  { Version 4.5 -- subtle bug fixes (handle null dates) }

CONST
  version = 'VERIF2    Version 4.5';

CONST
  devicelength = 3;
  filelength = 14;
  namelength = 10;
  datelength = 9;
  headerlength = 30;
  headersize = 3;
  entriesperline = 5;
  blocklength = 256;
TYPE
  devicetype = PACKED ARRAY [1 .. devicelength] OF char;
  filenametype = PACKED ARRAY [1 .. filelength] OF char;
  nametype = PACKED ARRAY [1 .. namelength] OF char;
  datetype = PACKED ARRAY [1 .. datelength] OF char;
  block = ARRAY [1 .. blocklength] OF integer;
  headerlinetype = PACKED ARRAY [1 .. headerlength] OF char;
  headertype = ARRAY [1 .. headersize] OF headerlinetype;
  entrypointer = ^entrytype;
  entrytype = RECORD
		next : entrypointer;
		name : nametype;
		length : integer;
		protected : boolean;
		date : datetype
	      END;
  directorytype = RECORD
		    header : headertype;
		    headerlines : integer;
		    root : entrypointer
		  END;
VAR
  list : text;
  listdevice : devicetype;
  listfile : filenametype;
  directoryone, directorytwo : directorytype;
  direcfile : text;
  devone, devtwo : FILE OF block;

  FUNCTION uppercase (letter : char) : char;

   BEGIN   { uppercase }
     IF ('a' <= letter) AND (letter <= 'z')
      THEN uppercase := chr(ord(letter) - ord('a') + ord('A'))
      ELSE uppercase := letter
   END;

  PROCEDURE checkdevicename (VAR device : devicetype);

  VAR
    index : 1 .. devicelength;

   BEGIN   { checkdevicename}
     FOR index := 1 TO devicelength DO
      BEGIN
	device[index] := uppercase (device[index]);
	IF NOT (device[index] IN ['A' .. 'Z', '0' .. '9'])
	 THEN device[index] := ' '
      END;
     IF device = '   '
      THEN device := 'DK '
   END;

  PROCEDURE makefilename (device : devicetype; name : nametype;
			  VAR filename : filenametype);

  VAR
    index : integer;

   BEGIN   { makefilename }
     FOR index := 1 TO devicelength DO
     filename[index] := device[index];
     filename[succ(devicelength)] := ':';
     FOR index := 1 TO namelength DO
     filename[succ(devicelength) + index] := name[index]
   END;

  PROCEDURE parsedirectory (VAR directory : directorytype;
			    direcname : nametype);

  VAR
    thisentry : entrypointer;

    PROCEDURE makeheader;

     BEGIN   { makeheader }
       WITH directory DO
	BEGIN
	  headerlines := 0;
	  WHILE direcfile^ = ' ' DO
	   BEGIN
	     headerlines := succ(headerlines);
	     IF headerlines <= headersize
	      THEN readln (direcfile, header[headerlines])
	      ELSE readln (direcfile);
	   END;
	  WHILE NOT (direcfile^ IN ['A' .. 'Z', '0' .. '9']) DO
	  readln (direcfile)
	END
     END;

    PROCEDURE makenewentry;

     BEGIN   { makenewentry }
       new (thisentry^.next);
       thisentry := thisentry^.next;
       WITH thisentry^ DO
	BEGIN
	  next := NIL;
	  read (direcfile, name);
	  read (direcfile, length);
	  protected := uppercase(direcfile^) = 'P';
	  IF protected
	   THEN get (direcfile);
	  WHILE (direcfile^ = ' ') AND NOT eoln (direcfile) DO
	  get (direcfile);
	  readln (direcfile, date)
	END
     END;

   BEGIN   { parsedirectory }
     WITH directory DO
      BEGIN
	reset (direcfile, direcname);
	thisentry := root;
	makeheader;
	WHILE direcfile^ <> ' ' DO
	makenewentry;
	close (direcfile)
      END
   END;

  PROCEDURE listuniquefiles;

    FUNCTION unique (thisentry, thatentry : entrypointer) : boolean;

    VAR
      finished : boolean;

     BEGIN   { unique }
	REPEAT
	 thatentry := thatentry^.next;
	 finished := thatentry = NIL;
	 IF NOT finished
	  THEN finished := thatentry^.name = thisentry^.name
	UNTIL finished;
       unique := thatentry = NIL
     END;

    PROCEDURE listunique (firstdirec, seconddirec : directorytype);

    VAR
      line : 1 .. headersize;
      count : 1 .. entriesperline;
      previousentry, thisentry : entrypointer;

     BEGIN   { listunique }
       WITH firstdirec DO
	BEGIN
	  writeln (list, 'Unique files :');
	  FOR line := 1 TO headerlines DO
writeln (list, ' ':20, header[line]);
	  writeln (list);
	  count := 1;
	  previousentry := root;
	  thisentry := previousentry^.next;
	  WHILE thisentry <> NIL DO
	   BEGIN
	     IF unique (thisentry, seconddirec.root)
	      THEN
	       BEGIN
		 count := succ(count MOD entriesperline);
		 write (list, thisentry^.name:namelength+5);
		 IF count = 1
		  THEN writeln (list);
		 previousentry^.next := thisentry^.next;
		 dispose (thisentry);
		 thisentry := previousentry^.next
	       END
	      ELSE
	       BEGIN
		 thisentry := thisentry^.next;
		 previousentry := previousentry^.next
	       END
	   END;
	  writeln (list);
	  writeln (list)
	END
     END;

   BEGIN   { listuniquefiles }
     listunique (directoryone, directorytwo);
     listunique (directorytwo, directoryone)
   END;

  PROCEDURE comparecommonfiles;

  TYPE
    endoffiletype = (one, two);
  VAR
    different : boolean;
    entryone, entrytwo : entrypointer;
    blockcount : integer;
    eofdevice : SET OF endoffiletype;

    PROCEDURE seeifdifferent;

    VAR
      filename : filenametype;
      blockindex : 1 .. blocklength;

     BEGIN   { seeifdifferent }
       different := entryone^.length <> entrytwo^.length;
       eofdevice := [];
       IF NOT different
	THEN
	 BEGIN
	   makefilename ('ONE', entryone^.name, filename);
	   reset (devone, filename);
	   makefilename ('TWO', entrytwo^.name, filename);
	   reset (devtwo, filename);
	   blockcount := 0;
	   WHILE NOT (eof (devone) OR eof (devtwo) OR different) DO
	    BEGIN
	      blockcount := succ(blockcount);
	      FOR blockindex := 1 TO blocklength DO
	      IF devone^[blockindex] <> devtwo^[blockindex]
	       THEN different := true;
	      get (devone);
	      get (devtwo)
	    END;
	   IF (blockcount <> entryone^.length) AND NOT different
	    THEN
	     BEGIN
	       IF eof (devone)
		THEN eofdevice := eofdevice + [one];
	       IF eof (devtwo)
		THEN eofdevice := eofdevice + [two]
	     END;
	   close (devone);
	   close (devtwo)
	 END
     END;

   BEGIN   { comparecommonfiles }
     IF directoryone.root^.next = NIL
      THEN write (list, 'No ')
      ELSE write (list, 'The following ');
     write (list, 'files are common to both devices');
     IF directoryone.root^.next <> NIL
      THEN writeln (list, ' :');
     writeln (list);
     entryone := directoryone.root;
     entrytwo := directorytwo.root;
     WHILE entryone^.next <> NIL DO
      BEGIN
	entryone := entryone^.next;
	entrytwo := entrytwo^.next;
	WITH entryone^ DO
	 BEGIN
	   write (list, name:namelength+2, length:5);
	   IF protected
	    THEN write (list, 'P')
	    ELSE write (list, ' ');
	   write (list, date:datelength+2, ' ':4)
	 END;
	seeifdifferent;
	IF (entryone^.date <> entrytwo^.date)
	 OR (entryone^.protected <> entrytwo^.protected)
	 OR different OR (eofdevice <> [])
	 THEN WITH entrytwo^ DO
	  BEGIN
	    write (list, name:namelength+2, length:5);
	    IF protected
	     THEN write (list, 'P')
	     ELSE write (list, ' ');
	    write (list, date:datelength+2, ' ':4)
	  END;
	IF different
	 THEN write (list, 'Different!');
	IF eofdevice <> []
	 THEN
	  BEGIN
	    write (list, 'EOF, device ');
	    IF one IN eofdevice
	     THEN
	      BEGIN
		write (list, 'one');
		IF two IN eofdevice
		 THEN write (list, ' and two')
	      END
	     ELSE write (list, 'two')
	  END;
	writeln (list)
      END
   END;

 BEGIN   { verifypasstwo }
   writeln ('VERIFY -- comparison pass');
   writeln;
   write ('Enter name of listing device -- ');
   readln (listdevice);
   checkdevicename (listdevice);
   makefilename (listdevice, 'VERIFY.LST', listfile);
   rewrite (list, listfile);
   WITH directoryone DO
    BEGIN
      new (root);
      root^.next := NIL;
      parsedirectory (directoryone, 'ONE.DIR   ')
    END;
   WITH directorytwo DO
    BEGIN
      new (root);
      root^.next := NIL;
      parsedirectory (directorytwo, 'TWO.DIR   ')
    END;
   listuniquefiles;
   comparecommonfiles;
   close (list)
 END.