iblocaldb/nongui/IBXUpgradeConfFile.pas

(*
 *  IBX For Lazarus (Firebird Express)
 *
 *  The contents of this file are subject to the Initial Developer's
 *  Public License Version 1.0 (the "License"); you may not use this
 *  file except in compliance with the License. You may obtain a copy
 *  of the License here:
 *
 *    http://www.firebirdsql.org/index.php?op=doc&id=idpl
 *
 *  Software distributed under the License is distributed on an "AS
 *  IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 *  implied. See the License for the specific language governing rights
 *  and limitations under the License.
 *
 *  The Initial Developer of the Original Code is Tony Whyman.
 *
 *  The Original Code is (C) 2014 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ____________________________UpgradeConfFile__________.
 *
*)
unit IBXUpgradeConfFile;

{$mode objfpc}{$H+}

{
       TUpgradeConfFile encapsulated a text file in “ini” file format with
       the following sections:

       [status]

       This should have a single named value “current” giving the current database
       schema number as in integer e.g.

       current = 2

       This should normally be set to the same value as the RequiredVersionNo property
       and acts as a check to ensure that both are in sync.

       [Version.nnn]

       Where nnn is an integer with leaving zeroes. For example, “Version.002” is
       the section read to upgrade the database schema from version 1 to version 2.
       This section can contain the following named values:

       Name         Type        Use

       Upgrade      String      Name and optional path to SQL script used to perform
                                the upgrade. May either be absolute path or relative
                                to the upgrade configuration file. Either forwards or
                                back slashes may be used as the path delimiter.

       Msg          string      Text message displayed in progress dialog while script is
                                active.  Defaults to “Upgrading Database Schema to Version nnn”.

       BackupDatabase yes/no    If present and set to “yes” then a database backup in
                                gbak format is made before the upgrade is performed. The backup file is
                                located in the same directory as the database file and is given the same
                                name as the database file with the extension replaced with “.nnn.gbak”.
                                Where “nnn” is the current schema version number (i.e. prior to running
                                the upgrade script).

       <Parameter Name> string  Name and optional path to binary data file. May either be
                                absolute path or relative to the upgrade configuration file.
                                Either forwards or back slashes may be used as the path delimiter.


       For example:

       [Version.002]
       Msg = Upgrading to Version 2
       BackupDatabase = yes
       Upgrade = patches/02-patch.sql
       mugshot = images/man.png.gz

       Note that in the above, “mugshot” is intended to be used to resolve an Update,
       Insert or Delete query parameter in the 02-patch.sql file. E.g.

       Update EMPLOYEE Set Photo =:MUGSHOT Where Emp_no = 2;

       This is only applicable to BLOB columns and the above is interpreted as update
       the EMPLOYEE table where the Emp_no is “2” and set the value of the Photo column
       to the binary data contained in the file “images/man.png.gz”.
}

interface

uses
  Classes, SysUtils, IniFiles, IB, DB;

type
  TUpgradeInfo = record
    UpdateSQLFile,
    UserMessage: string;
    BackupDB: boolean;
  end;

{ TUpgradeConfFile }

  TUpgradeConfFile = class
  private
    FConfFileName: string;
    FCurrentVersion: string;
    FUpgradeInfo: TIniFile;
    function GetUpgradeAvailableToVersion: integer;
  public
    constructor Create(aFileName: string);
    destructor Destroy; override;
    class function IsAbsolutePath(aPath: string): boolean;
    function CheckUpgradeAvailable(RequiredVersionNo: integer): boolean;
    function GetUpgradeInfo(SectionHeaderTemplate: string; VersionNo: integer;
      var UpgradeInfo: TUpgradeInfo): boolean;
    function GetSourceFile(aName: string; var FileName: string): boolean;
    procedure GetParamValue(Sender: TObject; ParamName: string; var BlobID: TISC_QUAD);
    property UpgradeAvailableToVersion: integer read GetUpgradeAvailableToVersion;
  end;

  EUpgradeConfFileError = class(Exception);


implementation

uses ZStream, IBBlob, ibxscript, IBMessages;

resourcestring
  sInvalidConfFile = 'Database Upgrade Required, but the Upgrade File (%s) is missing or not specified';
  sUpgradeRequired = 'Database Upgrade Required, but the Upgrade File is out of Date. '+
                              'Required Version = %d, Upgrade available for version %d';
  sNoInfo      = 'Upgrading Database Schema to Version %d';

{ TUpgradeConfFile }

function TUpgradeConfFile.GetUpgradeAvailableToVersion: integer;
begin
  Result := StrToInt(FUpgradeInfo.ReadString('Status','Current','0'))
end;

constructor TUpgradeConfFile.Create(aFileName: string);
begin
  inherited Create;
  FConfFileName := aFileName;
  if (FConfFileName = '') or not FileExists(FConfFileName) then
     raise EUpgradeConfFileError.CreateFmt(sInvalidConfFile,[FConfFileName]);
  FUpgradeInfo := TIniFile.Create(FConfFileName);
