migrator.bak.20120627

program migrator;
uses
  readtxt2,sysutils, contnrs, dpkgdb, classes;
const
  sourcesfile = '/home/repo/repo/raspbian/dists/wheezy/main/source/Sources';
  packagesfile = '/home/repo/repo/raspbian/dists/wheezy/main/binary-armhf/Packages';
  sourcesfilestaging = '/home/repo/repo/raspbian/dists/wheezy-staging/main/source/Sources';
  packagesfilestaging = '/home/repo/repo/raspbian/dists/wheezy-staging/main/binary-armhf/Packages';

  codename = 'wheezy';
  codenamestaging = 'wheezy-staging';
  
//return -1 if versiona is less than versionb
//reutrn 0 if versiona is equal to versionb
//reutrn 1 if versiona is greater than versionb
function compareversion(versiona,versionb: string) : longint;
var
  rversiona:versionrevision;
  rversionb:versionrevision;
  error : dpkg_error;
begin
  //writeln(versiona,' ',versionb);
  uniquestring(versiona);
  uniquestring(versionb);
  if parseversion(@rversiona,pchar(versiona),@error) <> 0 then begin
    writeln('error parsing version '+versiona);
    halt;
  end;
  //writeln('rversiona.version ',rversiona.version);
  //writeln('rversiona.revision ',rversiona.revision);
  if parseversion(@rversionb,pchar(versionb),@error) <> 0 then begin
    writeln('error parsing version '+versionb);
    halt;
  end;
  //writeln('rversionb.version ',rversionb.version);
  //writeln('rversionb.revision ',rversionb.revision);
  
  result := versioncompare(@rversiona,@rversionb);
end;

type
  tsourcepackage=class
    version : string;
    name : string;
    binaries : tfphashlist;
    constructor createcopy(sourcepackage:tsourcepackage);
  end;

  tbinarypackage=class
    version : string;
    source : tsourcepackage;
    sourceversion : string;

    //note: depends is sorted for easier comparisons
    depends : tfphashlist;
  end;

constructor tsourcepackage.createcopy(sourcepackage:tsourcepackage);
var
  i : integer;
  binarypackage : tbinarypackage;
  newbinarypackage : tbinarypackage;
  binarypackagename : string;
begin
  version := sourcepackage.version;
  name := sourcepackage.name;
  if assigned(sourcepackage.binaries) then begin
    binaries := tfphashlist.create;
    for i := 0 to sourcepackage.binaries.count-1 do begin
      binarypackage := sourcepackage.binaries[i];
      binarypackagename := sourcepackage.binaries.nameofindex(i);
      newbinarypackage := tbinarypackage.create;
      newbinarypackage.source := self;
      newbinarypackage.version := binarypackage.version;
      newbinarypackage.sourceversion := binarypackage.sourceversion;
      binaries.add(binarypackagename,newbinarypackage);
    end;
  end;
end;

type


  tdistribution=class
    t : treadtxt;
    line : string;
    currentpackage, currentversion, currentsourcepackage, currentsourceversion , currentdepends :string;
    sources : tfphashlist;
    //rdeps : tfpobjecthashtable;

    procedure reset;
    procedure processsource;
    //procedure processdependency(const sourcepackage:string; const dependency : string);
    procedure processpackage;
    constructor create(sourcesfile : string ;packagesfile :string);
    procedure getbinaries(binaries:tfphashlist);

    //WARNING: copy is shallow, the tfphashlist is copied but it's contents is not.
    constructor createcopy(distribution : tdistribution);
  end;

procedure tdistribution.reset;
begin
  currentpackage := '';
  currentversion := '';
  currentsourcepackage := '';
  currentsourceversion := '';
end;

procedure tdistribution.processsource;
var
  sourcepackage : tsourcepackage;
