ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/iblocaldb/nongui/IBXUpgradeConfFile.pas
Revision: 209
Committed: Wed Mar 14 12:48:51 2018 UTC (6 years ago) by tony
Content type: text/x-pascal
File size: 8356 byte(s)
Log Message:
Fixes Merged

File Contents

# User Rev Content
1 tony 209 (*
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     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