Subj : NodeDiff creation
To   : Dan Egli
From : Jasen Betts
Date : Wed Aug 20 2003 09:01 pm

Hi Dan.

latest version of diff prog - still needs CRC code - but I guess you've got
code for that sort of thing already.


program infinidf;  { Version 0.5 by Jasen Betts 19/8/2003 }

{unlimited* line length diff prog V0.5 - proof of concept}
{Copyright by Jasen Betts august 2003 - Tagware
{free for any purpose but attribute me in any derived work}

{this program could possibly be improved by modifying it to exploit
 the structure of the nodelist rather that using the black-magic "variety"
 figure}

{performance (speed) could be improved by rewriting mygetc/seek/filepos
to use buffered reads rather than single character reads ...
further improvement could then come from inlineing mygetc in
comparelines and showline}

{*actual line length limit and file size limit is maxlongint characters}

{*the author may be contacted at 3:640/1042@Fidonet or
 Jasen_Betts@yahoo.com.au at this time the fidonet address will get a
 much swifter respoonse}

function Mygetc(var f:FILE):char;  {read a character from the file}
var
c,d:char;
pos:longint;
begin
  if eof(f) then begin Mygetc:=#10;exit;end;
  blockread(f,c,1);
  if c in [#10,#13] then {handle #10#13 13#10 #10 and #13 as EOL}
    begin
      pos:=filepos(f);
      if not eof(f) then begin
        blockread(f,d,1);
        if (d=c) or not (d in [#10,#13]) then seek(f,pos);
      end;
      c:=#10;
    end;

  Mygetc:=c;
end;

var
linetype:char;
variety: longint;


function comparelines(var f1,f2:file; failskip1,failskip2:boolean):boolean;
var
c,d:char;
pos1,pos2:longint;
begin
   if not failskip1 then pos1:=filepos(f1);
   if not failskip2 then pos2:=filepos(f2);
   c:=mygetc(f1);
   linetype:=c;
   variety:=0;

   repeat
    d:=mygetc(f2);
    if c<> d then
    begin
     if (not failskip1) then seek(f1,pos1) else if (c<>#10)
       then while mygetc(f1) <> #10 do;

     if (not failskip2) then seek(f2,pos2) else if (d<>#10)
       then while mygetc(f2) <> #10 do;

     comparelines:=false;
     exit;
    end;
    if d=#10 then break;
    c:=mygetc(f1);
    if c <> d then inc(variety);
   until false;

   comparelines:=true;
end;



procedure resync(var f1,f2            :FILe ;
                     certainty        :longint;
                 var linedif1,linedif2:longint);

 { attempts to resynchronise two file pointers,
  succeeds with both pointing to the next matching line
  fails with poth pointing to EOF - could be considered succes.
 }

 var

 po1,po2,pm1,pm2,pl1,pl2:longint;
 n,depth,y,goodness:longint;

begin
 po1:=filepos(f1);
 po2:=filepos(f2);
 linedif2:=1;

  for depth:=1 to maxint do
   begin


  pl1:=filepos(f1);
   seek(f2,po2 );

   for y:=1 to depth-1 do begin
    pl2:=filepos(f2);

    if comparelines(f1,f2,false,true) then begin         { we have a match! }
       goodness:=variety;
       pm1:=filepos(f1);              { store file pointers }
       pm2:=filepos(f2);
       while true  do begin { check next matches-1 lines also match }
         if goodness >= certainty then { success! }
         begin
           seek(f1,pl1 );
           seek(f2,pl2 );
           linedif2:=y-1;
           linedif1:=depth-1;
          exit ;
          end;
         if not comparelines(f1,f2,false,false) then break;
         goodness:=goodness+variety;
         end;
       seek(f1,pl1 );   { failure: restore pointers, keep looking }
       seek(f2,pm2 );
       end;  {if comparelines}

     end;    { for y...}

  pl2:=filepos(f2);
   seek(f1,po1 );

   for y:=1 to depth do begin
    linedif1:=y;
    pl1:=filepos(f1);

    if comparelines(f2,f1,false,true) then begin         { we have a match! }
       goodness:=variety;
       pm2:=filepos(f2);              { store file pointers }
       pm1:=filepos(f1);
       while true do begin { check next matches-2 lines also match }
         if goodness >= certainty then { success! }
         begin
           seek(f2,pl2 );
           seek(f1,pl1 );
           linedif1:=y-1;
           linedif2:=depth-1;
          exit ;
          end;
         if not comparelines(f2,f1,false,false) then break;
         goodness:=goodness+variety;
         end;
       seek(f2,pl2 );   { failure: restore pointers, keep looking }
       seek(f1,pm1 );
       end;  {if comparelines}

     end;    { for y...}



   end;
end;




procedure showline(var f :FILE);
var c:char;
begin
 repeat
  c:=mygetc(f);
 if c=#10 then writeln else write(c);
 until c=#10;
end;


procedure process( s1,s2:string;paranoia:longint);
var
f1,f2:file;
pos1,pos2,matchpos,matches,ld1,ld2:longint;
buf:pchar;

begin


assign(f1,s1);
reset(f1,1);
if(IOResult <> 0 ) then halt(1);
assign(f2,s2);
reset(f2,1);
 if(IOResult <> 0 ) then halt(1);

writeln('*** - comparing[',s1,'] and [',s2,']');


matches:=0;
while  not  (eof(f1) and eof(f2)) do begin
  pos1:=filepos(f1);
  pos2:=filepos(f2);
  if not comparelines(f1,f2,false,false) then
    begin

    resync(f1,f2,paranoia,ld1,ld2);

    if(matches<> 0) then writeln ('C ',matches);
    if(ld1 <> 0 ) then
       begin
         writeln('D ',ld1);
{$ifdef DEBUG_D}
         matchpos:=filepos(f1);
         seek(f1,pos1 );
         while(filepos(f1)<matchpos) do
         begin
         showline(f1)
{$endif}
       end;
if(ld2 <> 0 ) then
      begin
        writeln('A ',ld2);
        matchpos:=filepos(f2);
        seek(f2,pos2 );
        while(filepos(f2)<matchpos) do
        begin
        showline(f2)
        end;
      end;

    matches:=0;
    end
    else inc(matches);
  end;

close(f1);
close(f2);

    if matches <>0 then writeln ('C ',matches);
end;


begin
  process(paramstr(1),paramstr(2),20)
end.

  -=> Bye <=-

---
 * Origin: Money is the root of all wealth. (3:640/1042)

.