begin
  if currentversion = '' then begin
    writeln('package without version!');
    halt;
  end;
  sourcepackage := sources.find(currentpackage);
  if sourcepackage = nil then begin
    sourcepackage := tsourcepackage.create();
    sourcepackage.name := currentpackage;
    sourcepackage.version := currentversion;
    sources.add(currentpackage, sourcepackage);
  end else begin
    writeln('multiple instances of the same source package cannot be handled yet');
    halt;
  end;
end;

{procedure tdistribution.processdependency(const sourcepackage:string; const dependency : string);
var
  rdeplist : tfphashlist;
begin
  rdeplist := tfphashlist(rdeps[dependency]);
  if rdeplist = nil then begin
    rdeplist := tfphashlist.create;
    rdeps[dependency] := rdeplist;
  end;
  if rdeplist.findindexof(sourcepackage) < 0 then rdeplist.add(sourcepackage,0);
end;}

procedure tdistribution.processpackage;
var
  sourceversionfromsources : string;
  versioncomparison : integer;
  inbrackets : boolean;
  dependency : string;
  c : char;
  i : integer;
  rdeplist : tstringlist;
  sourcepackage : tsourcepackage;
  binarypackage : tbinarypackage;
  depends : tfphashlist;
begin
  if currentversion = '' then begin
    writeln('package without version!');
    halt;
  end;
  if currentsourcepackage = '' then currentsourcepackage := currentpackage;
  if currentsourceversion = '' then currentsourceversion := currentversion;

  depends := tfphashlist.create();
  dependency := '';
  inbrackets := false;
  for i := 1 to length(currentdepends) do begin
    c := currentdepends[i];
    if c = '(' then inbrackets := true;
    if c = '(' then inbrackets := false;
    if (not inbrackets) and (c in ['a'..'z','0'..'9','+','-','.']) then begin
      dependency := dependency + c;
    end else begin
      if dependency <> '' then depends.add(dependency,0);
      dependency := '';
    end;
  end;
  if dependency <> '' then depends.add(dependency,0);
  sourcepackage := tsourcepackage(sources.find(currentsourcepackage));
  if sourcepackage = nil then begin
    sourcepackage := tsourcepackage.create();
    sourcepackage.name := currentsourcepackage;
    sourcepackage.version := '__NOT_PRESENT_BUT_HAS_BINARIES__';
    sources.add(currentsourcepackage, sourcepackage);
  end;
  if sourcepackage.binaries = nil then begin
    sourcepackage.binaries := tfphashlist.create;
  end;
  binarypackage := tbinarypackage.create;
  binarypackage.version := currentversion;
  binarypackage.source := sourcepackage;
  binarypackage.sourceversion := currentsourceversion;
  binarypackage.depends := depends;
  sourcepackage.binaries.add(currentpackage,binarypackage);
end;

function stringstartis(const s,start : string) : boolean;
var
  i : integer;
begin
  if length(s) < length(start) then begin
    result := false;
    exit;
  end;
  for i := 1 to length(start) do begin
    if s[i] <> start[i] then begin
      result := false;
      exit
    end;
  end;
  result := true;
end;

constructor tdistribution.create(sourcesfile :string; packagesfile :string);
var
  sourcelinecontent : string;
  p : integer;
  pass : byte;
  i : integer;
