ftp.barnyard.co.uk/2015.02.ftp.barnyard.co.uk.tar/ftp.barnyard.co.uk/cpm/walnut-creek-CDROM/CPM/CATLOG/CCAT26.LBR/CCAT26.PQS/CCAT26.PAS

Pascal/Delphi Source File | 2000-06-30 | 19KB | 600 lines

{                                    =========================================
    program: CCAT                    | CCAT is a program which compares two  |
    author:  Richard F. Mack         | MAST.LST output files from the MCAT   |
             3407A Courtleigh Dr.    | and XCAT programs.  The output of     |
             Baltimore, MD 21207     | CCAT is a double-ended listing of the |
             301-922-1176            | the files in each MAST.LST which are  |
    date:    24 DEC 85               | not common to both.  The output of    |
    version: 2.6                     | CCAT is displayed on the screen and   |
                                     | is written either to the printer or   |
                                     | or to a disk file.  This version of   |
                                     | CCAT is a complete rewrite of early   |
                                     | versions and adds nice formatting to  |
                                     | the output display.                   |
                                     =========================================

NOTES:  If user wishes to rename CCATxx.COM,  the source file
        must be recompiled - otherwise the overlay will not be found at
        run-time.  A run-time error (F0) will be indicated.

        Arrays below are dimensioned for 62K of available memory.  If
        memory overflow occurs, reduce the values of MaxCatSize and
        MaxNumberOfLines (just below) in a 10:1 ratio and recompile.

        CCAT must be run from the logged drive.  (The program
        expects the to find the overlay on the logged drive during
        execution.)

version 2.6 - correct identification of EMPTY filename

}


Program CompareCatalogs;

{$U-,C-}

Const
  NameLength       = 12;
  NameWithDrive    = 14;
  HeaderLength     = 65;

  MaxCatSize       = 3000;      { This or less in reference list - FileOne. }
  MaxNumberOfLines = 300;

  TempOut1         = 'Temp1.$$$';
  TempOut2         = 'Temp2.$$$';

Type
  FileName       = string[NameLength];
  FNameWithDrive = string[NameWithDrive];
  Header         = string[HeaderLength];
  Sentence       = string[60];

