1 // SPDX-License-Identifier: LGPL-3.0-linking-exception
2 unit ReleaserTypes;
3
4 {$mode objfpc}{$H+}
5
6 interface
7
8 uses
9 Classes, SysUtils, fgl;
10
11 type
12 TVersion = record
13 case boolean of
14 false: (Value: array[1..4] of integer);
15 true: (Major, Minor, Release, Build: integer);
16 end;
17
18 operator =(AVersion1,AVersion2: TVersion): boolean;
VersionToStrnull19 function VersionToStr(AVersion: TVersion; AAlwaysIncludeZero: boolean = false): string;
StrToVersionnull20 function StrToVersion(AStr: string): TVersion;
21
22 type
23 { TReleaserObject }
24
25 TReleaserObject = class
26 private
GetParamnull27 function GetParam(AIndex: integer): string;
GetParamCountnull28 function GetParamCount: integer;
29 protected
30 FLogicDir: string;
ReplaceVariablesnull31 function ReplaceVariables(AText: string; AVersion: TVersion): string; overload;
ReplaceVariablesnull32 function ReplaceVariables(AText: string): string; overload;
33 public
34 FParameters: TStringList;
35 constructor Create(AParameters: TStringList; ALogicDir: string); virtual;
36 procedure ExpectParamCount(ACount: integer);
37 destructor Destroy; override;
38 property ParamCount: integer read GetParamCount;
39 property Param[AIndex: integer]: string read GetParam;
IsUniquenull40 class function IsUnique: boolean; virtual;
41 procedure LinkWith({%H-}AOtherObject: TReleaserObject); virtual;
42 procedure GetVersions(AVersionList: TStringList); virtual; abstract;
43 procedure CheckVersion({%H-}AVersion: TVersion); virtual;
44 procedure UpdateVersion({%H-}AVersion: TVersion); virtual;
45 procedure Save; virtual; abstract;
46 end;
47
48 TReleaserObjectFactory = class of TReleaserObject;
49
50 TReleaserObjectList = specialize TFPGObjectList<TReleaserObject>;
51
AdaptPathDelimnull52 function AdaptPathDelim(APath: string): string;
53
54 implementation
55
56 operator=(AVersion1, AVersion2: TVersion): boolean;
57 begin
58 result := (AVersion1.Major = AVersion2.Major) and
59 (AVersion1.Minor = AVersion2.Minor) and
60 (AVersion1.Release = AVersion2.Release) and
61 (AVersion1.Build = AVersion2.Build);
62 end;
63
VersionToStrnull64 function VersionToStr(AVersion: TVersion; AAlwaysIncludeZero: boolean): string;
65 begin
66 result := IntToStr(AVersion.Major);
67 if AAlwaysIncludeZero or (AVersion.Minor<>0) or (AVersion.Release<>0) or (AVersion.Build<>0) then
68 begin
69 result += '.' + IntToStr(AVersion.Minor);
70 if AAlwaysIncludeZero or (AVersion.Release<>0) or (AVersion.Build<>0) then
71 begin
72 result += '.' + IntToStr(AVersion.Release);
73 if AAlwaysIncludeZero or (AVersion.Build<>0) then
74 begin
75 result += '.' + IntToStr(AVersion.Build);
76 end;
77 end;
78 end;
79 end;
80
StrToVersionnull81 function StrToVersion(AStr: string): TVersion;
82 var
83 lst: TStringList;
84 i: Integer;
85 begin
86 lst := TStringList.Create;
87 lst.Delimiter:= '.';
88 lst.DelimitedText := AStr;
89 if lst.Count > 4 then
90 begin
91 lst.Free;
92 raise exception.Create('Invalid version string');
93 end;
94 for i := 1 to 4 do result.Value[i] := 0;
95 for i := 1 to lst.Count do
96 result.Value[i] := StrToInt(lst[i-1]);
97 lst.Free;
98 end;
99
AdaptPathDelimnull100 function AdaptPathDelim(APath: string): string;
101 begin
102 if PathDelim <> '\' then
103 result := StringReplace(APath, '\', PathDelim, [rfReplaceAll]);
104 if PathDelim <> '/' then
105 result := StringReplace(APath, '/', PathDelim, [rfReplaceAll]);
106 end;
107
108 { TReleaserObject }
109
TReleaserObject.GetParamnull110 function TReleaserObject.GetParam(AIndex: integer): string;
111 begin
112 result := FParameters[AIndex];
113 end;
114
TReleaserObject.GetParamCountnull115 function TReleaserObject.GetParamCount: integer;
116 begin
117 result := FParameters.Count;
118 end;
119
TReleaserObject.ReplaceVariablesnull120 function TReleaserObject.ReplaceVariables(AText: string; AVersion: TVersion): string;
121 begin
122 result := AText;
123 result := StringReplace(result, '$(Version)', VersionToStr(AVersion), [rfIgnoreCase,rfReplaceAll]);
124 result := StringReplace(result, '$(LogicDir)', FLogicDir, [rfIgnoreCase,rfReplaceAll]);
125 end;
126
TReleaserObject.ReplaceVariablesnull127 function TReleaserObject.ReplaceVariables(AText: string): string;
128 begin
129 result := AText;
130 result := StringReplace(result, '$(Version)', '?', [rfIgnoreCase,rfReplaceAll]);
131 result := StringReplace(result, '$(LogicDir)', FLogicDir, [rfIgnoreCase,rfReplaceAll]);
132 end;
133
134 constructor TReleaserObject.Create(AParameters: TStringList; ALogicDir: string);
135 begin
136 FParameters := TStringList.Create;
137 FParameters.AddStrings(AParameters);
138 FLogicDir := ALogicDir;
139 end;
140
141 procedure TReleaserObject.ExpectParamCount(ACount: integer);
142 begin
143 if ACount <> ParamCount then
144 raise exception.Create('Invalid number of parameters. Found '+inttostr(ParamCount)+' but expected '+inttostr(ACount));
145 end;
146
147 destructor TReleaserObject.Destroy;
148 begin
149 FParameters.Free;
150 inherited Destroy;
151 end;
152
TReleaserObject.IsUniquenull153 class function TReleaserObject.IsUnique: boolean;
154 begin
155 result := false;
156 end;
157
158 procedure TReleaserObject.LinkWith(AOtherObject: TReleaserObject);
159 begin
160 //nothing
161 end;
162
163 procedure TReleaserObject.CheckVersion(AVersion: TVersion);
164 begin
165 //nothing
166 end;
167
168 procedure TReleaserObject.UpdateVersion(AVersion: TVersion);
169 begin
170 //nothing
171 end;
172
173 end.
174
175