begin
  //writeln(compareversion('1','2'));
  //writeln(compareversion('1-1','1-2'));
  //writeln(compareversion('2','1'));
  //writeln(compareversion('1','1'));
  //halt;
  sources := tfphashlist.create;
  t := treadtxt.createf(sourcesfile);
  reset;
  repeat
    line := t.readline;
    if copy(line,1,8) = 'Package:' then begin
      currentpackage := trim(copy(line,9,255));
    end;
    if copy(line,1,8) = 'Version:' then begin
      currentversion := trim(copy(line,9,255));
    end;
    if line = '' then begin
      //end of block
      if currentpackage <> '' then processsource;
      reset;
    end;
  until t.eof;
  if currentpackage <> '' then processsource;
  
  t.free;

  //rdeps := tfpobjecthashtable.create();
  t := treadtxt.createf(packagesfile);
  reset;
  repeat
    line := t.readline;
    if stringstartis(line,'Package:') then begin
      currentpackage := trim(copy(line,9,maxlongint));
    end;
    if stringstartis(line,'Version:') then begin
      currentversion := trim(copy(line,9,maxlongint));
    end;
    if stringstartis(line,'Source:') then begin
      sourcelinecontent := trim(copy(line,8,maxlongint));
      p := pos('(',sourcelinecontent);
      if p = 0 then begin
        currentsourcepackage := sourcelinecontent;
      end else begin
        currentsourcepackage := trim(copy(sourcelinecontent,1,p-1));
        currentsourceversion := copy(sourcelinecontent,p+1,255);
        p := pos(')',currentsourceversion);
        currentsourceversion := trim(copy(currentsourceversion,1,p-1));
      end;
    end;
    if stringstartis(line,'Depends:') then begin
      currentdepends := trim(copy(line,9,maxlongint));
    end;
    if line = '' then begin
      //end of block
      if currentpackage <> '' then processpackage;
      reset;
    end;
  until t.eof;
  if currentpackage <> '' then processpackage;
  t.free;
end;

procedure tdistribution.getbinaries(binaries : tfphashlist);
var
  i,j : integer;
  sourcepackage : tsourcepackage;
  binarypackagename : string;
  binarypackage : tbinarypackage;
begin
  binaries.clear;
  for i := 0 to sources.count-1 do begin
    sourcepackage := tsourcepackage(sources[i]);
    if sourcepackage.binaries <> nil then for j := 0 to sourcepackage.binaries.count -1 do begin
      binarypackage := tbinarypackage(sourcepackage.binaries[j]);
      binarypackagename := sourcepackage.binaries.nameofindex(j);
      binaries.add(binarypackagename,binarypackage);
    end;
  end;
 
end;

constructor tdistribution.createcopy(distribution: tdistribution);
var
  i : integer;
begin
  sources := tfphashlist.create;
  for i := 0 to distribution.sources.count -1 do begin
    sources.add(distribution.sources.nameofindex(i),distribution.sources[i]);
  end;
end;

var
  maindistribution: tdistribution;
  stagingdistribution: tdistribution;
  resultingdistribution: tdistribution;
  
  mainbinaries,stagingbinaries,resultingbinaries : tfphashlist;
  i,j,k: integer;
  sourcepackagename: string;
  mainsourcepackage: tsourcepackage;
  stagingsourcepackage: tsourcepackage;
  resultingsourcepackage: tsourcepackage;
  binarypackage: tbinarypackage;
  binarypackagename: string;
  inconsistentcount: integer;
  proposedsourcemigrations: tfphashlist;
  proposedbinarymigrations: tfphashlist;
  dummysourcepackage: tsourcepackage;
  stagingbinarypackage: tbinarypackage;
  mainbinarypackage: tbinarypackage;
  resultingbinarypackage: tbinarypackage;
  removalsthisiteration: integer;
  dependedonpackage: string;
  satisfiableinmain,satisfiableinstaging,satisfiableinresulting,presentinmain : boolean;
  migrationindex : integer;
  t : textfile;
  b : boolean;