end;

destructor TUpgradeConfFile.Destroy;
begin
  if assigned(FUpgradeInfo) then FUpgradeInfo.Free;
  inherited Destroy;
end;

class function TUpgradeConfFile.IsAbsolutePath(aPath: string): boolean;
begin
  Result := false;
  {$IFDEF WINDOWS}
    Result := (ExtractFileDrive(aPath) <> '') or
      ((Length(aPath) > 0) and (aPath[1] = DirectorySeparator));
  {$ENDIF}
  {$IFDEF UNIX}
    Result := (Length(aPath) > 0) and (aPath[1] = DirectorySeparator);
  {$ENDIF}
end;

function TUpgradeConfFile.CheckUpgradeAvailable(RequiredVersionNo: integer
  ): boolean;
var CurVersion: integer;
begin
  CurVersion := GetUpgradeAvailableToVersion;
  if CurVersion < RequiredVersionNo then
    raise EUpgradeConfFileError.CreateFmt(sUpgradeRequired, [RequiredVersionNo,CurVersion]);
end;

function TUpgradeConfFile.GetUpgradeInfo(SectionHeaderTemplate: string; VersionNo: integer;
  var UpgradeInfo: TUpgradeInfo): boolean;
begin
   Result := false;
   FCurrentVersion := Format(SectionHeaderTemplate,[VersionNo]);
   UpgradeInfo.UserMessage := FUpgradeInfo.ReadString(FCurrentVersion,'Msg',
                                Format(sNoInfo,[VersionNo]));
   UpgradeInfo.UpdateSQLFile := FUpgradeInfo.ReadString(FCurrentVersion,'Upgrade','');
   Result := UpgradeInfo.UpdateSQLFile <> '';
   if Result then
   begin
     DoDirSeparators(UpgradeInfo.UpdateSQLFile); {Resolve Platform dependencies}
     if not IsAbsolutePath(UpgradeInfo.UpdateSQLFile) then
       UpgradeInfo.UpdateSQLFile := ExtractFilePath(FConfFileName) + UpgradeInfo.UpdateSQLFile;
     UpgradeInfo.BackupDB := CompareText(FUpgradeInfo.ReadString(FCurrentVersion,'BackupDatabase','no'),'yes') = 0;
     if not FileExists(UpgradeInfo.UpdateSQLFile) then
       IBError(ibxePatchFileNotFound,[FUpgradeInfo.FileName,UpgradeInfo.UpdateSQLFile, FCurrentVersion])
     else
       Result := true;
   end;
end;

function TUpgradeConfFile.GetSourceFile(aName: string; var FileName: string
  ): boolean;
begin
  FileName := FUpgradeInfo.ReadString(FCurrentVersion,aName,'');
  DoDirSeparators(FileName);
  if not IsAbsolutePath(FileName) then
    FileName := ExtractFilePath(FConfFileName) + FileName;
  Result := FileExists(FileName);
end;

procedure TUpgradeConfFile.GetParamValue(Sender: TObject; ParamName: string;
  var BlobID: TISC_QUAD);
var Blob: TIBBlobStream;
    Source: TStream;
    FileName: string;
begin
  Blob := TIBBlobStream.Create;
  try
    Blob.Database := (Sender as TIBXScript).Database;
    Blob.Transaction := (Sender as TIBXScript).Transaction;
    Blob.Mode := bmWrite;
    if not GetSourceFile(ParamName,FileName) then
      IBError(ibxeResourceFileNotFound,[FileName]);

    if CompareText(ExtractFileExt(FileName),'.gz') = 0 then  {gzip compressed file}
      Source := TGZFileStream.Create(FileName,gzopenread)
    else
      Source := TFileStream.Create(FileName,fmOpenRead or fmShareDenyNone);
    try
      Blob.CopyFrom(Source,0)
    finally
      Source.Free
    end;
    Blob.Finalize;
    BlobID := Blob.BlobID
  finally
    Blob.Free
  end
end;

end.

