--- Merging r29489 into '.':

A    utils/mkinsadd.pp
--- Recording mergeinfo for merge of r29489 into '.':
 U   .
--- Merging r29490 into '.':
U    utils/fpmake.pp
--- Recording mergeinfo for merge of r29490 into '.':
 G   .
--- Merging r29499 into '.':
U    utils/mkinsadd.pp
--- Recording mergeinfo for merge of r29499 into '.':
 G   .

# revisions: 29489,29490,29499


git-svn-id: http://svn.freepascal.org/svn/fpc/branches/fixes_3_0@31092 3ad0048d-3df7-0310-abae-a5850022a9f2

2 files changed, 480 insertions, 0 deletions

diff --git a/utils/fpmake.pp b/utils/fpmake.pp
index 9c0be023c4..074b529bfa 100644
--- a/utils/fpmake.pp
+++ b/utils/fpmake.pp
@@ -78,6 +78,7 @@ begin
     P.Targets.AddProgram('data2inc.pp');
     P.Targets.AddProgram('delp.pp');
     P.Targets.AddProgram('bin2obj.pp');
+    P.Targets.AddProgram('mkinsadd.pp');
     P.Targets.AddProgram('postw32.pp');
     P.Targets.AddProgram('rmcvsdir.pp');
     P.Targets.AddProgram('grab_vcsa.pp',[linux]);