Var
  FirstCatSize,SecondCatSize,MismatchCount1,MismatchCount2: integer;
  OutFileOpen,FirstPass,Mismatch1,Mismatch2,Hardcopy: boolean;
  BakUpName,LineBuffer: FileName;
  ReferenceList,ExaminedList,OutFileName: FNameWithDrive;
  FileHeader1,FileHeader2: Header;
  FileOne,FileTwo,OutFile,TempOutFile1,TempOutFile2: text;

  procedure Help;
  type
    Paragraph = array[1..14] of Sentence;
  const
    Instruction: Paragraph =
    ('Usage:',
     '',
     'Place CCAT on the logged drive.',
     '',
     'Input MAST.LST files may be entered on the command line:',
     '',
     '            A>CCAT MAST.LST B:MAST.LST',
     '',
     'If not entered on the command line, user is prompted',
     'for data.',
     '',
     'Output may be directed either to the printer or to disk.',
     'Unless otherwise specified, differences between the',
     'MAST.LST input files are written to ODDFILE.LST.');
  var
    i: integer;
  begin
    writeln(^J);
    for i := 1 to 14 do writeln(^I,Instruction[i]);
    halt
  end;

  function Open(var fp:text; name: FNameWithDrive): boolean;
  begin
    Assign(fp,Name);
    {$I-} reset(fp); {$I+}
    If IOResult <> 0 then
      begin
        Open := False;
        close(fp);
      end
      else
        Open := True;
  end { Open };

  procedure Abort(s: Sentence; f: FNameWithDrive);
  begin
    writeln(^J,'ABORT - ',s,f);
    halt;
  end;

  procedure OpenInputFiles;
  var
    Answer: char;

    procedure CapStr(LowCaseStr: FNameWithDrive; var UpCaseStr: FNameWithDrive);
    var
      i: integer;
    begin
      UpCaseStr := '';
      for i := 1 to length(LowCaseStr) do
      begin
        UpCaseStr := UpCaseStr + UpCase(copy(LowCaseStr,i,1));
      end;
    end {CapStr};

    procedure WriteHeader;
    begin
      Writeln('CCAT Catalog Comparison Utility - Version 2.6   12/24/85',^J);
    end;


  begin {OpenInputFiles}
    OutFileName := '';
    If ParamCount = 0 then
    begin
      WriteHeader;
      Write('Enter first filename: ');
      readln(ReferenceList);
      Write(^J,'Enter second filename: ');
      readln(ExaminedList);
    end
    else
    begin
      WriteHeader;
      ReferenceList := ParamStr(1);
      ExaminedList  := ParamStr(2);
      if ParamCount <> 2 then
      begin
        if ParamStr(1) = '?' then Help
        else if UpCase(copy(ParamStr(1),1,1)) = 'H' then Help
        else
        begin
          writeln(^J,'Try again - ERROR in entering input filenames.');
          halt
        end;
      end;
    end;
    writeln(^J,'Do you want hard copy instead of disk file? (Y/N)');
    read(kbd,Answer);
    Hardcopy := (UpCase(Answer) = 'Y');
    if not Hardcopy then
    begin
      Write(^J,'Enter output filename or <RET> : ');
      readln(OutFileName);
    end;
    if OutFileName = '' then OutFileName := 'ODDFILE.LST';
    CapStr(ReferenceList,ReferenceList);
    CapStr(ExaminedList,ExaminedList);
    CapStr(OutFileName,OutFileName);
    if not Open(FileOne,ReferenceList) then
         Abort('File not found:  ',ReferenceList);
    if not Open(FileTwo,ExaminedList) then
         Abort('File not found:  ',ExaminedList);
    FirstPass := true;
  end {OpenInputFiles};

  procedure ExchangeInputFiles;
  begin
    if not Open(FileOne,ExaminedList) then
         Abort('File not found:  ',ExaminedList);
    if not Open(FileTwo,ReferenceList) then
         Abort('File not found:  ',ReferenceList);
    FirstPass := false;
  end {ExchangeInputFiles};

  function Exist(FileN: FNameWithDrive): boolean;
  var F: file;
  begin
    assign(F,FileN);
    {$I-} reset(F); {$I+}
    Exist := (IOResult = 0);
  end {Exist};

  procedure BakUp;
  begin
    if Exist(OutFileName) then
    begin
      BakUpName:=copy(OutFileName,1,length(OutfileName)-3)+'BAK';
      if Exist(BakUpName) then
      begin
        assign(OutFile,BakUpName);
        erase(OutFile)
      end;
      assign(OutFile,OutFileName);
      rename(OutFile,BakUpName)
    end;
  end {BakUp};

  procedure OpenOutputFile;
  Begin
    Assign(OutFile,OutFileName);
    {$I-} Rewrite(OutFile); {$I+}
    OutFileOpen := (IOResult = 0);
    if not OutFileOpen then Abort('Can''t open ',OutFileName);
  end {OpenOutputFile};

  procedure OpenTempFiles;
  var
    TempFileOpen: boolean;
  Begin
    Assign(TempOutFile1,TempOut1);
    {$I-} Rewrite(TempOutFile1); {$I+}
    TempFileOpen := (IOResult = 0);
    if not TempFileOpen then Abort('Can''t open temporary file:  ',TempOut1);
    Assign(TempOutFile2,TempOut2);
    {$I-} Rewrite(TempOutFile2); {$I+}
    TempFileOpen := (IOResult = 0);
    if not TempFileOpen then Abort('Can''t open temporary file:  ',TempOut2);
  end {OpenTempFile};

  procedure ReopenTempFile(var TempOutFile: text; TempOut: FileName);
  var
    TempFileOpen: boolean;
  begin
    Assign(TempOutFile,TempOut);
    {$I-} Reset(TempOutFile); {$I+}
    TempFileOpen := (IOResult = 0);
    if not TempFileOpen then Abort('Can''t open temporary file:  ',TempOut);
  end; {ReopenTempFile}

  overlay procedure ProcessFile;
  const
    BuffSize      = 100;   { bite of FileTwo taken at each disk access }
  type
    InputBuff      = array[1..BuffSize] of FileName;
    Catalog        = array[1..MaxCatSize] of FileName;
  var
    i,n,MismatchCounter,StartSearchPoint: integer;
    CompareBuffFull,Mismatch,Temp1Open,Temp2Open: boolean;
    OddOne,ProgramName: FileName;
    CompareBuff: InputBuff;
    RefFile: Catalog;

    procedure BinarySearch;
    var
      j,OffSet: integer;
      Match,NotOnList: boolean;

      procedure OutMismatchToDisk;
      var
        TempFile1Open,TempFile2Open: boolean;
      begin
        if FirstPass then
        begin
          FileHeader1 := 'The following files in ' + ExaminedList +
                         ' do not appear in ' + ReferenceList;
          writeln(TempOutFile1,OddOne);
        end
        else
        begin
          FileHeader2 := 'The following files in ' + ReferenceList +
                         ' do not appear in ' + ExaminedList;
          writeln(TempOutFile2,OddOne);
        end;
      end {OutMismatchToDisk};

    begin {BinarySearch}
      j := StartSearchPoint;
      OffSet := j;
      Match := false;
      NotOnList := false;
      repeat
        if ProgramName = RefFile[j] then
        begin
          Match := true;
        end
        else
        if ProgramName < RefFile[j] then
        begin
          OffSet := OffSet div 2;
          if OffSet = 0 then NotOnList := true
          else j := j - OffSet;
        end
        else
        if ProgramName > RefFile[j] then
        begin
          if j + OffSet div 2 > FirstCatSize then
          begin
            repeat
              OffSet := OffSet div 2;
            until j + OffSet div 2 <= FirstCatSize
          end;
        OffSet := OffSet div 2;
        if OffSet = 0 then NotOnList := true
        else j := j + OffSet;
        end;
      until Match or NotOnList;
      If not Match then
      begin
        if ProgramName <> '' then      {string empty?  Not enough data
                                        in grab to completely fill buffer.}
        begin
          Mismatch := true;
          OddOne := ProgramName;
          OutMismatchToDisk;
          MismatchCounter := succ(MismatchCounter);
          if FirstPass then
          begin
            writeln(OddOne,' doesn''t appear in ',ReferenceList)
          end
          else
          begin
            writeln(OddOne,' doesn''t appear in ',ExaminedList);
          end;
        end;
      end;
    end    { BinarySearch };

  begin  {Process File}
    MismatchCounter := 0;
    For i := 1 to MaxCatSize do RefFile[i] := '';  { initialize buffer }
    if FirstPass then
    begin
      OutFileOpen := false;
      Writeln(^J,'Reading ',ReferenceList,'  . . . ');
    end
    else Writeln(^J,'Reading ',ExaminedList,'  . . . ');
    i:=1;
    while not Eof(FileOne) do
    begin
      Readln(FileOne,LineBuffer);
      if copy(LineBuffer,9,1) = '.' then
      begin
        if copy(lineBuffer,10,3) <> 'FRE' then
        begin
          RefFile[i] := copy(LineBuffer,1,12);
          FirstCatSize := i;
          i := succ(i);
        end;
      end;
    end;
    if i = 1 then
    begin
      if FirstPass then writeln(^J,ReferenceList,' is an EMPTY file.')
                   else writeln(^J,ExaminedList,' is an EMPTY file.');
      close(TempOutFile1); erase(TempOutFile1);
      close(TempOutFile2); erase(TempOutFile2);
      halt
    end;
    close(FileOne);

    StartSearchPoint := 2;
    if StartSearchPoint < FirstCatSize then
    repeat
      StartSearchPoint := StartSearchPoint * 2
    until StartSearchPoint >= FirstCatSize;
    StartSearchPoint := StartSearchPoint div 2;

    Mismatch := false;
    if FirstPass then Writeln(^J,'Reading ',ExaminedList,'  . . . ',^J)
                 else Writeln(^J,'Reading ',ReferenceList,'  . . . ',^J);
    begin
      SecondCatSize := 0;
      repeat
        For i := 1 to BuffSize do CompareBuff[i] := '';  { initialize buffer }
        i := 1;
        CompareBuffFull := false;
        repeat
          readln(FileTwo,LineBuffer);
          if copy(LineBuffer,9,1) = '.' then
          begin
            if copy(lineBuffer,10,3) <> 'FRE' then
            begin
              CompareBuff[i] := copy(LineBuffer,1,12);
              if i >= BuffSize then CompareBuffFull := true;
              i:=succ(i);
              SecondCatSize := succ(SecondCatSize);
            end;
          end;
        until CompareBuffFull or Eof(FileTwo);

        { begin comparing the big reference array against chunks
                 of the other list taken from disk }

        n := 1;
        while n <= BuffSize do
        begin
          ProgramName := CompareBuff[n];
          BinarySearch;
          n := succ(n);
        end;
      until Eof(FileTwo);
    end;
    close(FileTwo);
    if not Mismatch then
    begin
      if FirstPass then
      begin
        Mismatch1 := false;
        writeln(^J,'Everything in the ',ExaminedList,
                         ' file also appears in the ',ReferenceList,' file.');
      end
      else
      begin
        Mismatch2 := false;
        writeln(^J,'Everything in the ',ReferenceList,
                         ' file also appears in the ',ExaminedList,' file.');
      end;
    end;
    if FirstPass then writeln(^J,'First comparison complete')
                 else writeln(^J,'Second comparison complete');
    if not Mismatch1 and not Mismatch2 and not FirstPass then
    begin
        writeln(^J,'Files in ' + ReferenceList + ' = ',SecondCatSize);
        writeln(^J,'Files in ' + ExaminedList + ' = ',FirstCatSize);
    end;
    if Mismatch then
    begin
      if FirstPass then
      begin
        Mismatch1 := true;
        MismatchCount1 := MismatchCounter
      end
      else
      begin
        Mismatch2 := true;
        MismatchCount2 := MismatchCounter;
      end;
      if not FirstPass then writeln(^J,'Formatting output . . .');
    end;
    if FirstPass then close(TempOutFile1) else close(TempOutFile2);
  end {Process File};

  overlay procedure FormatOutput;
  const
    NumberOfColumns = 5;
  type
    Page = array[1..MaxNumberOfLines] of array[1..NumberOfColumns] of FileName;
  var
    MinColumnLength: integer;
    LineBuffer: string[79];
    NoMatch1,NoMatch2: Page;

    procedure ClrArray(var FileDisplay: Page; MismatchCount: integer);
    var
      i,j: integer;
    begin
      MinColumnLength := MismatchCount div NumberOfColumns;
      for i := 1 to NumberOfColumns do
      begin
        for j := 1 to MinColumnLength + 1 do FileDisplay[j,i] := '';
      end;
      LineBuffer := '';
    end; {ClrArray}

    procedure PrettyItUp(var FileDisplay: Page;
                         var TFile: text;
                             MismatchCount: integer);
    var
      i,j,Residue,AddOn: integer;
    begin
      MinColumnLength := MismatchCount div NumberOfColumns;
      Residue := MismatchCount - NumberOfColumns * MinColumnLength;
      for i := 1 to NumberOfColumns do
      begin
        AddOn := 0;
        if Residue > 0 then
        begin
          AddOn := 1;
          Residue := Residue - 1;
        end;
        for j := 1 to MinColumnLength + AddOn do
        begin
          readln(TFile,LineBuffer);
          FileDisplay[j,i] := LineBuffer;
        end; {j loop}
      end; {i loop}
      close(TFile); erase(TFile);
    end; {PrettyItUp}

    procedure WriteItOut(var FileDisplay: Page; FileHeader: Header;
                             NumOfMismatches: integer);
    var
      i,j: integer;

      procedure Summary;
      var
        SummaryStringA,SummaryStringB,
        SummaryStringC,SummaryStringD: string[79];
      begin
        SummaryStringA := 'Files in ' + ReferenceList + ' = ';
        SummaryStringB := 'Files in ' + ExaminedList + ' = ';
        SummaryStringC := 'Files in ' + ExaminedList +
          ' which are not found in ' + ReferenceList + ' = ';
        SummaryStringD := 'Files in ' + ReferenceList +
          ' which are not found in ' + ExaminedList + ' = ';
        writeln(^J,SummaryStringA,SecondCatSize);
        writeln(SummaryStringB,FirstCatSize);
        if FileHeader = FileHeader1 then
                         writeln(SummaryStringC,NumOfMismatches,^J)
                                    else
                         writeln(SummaryStringD,NumOfMismatches);
        if not Hardcopy then
        begin
          writeln(OutFile,^J,SummaryStringA,SecondCatSize);
          writeln(OutFile,SummaryStringB,FirstCatSize);
          if FileHeader = FileHeader1 then
                         writeln(OutFile,SummaryStringC,NumOfMismatches,^J)
                                      else
                         writeln(OutFile,SummaryStringD,NumOfMismatches);
        end
        else
        begin
          writeln(lst,^J,SummaryStringA,SecondCatSize);
          writeln(lst,SummaryStringB,FirstCatSize);
          if FileHeader = FileHeader1 then
                         writeln(lst,SummaryStringC,NumOfMismatches,^J)
                                      else
                         writeln(lst,SummaryStringD,NumOfMismatches);
        end;
      end; {Summary}

    begin {WriteItOut}
      writeln(^J,FileHeader,^J);
      if not Hardcopy then writeln(OutFile,^J,FileHeader,^J)
                      else writeln(lst,^J,FileHeader,^J);
      for j := 1 to MinColumnLength +1 do
      begin
        write(FileDisplay[j,1]);
        if not Hardcopy then write(OutFile,FileDisplay[j,1])
                        else write(lst,FileDisplay[j,1]);
        for i := 2 to NumberOfColumns do
        begin
          write(FileDisplay[j,i]:16);
          if not Hardcopy then write(OutFile,FileDisplay[j,i]:16)
                          else write(OutFile,FileDisplay[j,i]:16);
        end;
        writeln;
        if not Hardcopy then writeln(OutFile)
                        else writeln(lst);
      end;
      Summary;
   end; {WriteItOut}

  begin {FormatOutput}
    if not Hardcopy then
    begin
      if Mismatch1 or Mismatch2 then
      begin
        BakUp;
        OpenOutputFile;
      end;
    end;
    if Mismatch1 then
    begin
      ReopenTempFile(TempOutFile1,TempOut1);
      ClrArray(NoMatch1,MismatchCount1);
      PrettyItUp(NoMatch1,TempOutFile1,MismatchCount1);
      WriteItOut(NoMatch1,FileHeader1,MismatchCount1);
    end;
    if Mismatch2 then
    begin
      ReopenTempFile(TempOutFile2,TempOut2);
      ClrArray(NoMatch2,MismatchCount2);
      PrettyItUp(NoMatch2,TempOutFile2,MismatchCount2);
      WriteItOut(NoMatch2,FileHeader2,MismatchCount2);
    end;
    if not Mismatch1 then
    begin
      close(TempOutFile1); erase(TempOutFile1);
    end;
    if not Mismatch2 then
    begin
      close(TempOutFile2); erase(TempOutFile2);
    end;
    if not Hardcopy then
    begin
      if Mismatch1 or Mismatch2 then writeln(^J,'Output File = ',OutFileName);
    end;
    if OutFileOpen then close(OutFile);
  end; {FormatOutput}

BEGIN {main program}
  ClrScr;
  OpenInputFiles;
  OpenTempFiles;
  ProcessFile;
  ExchangeInputFiles;
  ProcessFile;
  FormatOutput;
END.