Revision:	345
Committed:	Mon Aug 23 14:22:29 2021 UTC (2 years, 7 months ago) by tony
Content type:	text/x-pascal
File size:	8596 byte(s)
Log Message:	Merged into public release
#	Content
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(SectionHeaderTemplate: string; VersionNo: integer;
116	var UpgradeInfo: TUpgradeInfo): boolean;
117	function GetSourceFile(aName: string; var FileName: string): boolean;
118	procedure GetParamValue(Sender: TObject; ParamName: string; var BlobID: TISC_QUAD);
119	property UpgradeAvailableToVersion: integer read GetUpgradeAvailableToVersion;
120	end;
121
122	EUpgradeConfFileError = class(Exception);
123
124
125	implementation
126
127	uses ZStream, IBBlob, ibxscript, IBMessages;
128
129	resourcestring
130	sInvalidConfFile = 'Database Upgrade Required, but the Upgrade File (%s) is missing or not specified';
131	sUpgradeRequired = 'Database Upgrade Required, but the Upgrade File is out of Date. '+
132	'Required Version = %d, Upgrade available for version %d';
133	sNoInfo = 'Upgrading Database Schema to Version %d';
134
135	{ TUpgradeConfFile }
136
137	function TUpgradeConfFile.GetUpgradeAvailableToVersion: integer;
138	begin
139	Result := StrToInt(FUpgradeInfo.ReadString('Status','Current','0'))
140	end;
141
142	constructor TUpgradeConfFile.Create(aFileName: string);
143	begin
144	inherited Create;
145	FConfFileName := aFileName;
146	if (FConfFileName = '') or not FileExists(FConfFileName) then
147	raise EUpgradeConfFileError.CreateFmt(sInvalidConfFile,[FConfFileName]);
148	FUpgradeInfo := TIniFile.Create(FConfFileName);
149	end;
150
151	destructor TUpgradeConfFile.Destroy;
152	begin
153	if assigned(FUpgradeInfo) then FUpgradeInfo.Free;
154	inherited Destroy;
155	end;
156
157	class function TUpgradeConfFile.IsAbsolutePath(aPath: string): boolean;
158	begin
159	Result := false;
160	{$IFDEF WINDOWS}
161	Result := (ExtractFileDrive(aPath) <> '') or
162	((Length(aPath) > 0) and (aPath[1] = DirectorySeparator));
163	{$ENDIF}
164	{$IFDEF UNIX}
165	Result := (Length(aPath) > 0) and (aPath[1] = DirectorySeparator);
166	{$ENDIF}
167	end;
168
169	function TUpgradeConfFile.CheckUpgradeAvailable(RequiredVersionNo: integer
170	): boolean;
171	var CurVersion: integer;
172	begin
173	CurVersion := GetUpgradeAvailableToVersion;
174	if CurVersion < RequiredVersionNo then
175	raise EUpgradeConfFileError.CreateFmt(sUpgradeRequired, [RequiredVersionNo,CurVersion]);
176	end;
177
178	function TUpgradeConfFile.GetUpgradeInfo(SectionHeaderTemplate: string; VersionNo: integer;
179	var UpgradeInfo: TUpgradeInfo): boolean;
180	begin
181	Result := false;
182	FCurrentVersion := Format(SectionHeaderTemplate,[VersionNo]);
183	UpgradeInfo.UserMessage := FUpgradeInfo.ReadString(FCurrentVersion,'Msg',
184	Format(sNoInfo,[VersionNo]));
185	UpgradeInfo.UpdateSQLFile := FUpgradeInfo.ReadString(FCurrentVersion,'Upgrade','');
186	Result := UpgradeInfo.UpdateSQLFile <> '';
187	if Result then
188	begin
189	DoDirSeparators(UpgradeInfo.UpdateSQLFile); {Resolve Platform dependencies}
190	if not IsAbsolutePath(UpgradeInfo.UpdateSQLFile) then
191	UpgradeInfo.UpdateSQLFile := ExtractFilePath(FConfFileName) + UpgradeInfo.UpdateSQLFile;
192	UpgradeInfo.BackupDB := CompareText(FUpgradeInfo.ReadString(FCurrentVersion,'BackupDatabase','no'),'yes') = 0;
193	if not FileExists(UpgradeInfo.UpdateSQLFile) then
194	IBError(ibxePatchFileNotFound,[FUpgradeInfo.FileName,UpgradeInfo.UpdateSQLFile, FCurrentVersion])
195	else
196	Result := true;
197	end;
198	end;
199
200	function TUpgradeConfFile.GetSourceFile(aName: string; var FileName: string
201	): boolean;
202	begin
203	FileName := FUpgradeInfo.ReadString(FCurrentVersion,aName,'');
204	DoDirSeparators(FileName);
205	if not IsAbsolutePath(FileName) then
206	FileName := ExtractFilePath(FConfFileName) + FileName;
207	Result := FileExists(FileName);
208	end;
209
210	procedure TUpgradeConfFile.GetParamValue(Sender: TObject; ParamName: string;
211	var BlobID: TISC_QUAD);
212	var Blob: TIBBlobStream;
213	Source: TStream;
214	FileName: string;
215	begin
216	Blob := TIBBlobStream.Create;
217	try
218	Blob.Database := (Sender as TIBXScript).Database;
219	Blob.Transaction := (Sender as TIBXScript).Transaction;
220	Blob.Mode := bmWrite;
221	if not GetSourceFile(ParamName,FileName) then
222	IBError(ibxeResourceFileNotFound,[FileName]);
223
224	if CompareText(ExtractFileExt(FileName),'.gz') = 0 then {gzip compressed file}
225	Source := TGZFileStream.Create(FileName,gzopenread)
226	else
227	Source := TFileStream.Create(FileName,fmOpenRead or fmShareDenyNone);
228	try
229	Blob.CopyFrom(Source,0)
230	finally
231	Source.Free
232	end;
233	Blob.Finalize;
234	BlobID := Blob.BlobID
235	finally
236	Blob.Free
237	end
238	end;
239
240	end.
241