ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/iblocaldb/nongui/IBXUpgradeConfFile.pas
Revision: 315
Committed: Thu Feb 25 11:56:36 2021 UTC (17 months, 2 weeks ago) by tony
File size: 8429 byte(s)
Log Message:
Updated for IBX 4 release
Line File contents
1 (*
2 * IBX For Lazarus (Firebird Express)
3 *
4 * The contents of this file are subject to the Initial Developer's
5 * Public License Version 1.0 (the "License"); you may not use this
6 * file except in compliance with the License. You may obtain a copy
7 * of the License here:
8 *
9 * http://www.firebirdsql.org/index.php?op=doc&id=idpl
10 *
11 * Software distributed under the License is distributed on an "AS
12 * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
13 * implied. See the License for the specific language governing rights
14 * and limitations under the License.
15 *
16 * The Initial Developer of the Original Code is Tony Whyman.
17 *
18 * The Original Code is (C) 2014 Tony Whyman, MWA Software
19 * (http://www.mwasoftware.co.uk).
20 *
21 * All Rights Reserved.
22 *
23 * Contributor(s): ____________________________UpgradeConfFile__________.
24 *
25 *)
26 unit IBXUpgradeConfFile;
27
28 {$mode objfpc}{$H+}
29
30 {
31 TUpgradeConfFile encapsulated a text file in “ini” file format with
32 the following sections:
33
34 [status]
35
36 This should have a single named value “current” giving the current database
37 schema number as in integer e.g.
38
39 current = 2
40
41 This should normally be set to the same value as the RequiredVersionNo property
42 and acts as a check to ensure that both are in sync.
43
44 [Version.nnn]
45
46 Where nnn is an integer with leaving zeroes. For example, “Version.002” is
47 the section read to upgrade the database schema from version 1 to version 2.
48 This section can contain the following named values:
49
50 Name Type Use
51
52 Upgrade String Name and optional path to SQL script used to perform
53 the upgrade. May either be absolute path or relative
54 to the upgrade configuration file. Either forwards or
55 back slashes may be used as the path delimiter.
56
57 Msg string Text message displayed in progress dialog while script is
58 active. Defaults to “Upgrading Database Schema to Version nnn”.
59
60 BackupDatabase yes/no If present and set to “yes” then a database backup in
61 gbak format is made before the upgrade is performed. The backup file is
62 located in the same directory as the database file and is given the same
63 name as the database file with the extension replaced with “.nnn.gbak”.
64 Where “nnn” is the current schema version number (i.e. prior to running
65 the upgrade script).
66
67 <Parameter Name> string Name and optional path to binary data file. May either be
68 absolute path or relative to the upgrade configuration file.
69 Either forwards or back slashes may be used as the path delimiter.
70
71
72 For example:
73
74 [Version.002]
75 Msg = Upgrading to Version 2
76 BackupDatabase = yes
77 Upgrade = patches/02-patch.sql
78 mugshot = images/man.png.gz
79
80 Note that in the above, “mugshot” is intended to be used to resolve an Update,
81 Insert or Delete query parameter in the 02-patch.sql file. E.g.
82
83 Update EMPLOYEE Set Photo =:MUGSHOT Where Emp_no = 2;
84
85 This is only applicable to BLOB columns and the above is interpreted as update
86 the EMPLOYEE table where the Emp_no is “2” and set the value of the Photo column
87 to the binary data contained in the file “images/man.png.gz”.
88 }
89
90 interface
91
92 uses
93 Classes, SysUtils, IniFiles, IB, DB;
94
95 type
96 TUpgradeInfo = record
97 UpdateSQLFile,
98 UserMessage: string;
99 BackupDB: boolean;
100 end;
101
102 { TUpgradeConfFile }
103
104 TUpgradeConfFile = class
105 private
106 FConfFileName: string;
107 FCurrentVersion: string;
108 FUpgradeInfo: TIniFile;
109 function GetUpgradeAvailableToVersion: integer;
110 public
111 constructor Create(aFileName: string);
112 destructor Destroy; override;
113 class function IsAbsolutePath(aPath: string): boolean;
114 function CheckUpgradeAvailable(RequiredVersionNo: integer): boolean;
115 function GetUpgradeInfo(VersionNo: integer; var UpgradeInfo: TUpgradeInfo): boolean;
116 function GetSourceFile(aName: string; var FileName: string): boolean;
117 procedure GetParamValue(Sender: TObject; ParamName: string; var BlobID: TISC_QUAD);
118 property UpgradeAvailableToVersion: integer read GetUpgradeAvailableToVersion;
119 end;
120
121 EUpgradeConfFileError = class(Exception);
122
123
124 implementation
125
126 uses ZStream, IBBlob, ibxscript, IBMessages;
127
128 const
129 sSectionheader = 'Version.%.3d';
130
131 resourcestring
132 sInvalidConfFile = 'Database Upgrade Required, but the Upgrade File (%s) is missing or not specified';
133 sUpgradeRequired = 'Database Upgrade Required, but the Upgrade File is out of Date. '+
134 'Required Version = %d, Upgrade available for version %d';
135 sNoInfo = 'Upgrading Database Schema to Version %d';
136
137 { TUpgradeConfFile }
138
139 function TUpgradeConfFile.GetUpgradeAvailableToVersion: integer;
140 begin
141 Result := StrToInt(FUpgradeInfo.ReadString('Status','Current','0'))
142 end;
143
144 constructor TUpgradeConfFile.Create(aFileName: string);
145 begin
146 inherited Create;
147 FConfFileName := aFileName;
148 if (FConfFileName = '') or not FileExists(FConfFileName) then
149 raise EUpgradeConfFileError.CreateFmt(sInvalidConfFile,[FConfFileName]);
150 FUpgradeInfo := TIniFile.Create(FConfFileName);
151 end;
152
153 destructor TUpgradeConfFile.Destroy;
154 begin
155 if assigned(FUpgradeInfo) then FUpgradeInfo.Free;
156 inherited Destroy;
157 end;
158
159 class function TUpgradeConfFile.IsAbsolutePath(aPath: string): boolean;
160 begin
161 Result := false;
162 {$IFDEF WINDOWS}
163 Result := (ExtractFileDrive(aPath) <> '') or
164 ((Length(aPath) > 0) and (aPath[1] = DirectorySeparator));
165 {$ENDIF}
166 {$IFDEF UNIX}
167 Result := (Length(aPath) > 0) and (aPath[1] = DirectorySeparator);
168 {$ENDIF}
169 end;
170
171 function TUpgradeConfFile.CheckUpgradeAvailable(RequiredVersionNo: integer
172 ): boolean;
173 var CurVersion: integer;
174 begin
175 CurVersion := GetUpgradeAvailableToVersion;
176 if CurVersion < RequiredVersionNo then
177 raise EUpgradeConfFileError.CreateFmt(sUpgradeRequired, [RequiredVersionNo,CurVersion]);
178 end;
179
180 function TUpgradeConfFile.GetUpgradeInfo(VersionNo: integer;
181 var UpgradeInfo: TUpgradeInfo): boolean;
182 begin
183 Result := false;
184 FCurrentVersion := Format(sSectionheader,[VersionNo]);
185 UpgradeInfo.UserMessage := FUpgradeInfo.ReadString(FCurrentVersion,'Msg',
186 Format(sNoInfo,[VersionNo]));
187 UpgradeInfo.UpdateSQLFile := FUpgradeInfo.ReadString(FCurrentVersion,'Upgrade','');
188 Result := UpgradeInfo.UpdateSQLFile <> '';
189 if Result then
190 begin
191 DoDirSeparators(UpgradeInfo.UpdateSQLFile); {Resolve Platform dependencies}
192 if not IsAbsolutePath(UpgradeInfo.UpdateSQLFile) then
193 UpgradeInfo.UpdateSQLFile := ExtractFilePath(FConfFileName) + UpgradeInfo.UpdateSQLFile;
194 UpgradeInfo.BackupDB := CompareText(FUpgradeInfo.ReadString(FCurrentVersion,'BackupDatabase','no'),'yes') = 0;
195 Result := FileExists(UpgradeInfo.UpdateSQLFile);
196 end;
197 end;
198
199 function TUpgradeConfFile.GetSourceFile(aName: string; var FileName: string
200 ): boolean;
201 begin
202 FileName := FUpgradeInfo.ReadString(FCurrentVersion,aName,'');
203 DoDirSeparators(FileName);
204 if not IsAbsolutePath(FileName) then
205 FileName := ExtractFilePath(FConfFileName) + FileName;
206 Result := FileExists(FileName);
207 end;
208
209 procedure TUpgradeConfFile.GetParamValue(Sender: TObject; ParamName: string;
210 var BlobID: TISC_QUAD);
211 var Blob: TIBBlobStream;
212 Source: TStream;
213 FileName: string;
214 begin
215 Blob := TIBBlobStream.Create;
216 try
217 Blob.Database := (Sender as TIBXScript).Database;
218 Blob.Transaction := (Sender as TIBXScript).Transaction;
219 Blob.Mode := bmWrite;
220 if not GetSourceFile(ParamName,FileName) then
221 IBError(ibxeResourceFileNotFound,[FileName]);
222
223 if CompareText(ExtractFileExt(FileName),'.gz') = 0 then {gzip compressed file}
224 Source := TGZFileStream.Create(FileName,gzopenread)
225 else
226 Source := TFileStream.Create(FileName,fmOpenRead or fmShareDenyNone);
227 try
228 Blob.CopyFrom(Source,0)
229 finally
230 Source.Free
231 end;
232 Blob.Finalize;
233 BlobID := Blob.BlobID
234 finally
235 Blob.Free
236 end
237 end;
238
239 end.
240