trunk/iblocaldb/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): ______________________________________.
 *
*)
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:	80
Committed:	Mon Jan 1 11:31:07 2018 UTC (6 years, 10 months ago) by tony
Content type:	text/x-pascal
File size:	8356 byte(s)
Log Message:	Fixes merged into public release
#	User	Rev	Content
1	tony	37	(*
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): ______________________________________.
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	tony	80	Classes, SysUtils, IniFiles, IB, DB;
94	tony	37
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	tony	80	procedure GetParamValue(Sender: TObject; ParamName: string; var BlobID: TISC_QUAD);
118	tony	37	property UpgradeAvailableToVersion: integer read GetUpgradeAvailableToVersion;
119			end;
120
121			EUpgradeConfFileError = class(Exception);
122
123
124			implementation
125
126	tony	80	uses ZStream, IBBlob, ibxscript;
127
128	tony	37	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	tony	80	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	tony	37	end.
239