begin
  writeln('reading packages and sources files for main distribution');
  maindistribution := tdistribution.create(sourcesfile,packagesfile);
  mainbinaries := tfphashlist.create;
  maindistribution.getbinaries(mainbinaries);
  writeln('reading packages and sources files for staging distribution');
  stagingdistribution := tdistribution.create(sourcesfilestaging,packagesfilestaging);
  stagingbinaries := tfphashlist.create;
  maindistribution.getbinaries(mainbinaries);

  resultingbinaries := tfphashlist.create;

  writeln('scanning for source migration canditates');
  
  dummysourcepackage := tsourcepackage.create;
  dummysourcepackage.version := '__NOT_PRESENT__';
  
  proposedsourcemigrations := tfphashlist.create;
  for i := 0 to stagingdistribution.sources.count-1 do begin
    sourcepackagename := stagingdistribution.sources.nameofindex(i);
    stagingsourcepackage := tsourcepackage(stagingdistribution.sources[i]);
    mainsourcepackage := tsourcepackage(maindistribution.sources.find(sourcepackagename));
    if mainsourcepackage = nil then begin
      mainsourcepackage := dummysourcepackage;
      
    end;
    if mainsourcepackage.version = stagingsourcepackage.version then continue;
    writeln(sourcepackagename,' ',mainsourcepackage.version,' ',stagingsourcepackage.version);
    //if stagingsourcepackage.binaries <> nil then writeln(stagingsourcepackage.binaries.count) else writeln('no binaries found');
    inconsistentcount := 0;
    if stagingsourcepackage.binaries <> nil then for j := 0 to stagingsourcepackage.binaries.count -1 do begin
      binarypackage := tbinarypackage(stagingsourcepackage.binaries[j]);
      binarypackagename := stagingsourcepackage.binaries.nameofindex(j);
      if binarypackage.sourceversion = stagingsourcepackage.version then begin
        writeln('  ',binarypackagename,' consistent');
      end else begin
        writeln('  ',binarypackagename,' inconsistent');
        inconsistentcount := inconsistentcount + 1;
      end;
    end;
    if inconsistentcount <> 0 then begin
      writeln('  rejecting migration of '+sourcepackagename+' due to inconsistent binaries');
      writeln;
      continue;
    end;
    writeln('  accepting '+sourcepackagename+' onto list of proposed source migrations');
    proposedsourcemigrations.add(sourcepackagename,stagingsourcepackage);
    writeln;
  end;
  
  writeln('scanning for binary migration canditates');
  proposedbinarymigrations := tfphashlist.create;
  for i := 0 to stagingdistribution.sources.count-1 do begin
    sourcepackagename := stagingdistribution.sources.nameofindex(i);
    stagingsourcepackage := tsourcepackage(stagingdistribution.sources[i]);
    mainsourcepackage := tsourcepackage(maindistribution.sources.find(sourcepackagename));
    if mainsourcepackage = nil then begin
      mainsourcepackage := dummysourcepackage;
    end;
    if mainsourcepackage.version <> stagingsourcepackage.version then continue;
    if stagingsourcepackage.binaries <> nil then for j := 0 to stagingsourcepackage.binaries.count -1 do begin
      stagingbinarypackage := tbinarypackage(stagingsourcepackage.binaries[j]);
      binarypackagename := stagingsourcepackage.binaries.nameofindex(j);
      if assigned(mainsourcepackage.binaries) then begin
        mainbinarypackage := tbinarypackage(mainsourcepackage.binaries.find(binarypackagename));
      end else begin
        mainbinarypackage := nil;
      end;
      if assigned(mainbinarypackage) then begin
        b := stagingbinarypackage.version <> mainbinarypackage.version
      end else begin
        b := true;
      end;
      if b then begin
        if stagingbinarypackage.sourceversion = stagingsourcepackage.version then begin
          proposedbinarymigrations.add(binarypackagename,stagingbinarypackage);
          writeln(binarypackagename,' accepted as candidate for binary migration');
        end else begin
          writeln(binarypackagename,' from source '+sourcepackagename+' rejected for binary migration due to inconsistent source version ',stagingbinarypackage.sourceversion,' expected ',stagingsourcepackage.version);
        end;
      end;
    end;
  end;

  writeln('stage 1 complete, there are ',proposedsourcemigrations.count,' proposed source migrations and ',proposedbinarymigrations.count,' proposed binary migrations');

  writeln('starting candidate test and removal loop');
  repeat
    writeln('copying distribution structure and applying changes');
    removalsthisiteration := 0;
    resultingdistribution := tdistribution.createcopy(maindistribution);
    resultingdistribution.getbinaries(resultingbinaries);
    for i := 0 to proposedsourcemigrations.count-1 do begin
      sourcepackagename := proposedsourcemigrations.nameofindex(i);
      stagingsourcepackage := proposedsourcemigrations[i];
      writeln('applying source migration '+sourcepackagename+' '+stagingsourcepackage.version);
      j := resultingdistribution.sources.findindexof(sourcepackagename);
      if j >= 0 then begin
        resultingdistribution.sources[j] := stagingsourcepackage;
      end else begin
        resultingdistribution.sources.add(sourcepackagename,stagingsourcepackage);
      end;
    end;
    writeln('finished applying source migrations, about to apply binary ones');
    for i := 0 to proposedbinarymigrations.count-1 do begin
      binarypackagename := proposedbinarymigrations.nameofindex(i);
      stagingbinarypackage := proposedbinarymigrations[i];
      writeln('applying binary migration '+binarypackagename+' '+stagingbinarypackage.version);
      sourcepackagename := stagingbinarypackage.source.name;
      //writeln('a');
      j := resultingdistribution.sources.findindexof(sourcepackagename);
      //writeln('b');
      resultingsourcepackage := tsourcepackage.createcopy(resultingdistribution.sources[j]);
      //writeln('c');
      resultingbinarypackage := tbinarypackage.create;
      resultingbinarypackage.source := resultingsourcepackage;
      resultingbinarypackage.version := stagingbinarypackage.version;
      resultingbinarypackage.sourceversion := stagingbinarypackage.sourceversion;
      if resultingsourcepackage.binaries = nil then resultingsourcepackage.binaries := tfphashlist.create;
      //writeln('d');
      k := resultingsourcepackage.binaries.findindexof(binarypackagename);
      if k >= 0 then begin
        resultingsourcepackage.binaries[k] := resultingbinarypackage;
      end else begin
        resultingsourcepackage.binaries.add(binarypackagename,resultingbinarypackage);
      end;
      //writeln('e');
      resultingdistribution.sources[j] := resultingsourcepackage;
      //writeln('f');
    end;
    
    writeln('scanning depedencies');
    for i := 0 to resultingbinaries.count -1 do begin
      binarypackagename := resultingbinaries.nameofindex(i);
      resultingbinarypackage := tbinarypackage(resultingbinaries[i]);
      mainbinarypackage := tbinarypackage(mainbinaries.find(binarypackagename));

      //we don't care if new binaries migrate before their dependencies are satisfiable.
      if mainbinarypackage = nil then continue;

      for j := 0 to resultingbinarypackage.depends.count -1 do begin
        //writeln(resultingbinarypackage.depends.nameofindex(j));
        dependedonpackage := resultingbinarypackage.depends.nameofindex(j);

        //find out whether the dependency is present in main
        presentinmain := mainbinarypackage.depends.findindexof(dependedonpackage) >= 0;

        //find out where the dependency is "satisfiable";
        satisfiableinmain := mainbinaries.findindexof(dependedonpackage) >= 0;
        satisfiableinstaging := stagingbinaries.findindexof(dependedonpackage) >= 0;
        satisfiableinresulting := resultingbinaries.findindexof(dependedonpackage) >= 0;

        if satisfiableinresulting then begin //is the dependency satisfiable in resulting, if so great
        end else if presentinmain and not satisfiableinmain then begin //if the dependency is present in main and not satisdiable there  we aren't making things worse
          //if the dependency is present in main and not satisdiable there  we aren't making things worse
        end else if not (satisfiableinmain or satisfiableinstaging or satisfiableinresulting) then begin //if the dependency is not satisdiable in any distribution it's probablly a virtual package, ignore it
          //if the dependency is not present in any distribution it's probablly a virtual package, ignore it
        end else if presentinmain and  satisfiableinmain then begin
          //the dependency was made unsatisfiable in resulting by an update to another package, remove that update from the candidate list
          mainsourcepackage := tbinarypackage(mainbinarypackage.depends.findindexof(dependedonpackage)).source;
          sourcepackagename := mainsourcepackage.name;
          migrationindex := proposedsourcemigrations.findindexof(sourcepackagename);
          if migrationindex >= 0 then begin //if this is -1 it most likely means the migration has already been removed from the list
            writeln('removing source package ',sourcepackagename,' from migration list because migrating it would break dependencies of ',binarypackagename);
            proposedsourcemigrations.delete(migrationindex);
            removalsthisiteration := removalsthisiteration + 1;
          end;
        end else begin
          //if we get this far it means we are going to break a dependency and it's most likely a real one remove the migration
          sourcepackagename := resultingbinarypackage.source.name;
          migrationindex := proposedsourcemigrations.findindexof(sourcepackagename);
          if migrationindex >= 0 then begin
            writeln('removing source package ',sourcepackagename,' from migration list because of dependency on ',dependedonpackage);
            proposedsourcemigrations.delete(migrationindex);
            removalsthisiteration := removalsthisiteration + 1;
          end;

          migrationindex := proposedbinarymigrations.findindexof(binarypackagename);
          if migrationindex >= 0 then begin
            writeln('removing binary package ',sourcepackagename,' from migration list because of dependency on ',dependedonpackage);
            proposedbinarymigrations.delete(migrationindex);
            removalsthisiteration := removalsthisiteration + 1;
          end;
        end;
      end;
    end;
    writeln('removed ',removalsthisiteration,' from the migration lists this iteration');
  until removalsthisiteration = 0;
  writeln('stage 2 complete, there are ',proposedsourcemigrations.count,' proposed source migrations and ',proposedbinarymigrations.count,' proposed binary migrations');
  assignfile(t,'migrations.sh');
  rewrite(t);
  for i := 0 to proposedsourcemigrations.count-1 do begin
    sourcepackagename := proposedsourcemigrations.nameofindex(i);
    stagingsourcepackage := proposedsourcemigrations[i];
    mainsourcepackage := maindistribution.sources.find(sourcepackagename);

    writeln('outputing source migration '+sourcepackagename+' '+stagingsourcepackage.version);
    writeln(t,'#source migration '+sourcepackagename+' '+stagingsourcepackage.version);
    //write removals
    if assigned(mainsourcepackage) then if assigned(mainsourcepackage.binaries) then for j := 0 to mainsourcepackage.binaries.count -1 do begin
      binarypackagename := mainsourcepackage.binaries.nameofindex(j);
      if stagingsourcepackage.binaries.findindexof(binarypackagename) < 0 then writeln(t,'reprepro -V --basedir . --morguedir +b/morgue --export=never --arch=armhf remove ',codename,' ',binarypackagename);
    end;
    //write source migration
    writeln(t,'reprepro -V --basedir . --morguedir +b/morgue --export=never --arch=source copy ',codename,' ',codenamestaging,' ',sourcepackagename);
    //write binary migration
    if assigned(stagingsourcepackage.binaries) then for j := 0 to stagingsourcepackage.binaries.count -1 do begin
      binarypackagename := stagingsourcepackage.binaries.nameofindex(j);
      writeln(t,'reprepro -V --basedir . --morguedir +b/morgue --export=never --arch=armhf copy ',codename,' ',codenamestaging,' ',binarypackagename);
    end;
    
    writeln(t);
  end;
  
  for i := 0 to proposedbinarymigrations.count-1 do begin
    binarypackagename := proposedbinarymigrations.nameofindex(i);
    stagingbinarypackage := proposedbinarymigrations[i];
    //mainsourcepackage := maindistribution.sources.find(sourcepackagename);

    writeln('outputing binary migration '+binarypackagename+' '+stagingbinarypackage.version);
    writeln(t,'#binary migration '+binarypackagename+' '+stagingbinarypackage.version);
    //write migration
    writeln(t,'reprepro -V --basedir . --morguedir +b/morgue --export=never --arch=armhf copy ',codename,' ',codenamestaging,' ',binarypackagename);
    
    writeln(t);
  end;
  
  //write export
  writeln(t,'reprepro -V --basedir . --morguedir +b/morgue export wheezy');
  closefile(t);
end.