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(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;

const
  sSectionheader      = 'Version.%.3d';

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(VersionNo: integer;
  var UpgradeInfo: TUpgradeInfo): boolean;
begin
   Result := false;
   FCurrentVersion := Format(sSectionheader,[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;
     Result := FileExists(UpgradeInfo.UpdateSQLFile);
   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 Exit;

    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:	272
Committed:	Mon Feb 4 13:34:37 2019 UTC (5 years, 9 months ago) by tony
Content type:	text/x-pascal
File size:	8371 byte(s)
Log Message:	Fixes merged
#	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(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;
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 Exit;
221
222	if CompareText(ExtractFileExt(FileName),'.gz') = 0 then {gzip compressed file}
223	Source := TGZFileStream.Create(FileName,gzopenread)
224	else
225	Source := TFileStream.Create(FileName,fmOpenRead or fmShareDenyNone);
226	try
227	Blob.CopyFrom(Source,0)
228	finally
229	Source.Free
230	end;
231	Blob.Finalize;
232	BlobID := Blob.BlobID
233	finally
234	Blob.Free
235	end
236	end;
237
238	end.
239