diff --git a/.gitattributes b/.gitattributes index e778b6c76c..1c25fa48ba 100644 --- a/.gitattributes +++ b/.gitattributes @@ -15314,6 +15314,7 @@ utils/javapp/src/fpc/tools/javapp/StackMapTableData.java svneol=native#text/plai utils/javapp/src/fpc/tools/javapp/Tables.java svneol=native#text/plain utils/javapp/src/fpc/tools/javapp/TrapData.java svneol=native#text/plain utils/javapp/src/fpc/tools/javapp/TypeSignature.java svneol=native#text/plain +utils/mkinsadd.pp svneol=native#text/plain utils/mksymbian/Makefile svneol=native#text/plain utils/mksymbian/Makefile.fpc svneol=native#text/plain utils/mksymbian/Makefile.fpc.fpcmake svneol=native#text/plain diff --git a/utils/mkinsadd.pp b/utils/mkinsadd.pp new file mode 100644 index 0000000000..89b064904e --- /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= -zp units-' + for unit packages or without the '-zp ' 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)), + ' [...]'); + WriteLn; + WriteLn (' files are expected to be in the format produced by fpmake'); + WriteLn ('(e.g. using ''fpmake pkglist --target= -zp units-'''); + WriteLn ('for unit packages or without the ''-zp '' 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.