diff --git a/utils/mkinsadd.pp b/utils/mkinsadd.pp
new file mode 100644
index 0000000000..4bec50ce71
--- /dev/null
+++ b/utils/mkinsadd.pp
@@ -0,0 +1,479 @@
+{$MODE FPC}
+{
+    This file is part of Free Pascal build tools
+    Copyright (c) 2014-2015 by Tomas Hajny, member of the FPC core team.
+
+    This program takes processes one or more listing files created with
+    fpmake (e.g. using 'fpmake pkglist --target=<FPC_target> -zp units-'
+    for unit packages or without the '-zp <prefix>' for utils), compares
+    them to the text-mode installer configuration file install.dat and
+    creates file install.add which provides information about packages
+    missing in install.dat in a form allowing copy&paste of individual
+    lines into install.dat.
+
+    If the original description of a certain package as found in fpmake.pp
+    is too long for install.dat, the maximum length is marked
+    in the respective line in install.add using a pipe character ('|').
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+program mkinsadd;
+
+uses
+ dos, objects;
+
+
+const
+ MaxTarget = 5;
+ TargetListShort: array [1..MaxTarget] of string [3] = ('dos', 'emx', 'os2', 'w32', 'src');
+ TargetListLong: array [1..MaxTarget] of string = ('dos', 'emx', 'os2', '.i386-win32', '.source');
+ DefDiffFN = 'install.add';
+ PackageStr = 'package=';
+ UnitsStr = 'units-';
+ ZipExt = '.zip';
+
+
+type
+ PPackageRec = ^TPackageRec;
+ TPackageRec = object (TObject)
+  Name, ShortName, Desc: PString;
+  Target: byte;
+  constructor Init (ALine: string);
+  function GetKeyStr: string;
+  function GetLine: string;
+  function GetSrcLine: string;
+  destructor Done; virtual;
+ end;
+
+ PPackageCollection = ^TPackageCollection;
+ TPackageCollection = object (TSortedCollection)
+  constructor Load (FN: string);
+  function LoadFile (FN: string; DupSrc: PPackageCollection): boolean;
+  function WriteFile (FN: string): boolean;
+  function Compare (Key1, Key2: pointer): sw_integer; virtual;
+ end;
+
+ PDatFile = ^TDatFile;
+ TDatFile = object (TObject)
+  DatCollection, LstCollection: PPackageCollection;
+  constructor LoadDat (FN: string);
+  function ReadLstFile (FN: string): boolean;
+  function WriteNew (FN: string): boolean;
+  destructor Done; virtual;
+ end;
+
+
+function LoCase (S: string): string;
+var
+ I: longint;
+begin
+ for I := 1 to Length (S) do
+  if S [I] in ['A'..'Z'] then
+   S [I] := char (Ord (S [I]) + 32);
+ LoCase := S;
+end;
+
+
+constructor TPackageRec.Init (ALine: string);
+var
+ I: longint;
+ J: byte;
+ N, SN, D, TS: string;
+ ALine2: string;
+begin
+ inherited Init;
+ N := '';
+ SN := '';
+ D := '';
+ TS := '';
+ ALine2 := LoCase (ALine);
+ if Copy (ALine2, 1, Length (PackageStr)) = PackageStr then
+  begin
+   Delete (ALine, 1, Length (PackageStr));
+   I := Pos ('[', ALine);
+   if I = 0 then
+    begin
+     I := Pos (',', ALine);
+     if I = 0 then
+      I := Succ (Length (ALine));
+    end
+   else
+    begin
+     SN := Copy (ALine, Succ (I), Pos (',', ALine) - I - 2);
+     Delete (ALine, I, Length (SN) + 2);
+    end;
+   N := Copy (ALine, 1, Pred (I));
+   if Length (N) <= 12 then
+    SN := N
+   else if (Copy (N, 1, Length (UnitsStr)) = UnitsStr) and
+                                    (Length (N) - Length (UnitsStr) <= 11) then
+    SN := 'u' + Copy (N, Succ (Length (UnitsStr)),
+                                               Length (N) - Length (UnitsStr));
+   D := Copy (ALine, Succ (I), Length (ALine) - I);
+  end;
+
+ Name := NewStr (N);
+ if SN <> '' then
+  ShortName := NewStr (SN)
+ else
+  ShortName := nil;
+ Desc := NewStr (D);
+ Target := 0;
+
+ if SN <> '' then
+  begin
+   TS := LoCase (Copy (SN, Length (SN) - Length (ZipExt) - 2, 3));
+   if Length (TS) <> 3 then
+    TS := ''
+   else
+    for J := 1 to MaxTarget do
+     if TS = TargetListShort [J] then
+      begin
+       Target := J;
+       Break;
+      end;
+  end
+ else
+  begin
+   I := Length (N) - Length (ZipExt);
+   while (I > 0) and (N [I] <> '.') do
+    Dec (I);
+   if I = 0 then
+    TS := LoCase (Copy (N, Length (SN) - Length (ZipExt) - 2, 3))
+   else
+    TS := LoCase (Copy (N, I, Length (N) - Length (ZipExt) - I + 1));
+   for J := 1 to MaxTarget do
+    if TS = TargetListLong [J] then
+     begin
+      Target := J;
+      Break;
+     end;
+  end;
+ if N = '' then
+  begin
+   WriteLn ('Err: Init failed (', ALine, ')!');
+   Fail;
+  end;
+end;
+
+
+destructor TPackageRec.Done;
+begin
+ DisposeStr (Name);
+ if ShortName <> nil then
+  DisposeStr (ShortName);
+ DisposeStr (Desc);
+ inherited Done;
+end;
+
+
+function TPackageRec.GetKeyStr: string;
+var
+ G: string;
+begin
+ if ShortName <> nil then
+  begin
+   if Target = 0 then
+    G := LoCase (Copy (ShortName^, 1, Length (ShortName^) - Length (ZipExt)))
+   else
+    G := LoCase (Copy (ShortName^, 1, Length (ShortName^) - Length (ZipExt) - 3));
+  end
+ else
+  begin
+   if Name = nil then
+    begin
+     GetKeyStr := '';
+     WriteLn ('Err - GetKeyStr (nil)!');
+     Exit;
+    end;
+   if Target = 0 then
+    G := LoCase (Copy (Name^, 1, Length (Name^) - Length (ZipExt)))
+   else
+    begin
+     if Copy (LoCase (Name^), 1, Length (UnitsStr)) = UnitsStr then
+      G := 'u' + LoCase (Copy (Name^, Succ (Length (UnitsStr)),
+         Length (Name^) - Length (UnitsStr) - Length (TargetListLong [Target])
+                                                            - Length (ZipExt)))
+     else
+      G := LoCase (Copy (Name^, 1,
+         Length (Name^) - Length (TargetListLong [Target]) - Length (ZipExt)));
+    end;
+  end;
+
+ G := G + '.';
+ if Target <> 0 then
+  G := G + TargetListShort [Target];
+ GetKeyStr := G;
+end;
+
+
+function TPackageRec.GetLine: string;
+var
+ G: string;
+begin
+ G := PackageStr + Name^;
+ if ShortName <> nil then
+  G := G + '[' + ShortName^ + ']';
+ if Length (Desc^) <= 45 then
+  G := G + ',' + Desc^
+ else
+  G := G + ',' + Copy (Desc^, 1, 45) + '|' +
+                                         Copy (Desc^, 46, Length (Desc^) - 45);
+ GetLine := G;
+end;
+
+
+function TPackageRec.GetSrcLine: string;
+var
+ GS: string;
+begin
+ if Target = 0 then
+  GS := ''
+ else
+  begin
+   GS := PackageStr + Copy (Name^, 1,
+     Length (Name^) - Length (TargetListLong [Target]) - Length (ZipExt)) +
+                                           TargetListLong [MaxTarget] + ZipExt;
+   if ShortName <> nil then
+    GS := GS + '[' + Copy (ShortName^, 1, Length (ShortName^)
+                    - Length (TargetListShort [Target]) - Length (ZipExt)) +
+                                    TargetListShort [MaxTarget] + ZipExt + ']';
+   GS := GS + ',' + Desc^;
+  end;
+ GetSrcLine := GS;
+end;
+
+
+constructor TDatFile.LoadDat (FN: string);
+begin
+ Init;
+ New (DatCollection, Load (FN));
+ New (LstCollection, Init (100, 50)); (* false? *)
+end;
+
+
+function TDatFile.ReadLstFile (FN: string): boolean;
+begin
+ ReadLstFile := LstCollection^.LoadFile (FN, DatCollection);
+end;
+
+
+function TDatFile.WriteNew (FN: string): boolean;
+begin
+ WriteNew := LstCollection^.WriteFile (FN);
+end;
+
+
+destructor TDatFile.Done;
+begin
+ Dispose (DatCollection, Done);
+ Dispose (LstCollection, Done);
+ inherited Done;
+end;
+
+
+constructor TPackageCollection.Load (FN: string);
+begin
+ Init (100, 50);
+ if not (LoadFile (FN, nil)) then
+  Fail;
+end;
+
+
+function TPackageCollection.LoadFile (FN: string; DupSrc: PPackageCollection): boolean;
+var
+ F: text;
+ S: ansistring;
+ S2: string;
+ P, Q: PPackageRec;
+ I: SW_Integer;
+begin
+{$I-}
+ Assign (F, FN);
+ Reset (F);
+ while not (Eof (F)) {and (LastErr = 0)} do
+  begin
+   S := '';
+   ReadLn (F, S);
+   if (Length (S) > 255) then
+    begin
+     WriteLn ('Error: Line too long!');
+     WriteLn (S);
+     Halt (255); (* Change error handling *)
+    end;
+   if Copy (LoCase (S), 1, Length (PackageStr)) = PackageStr then
+    begin
+     New (P, Init (S));
+     if DupSrc = nil then
+      S2 := ''
+     else
+      S2 := P^.GetSrcLine;
+     if (DupSrc = nil) or not (DupSrc^.Search (P, I)) then
+      Insert (P)
+     else
+      Dispose (P, Done);
+     if S2 <> '' then
+      begin
+       New (Q, Init (S2));
+       if (Q <> nil) and not (Search (Q, I)) and
+                           ((DupSrc = nil) or not (DupSrc^.Search (Q, I))) then
+        Insert (Q)
+       else
+        Dispose (Q, Done);
+      end;
+    end;
+  end;
+ Close (F);
+ LoadFile := IOResult = 0;
+{
+ if P = nil then Fail else
+ begin
+  if P^.LastErr <> 0 then
+  begin
+   Dispose (P, Done);
+   Fail;
+  end else
+  begin
+   P^.ReadIni (@Self);
+   Dispose (P, Done);
+  end;
+ end;
+}
+end;
+
+
+function TPackageCollection.WriteFile (FN: string): boolean;
+var
+ F: text;
+ S: string;
+ P: PPackageRec;
+ I: SW_Integer;
+ J: byte;
+begin
+ Assign (F, FN);
+ Rewrite (F);
+ for J := 0 to MaxTarget do
+  for I := 0 to Count - 1 do
+   begin
+    P := At (I);
+    if (P <> nil) and (P^.Target = J) then
+     begin
+{ Write (P^.Name^, '|');
+   if P^.ShortName <> nil then
+    Write (P^.ShortName^, '|')
+   else
+    Write ('x|');
+   WriteLn (P^.Desc^, '|', P^.Target);
+ WriteLn (P^.GetKeyStr);
+}
+      S := P^.GetLine;
+(* Signalize too long description *)
+      WriteLn (F, S);
+     end;
+   end;
+ Close (F);
+ WriteFile := IOResult = 0;
+end;
+
+
+function TPackageCollection.Compare (Key1, Key2: pointer): SW_Integer;
+var
+ S1, S2: string;
+begin
+ S1 := LoCase (PPackageRec (Key1)^.GetKeyStr);
+ S2 := LoCase (PPackageRec (Key2)^.GetKeyStr);
+ if S1 < S2 then
+  Compare := -1
+ else if S1 > S2 then
+  Compare := 1
+ else
+  Compare := 0;
+end;
+
+
+function Base (const S: string): string;
+var
+ D: DirStr;
+ N: NameStr;
+ E: ExtStr;
+begin
+ FSplit (S, D, N, E);
+ Base := N;
+end;
+
+
+procedure Error (const S: string; B: byte);
+begin
+ WriteLn;
+ WriteLn ('Error: ', S, '!!');
+ Halt (B);
+end;
+
+
+procedure Syntax;
+begin
+ WriteLn;
+ WriteLn ('Syntax: ', Base (ParamStr (0)),
+                          ' <path_to_install.dat> <LstFile1> [<LstFile2>...]');
+ WriteLn;
+ WriteLn ('<LstFileN> files are expected to be in the format produced by fpmake');
+ WriteLn ('(e.g. using ''fpmake pkglist --target=<FPC_target> -zp units-''');
+ WriteLn ('for unit packages or without the ''-zp <prefix>'' parameter for utils).');
+ WriteLn;
+ WriteLn ('Program compares their content to the list of packages in the text-mode');
+ WriteLn ('installer configuration file install.dat and creates file install.add');
+ WriteLn ('with information about packages missing in install.dat in a form allowing');
+ WriteLn ('copy&paste of individual lines into install.dat.');
+ WriteLn;
+ WriteLn ('If the original description of a certain package as found in fpmake.pp is');
+ WriteLn ('too long for install.dat, the maximum length is marked in the respective line');
+ WriteLn ('in install.add using a pipe character (''|'') to give hint for manual editing.');
+ Halt;
+end;
+
+var
+ I, J: byte;
+ DAT: TDatFile;
+ PrevCount: SW_Integer;
+
+begin
+ J := ParamCount;
+ if J < 2 then
+  begin
+   WriteLn;
+   WriteLn ('Error: Too few parameters!!');
+   Syntax;
+  end;
+ DAT.LoadDat (ParamStr (1));
+ if DAT.DatCollection <> nil then
+  WriteLn (LineEnding +
+            'Source install.dat file (', ParamStr (1), ') loaded correctly: ',
+                                          DAT.DatCollection^.Count, ' records')
+ else
+  Error ('Failure while loading source install.dat file (' + ParamStr (1) +
+                                                                       ')', 1);
+ for I := 2 to J do
+  begin
+   PrevCount := DAT.LstCollection^.Count;
+   if DAT.ReadLstFile (ParamStr (I)) then
+    WriteLn ('Package listing #', Pred (I), ' (', ParamStr (I),
+      ') loaded correctly: ', DAT.LstCollection^.Count - PrevCount,
+                                                                ' new records')
+   else
+    Error ('Failure while loading package listing (' + ParamStr (I) + ')', I);
+  end;
+ WriteLn ('Total: ', DAT.LstCollection^.Count, ' new records');
+ if DAT.WriteNew (DefDiffFN) then
+  WriteLn ('Output file (' + DefDiffFN + ') created successfully.')
+ else
+  Error ('Failure while trying to write records to the output file (' +
+                                                    DefDiffFN + ')', Succ (J));
+ DAT.Done;
+end.