Menu
▾
▴
[Instantobjects-cvscommit] SF.net SVN: instantobjects: [584] trunk/Source/Core
|
From: <na...@us...> - 2006-02-13 07:10:20
|
Revision: 584 Author: nandod Date: 2006-02-12 23:09:19 -0800 (Sun, 12 Feb 2006) ViewCVS: http://svn.sourceforge.net/instantobjects?rev=584&view=rev Log Message: ----------- unsupported column types no longer stop the build/evolution process. Modified Paths: -------------- trunk/Source/Brokers/BDE/InstantBDECatalog.pas trunk/Source/Brokers/ZeosDBO/InstantZeosDBO.pas trunk/Source/Brokers/ZeosDBO/InstantZeosDBOCatalog.pas trunk/Source/Catalogs/MSSql/InstantMSSqlCatalog.pas trunk/Source/Core/InstantConsts.pas trunk/Source/Core/InstantCustomDBEvolverFormUnit.pas trunk/Source/Core/InstantDBBuild.pas trunk/Source/Core/InstantDBEvolution.pas trunk/Source/Core/InstantPersistence.pas Modified: trunk/Source/Brokers/BDE/InstantBDECatalog.pas =================================================================== --- trunk/Source/Brokers/BDE/InstantBDECatalog.pas 2006-02-05 16:40:22 UTC (rev 583) +++ trunk/Source/Brokers/BDE/InstantBDECatalog.pas 2006-02-13 07:09:19 UTC (rev 584) @@ -23,7 +23,7 @@ * Portions created by the Initial Developer are Copyright (C) 2005 * the Initial Developer. All Rights Reserved. * - * Contributor(s): + * Contributor(s): Nando Dessena * * ***** END LICENSE BLOCK ***** *) @@ -48,7 +48,8 @@ procedure AddFieldMetadatas(TableMetadata: TInstantTableMetadata); procedure AddIndexMetadatas(TableMetadata: TInstantTableMetadata); procedure AddTableMetadatas(TableMetadatas: TInstantTableMetadatas); - function ColumnTypeToDataType(const ColumnType: TFieldType): TInstantDataType; + function ColumnTypeToDataType(const ColumnType: TFieldType; + out DataType: TInstantDataType): Boolean; public procedure InitTableMetadatas(ATableMetadatas: TInstantTableMetadatas); override; @@ -65,6 +66,7 @@ vTable: TTable; FieldMetadata: TInstantFieldMetadata; i: Integer; + FieldDataType: TInstantDataType; begin vTable := TTable.Create(nil); try @@ -73,17 +75,24 @@ vTable.FieldDefs.Update; for i := 0 to Pred(vTable.FieldDefs.Count) do begin - FieldMetadata := TableMetadata.FieldMetadatas.Add; - FieldMetadata.Name := Trim(vTable.FieldDefs[i].Name); - FieldMetadata.DataType := ColumnTypeToDataType(vTable.FieldDefs[i].DataType); - FieldMetadata.Options := []; - if vTable.FieldDefs[i].Required then - FieldMetadata.Options := FieldMetadata.Options + [foRequired]; - if TableMetadata.IndexMetadatas.IsFieldIndexed(FieldMetadata) then - FieldMetadata.Options := FieldMetadata.Options + [foIndexed]; - { TODO : support ExternalTableName? } - if FieldMetadata.DataType in [dtString, dtMemo] then - FieldMetadata.Size := vTable.FieldDefs[i].Size; + if ColumnTypeToDataType(vTable.FieldDefs[i].DataType, FieldDataType) then + begin + FieldMetadata := TableMetadata.FieldMetadatas.Add; + FieldMetadata.Name := vTable.FieldDefs[i].Name; + FieldMetadata.DataType := FieldDataType; + FieldMetadata.Options := []; + if vTable.FieldDefs[i].Required then + FieldMetadata.Options := FieldMetadata.Options + [foRequired]; + if TableMetadata.IndexMetadatas.IsFieldIndexed(FieldMetadata) then + FieldMetadata.Options := FieldMetadata.Options + [foIndexed]; + { TODO : support ExternalTableName? } + if FieldMetadata.DataType in [dtString, dtMemo] then + FieldMetadata.Size := vTable.FieldDefs[i].Size; + end + else + DoWarning(Format(SUnsupportedColumnSkipped, [ + TableMetadata.Name, vTable.FieldDefs[i].Name, + GetEnumName(TypeInfo(TFieldType), Ord(vTable.FieldDefs[i].DataType))])); end; finally vTable.Free; @@ -109,10 +118,10 @@ begin IndexMetadata := TableMetadata.IndexMetadatas.Add; if ixPrimary in vTable.IndexDefs[i].Options then - IndexMetadata.Name := Trim(vTable.IndexDefs[i].Name) + IndexMetadata.Name := vTable.IndexDefs[i].Name else IndexMetadata.Name := ChangeFileExt(vTable.TableName, '') - + Trim(vTable.IndexDefs[i].Name); + + vTable.IndexDefs[i].Name; IndexMetadata.Fields := vTable.IndexDefs[i].Fields; IndexMetadata.Options := vTable.IndexDefs[i].Options; end; @@ -136,7 +145,7 @@ Session.GetTableNames(vDatabaseName, '*.*', true, false, vTables); for i := 0 to Pred(vTables.Count) do begin - vTableName := ExtractFileName(Trim(vTables.Strings[i])); + vTableName := ExtractFileName(vTables.Strings[i]); TableMetadata := TableMetadatas.Add; TableMetadata.Name := vTableName; // Call AddIndexMetadatas first, so that AddFieldMetadatas can see what @@ -150,26 +159,26 @@ end; end; -function TInstantBDECatalog.ColumnTypeToDataType(const ColumnType: TFieldType): - TInstantDataType; +function TInstantBDECatalog.ColumnTypeToDataType(const ColumnType: TFieldType; + out DataType: TInstantDataType): Boolean; begin + Result := True; case ColumnType of - ftString: Result := dtString; + ftString: DataType := dtString; ftSmallint, - ftInteger: Result := dtInteger; - ftBoolean: Result := dtBoolean; - ftFloat: Result := dtFloat; - ftCurrency: Result := dtCurrency; + ftInteger: DataType := dtInteger; + ftBoolean: DataType := dtBoolean; + ftFloat: DataType := dtFloat; + ftCurrency: DataType := dtCurrency; ftDate, ftTime, - ftDateTime: Result := dtDateTime; - ftAutoInc: Result := dtInteger; + ftDateTime: DataType := dtDateTime; + ftAutoInc: DataType := dtInteger; ftBlob, - ftGraphic: Result := dtBlob; - ftMemo: Result := dtMemo; + ftGraphic: DataType := dtBlob; + ftMemo: DataType := dtMemo; else - raise Exception.CreateFmt(SUnsupportedColumnType, - [GetEnumName(TypeInfo(TFieldType), Ord(ColumnType))]); + Result := False; end; end; Modified: trunk/Source/Brokers/ZeosDBO/InstantZeosDBO.pas =================================================================== --- trunk/Source/Brokers/ZeosDBO/InstantZeosDBO.pas 2006-02-05 16:40:22 UTC (rev 583) +++ trunk/Source/Brokers/ZeosDBO/InstantZeosDBO.pas 2006-02-13 07:09:19 UTC (rev 584) @@ -1148,7 +1148,7 @@ if not Assigned(FOldTableMetadata) then begin //Force to read the table from database - FScheme := Broker.ReadDatabaseScheme; + FScheme := Broker.ReadDatabaseScheme(nil); FieldMetadata := nil; case CommandType of Modified: trunk/Source/Brokers/ZeosDBO/InstantZeosDBOCatalog.pas =================================================================== --- trunk/Source/Brokers/ZeosDBO/InstantZeosDBOCatalog.pas 2006-02-05 16:40:22 UTC (rev 583) +++ trunk/Source/Brokers/ZeosDBO/InstantZeosDBOCatalog.pas 2006-02-13 07:09:19 UTC (rev 584) @@ -49,7 +49,8 @@ procedure AddIndexMetadatas(TableMetadata: TInstantTableMetadata); procedure AddTableMetadatas(TableMetadatas: TInstantTableMetadatas); function ColumnTypeToDataType(const ColumnType: TZSQLType; - out AlternateDataTypes: TInstantDataTypes): TInstantDataType; + out DataType: TInstantDataType; + out AlternateDataTypes: TInstantDataTypes): Boolean; function GetBroker: TInstantZeosDBOBroker; function GetConnector: TInstantZeosDBOConnector; public @@ -70,7 +71,8 @@ var Fields: IZResultSet; FieldMetadata: TInstantFieldMetadata; - AlternateDatatypes: TInstantDataTypes; + FieldDataType: TInstantDataType; + FieldAlternateDataTypes: TInstantDataTypes; begin with Connector.Connection do Fields := DbcConnection.GetMetadata.GetColumns(Catalog, '', @@ -79,24 +81,30 @@ Fields.BeforeFirst; while Fields.Next do begin - FieldMetadata := TableMetadata.FieldMetadatas.Add; - FieldMetadata.Name := Fields.GetStringByName('COLUMN_NAME'); - FieldMetadata.DataType := - ColumnTypeToDataType(TZSQLType(Fields.GetShortByName('DATA_TYPE')), - AlternateDataTypes); - FieldMetadata.AlternateDataTypes := AlternateDataTypes; - FieldMetadata.Options := []; - if not Fields.GetBooleanByName('IS_NULLABLE') then - FieldMetadata.Options := FieldMetadata.Options + [foRequired]; - if TableMetadata.IndexMetadatas.IsFieldIndexed(FieldMetadata) then - FieldMetadata.Options := FieldMetadata.Options + [foIndexed]; - // work around bug in GetColumns for all drivers where - // CHAR_OCTET_LENGTH is not assigned - if (FieldMetadata.DataType in [dtString, dtMemo]) and - (Fields.GetIntByName('CHAR_OCTET_LENGTH') > 0) then - FieldMetadata.Size := Fields.GetIntByName('CHAR_OCTET_LENGTH') + if ColumnTypeToDataType(TZSQLType(Fields.GetShortByName('DATA_TYPE')), + FieldDataType, FieldAlternateDataTypes) then + begin + FieldMetadata := TableMetadata.FieldMetadatas.Add; + FieldMetadata.Name := Fields.GetStringByName('COLUMN_NAME'); + FieldMetadata.DataType := FieldDataType; + FieldMetadata.AlternateDataTypes := FieldAlternateDataTypes; + FieldMetadata.Options := []; + if not Fields.GetBooleanByName('IS_NULLABLE') then + FieldMetadata.Options := FieldMetadata.Options + [foRequired]; + if TableMetadata.IndexMetadatas.IsFieldIndexed(FieldMetadata) then + FieldMetadata.Options := FieldMetadata.Options + [foIndexed]; + // work around bug in GetColumns for all drivers where + // CHAR_OCTET_LENGTH is not assigned + if (FieldMetadata.DataType in [dtString, dtMemo]) and + (Fields.GetIntByName('CHAR_OCTET_LENGTH') > 0) then + FieldMetadata.Size := Fields.GetIntByName('CHAR_OCTET_LENGTH') + else + FieldMetadata.Size := Fields.GetIntByName('COLUMN_SIZE'); + end else - FieldMetadata.Size := Fields.GetIntByName('COLUMN_SIZE'); + DoWarning(Format(SUnsupportedColumnSkipped, [ + TableMetadata.Name, Fields.GetStringByName('COLUMN_NAME'), + GetEnumName(TypeInfo(TZSQLType), Fields.GetShortByName('DATA_TYPE'))])); end; end; @@ -191,39 +199,40 @@ end; end; -function TInstantZeosDBOCatalog.ColumnTypeToDataType(const ColumnType: - TZSQLType; out AlternateDataTypes: TInstantDataTypes): TInstantDataType; +function TInstantZeosDBOCatalog.ColumnTypeToDataType(const ColumnType: TZSQLType; + out DataType: TInstantDataType; + out AlternateDataTypes: TInstantDataTypes): Boolean; begin + Result := True; AlternateDataTypes := []; case ColumnType of stString, - stUnicodeString: Result := dtString; - stBoolean: Result := dtBoolean; + stUnicodeString: DataType := dtString; + stBoolean: DataType := dtBoolean; stShort: begin - Result := dtBoolean; + DataType := dtBoolean; Include(AlternateDataTypes, dtInteger); end; stByte, stInteger, - stLong: Result := dtInteger; + stLong: DataType := dtInteger; stFloat, stDouble: begin - Result := dtFloat; + DataType := dtFloat; Include(AlternateDataTypes, dtCurrency); end; - stBigDecimal: Result := dtCurrency; + stBigDecimal: DataType := dtCurrency; stDate, stTime, - stTimeStamp: Result := dtDateTime; + stTimeStamp: DataType := dtDateTime; stBytes, - stBinaryStream: Result := dtBlob; + stBinaryStream: DataType := dtBlob; stAsciiStream, - stUnicodeStream: Result := dtMemo; + stUnicodeStream: DataType := dtMemo; else - raise EInstantError.CreateFmt(SUnsupportedColumnType, - [GetEnumName(TypeInfo(TZSQLType), Ord(ColumnType))]); + Result := False; end; end; Modified: trunk/Source/Catalogs/MSSql/InstantMSSqlCatalog.pas =================================================================== --- trunk/Source/Catalogs/MSSql/InstantMSSqlCatalog.pas 2006-02-05 16:40:22 UTC (rev 583) +++ trunk/Source/Catalogs/MSSql/InstantMSSqlCatalog.pas 2006-02-13 07:09:19 UTC (rev 584) @@ -49,7 +49,8 @@ procedure AddIndexMetadatas(TableMetadata: TInstantTableMetadata); procedure AddTableMetadatas(TableMetadatas: TInstantTableMetadatas); function ColumnTypeToDataType(const ColumnType: string; - const ColumnSubType, FieldScale: Integer): TInstantDataType; + const ColumnSubType, FieldScale: Integer; + out DataType: TInstantDataType): Boolean; function GetSelectFieldsSQL(const ATableName: string): string; function GetSelectIndexesSQL(const ATableName: string): string; function GetSelectIndexFieldsSQL(const AIndexName: string): string; @@ -90,7 +91,7 @@ try while not IndexFields.Eof do begin - IndexFieldList.Add(Trim(IndexFields.FieldByName('COLUMN_NAME').AsString)); + IndexFieldList.Add(IndexFields.FieldByName('COLUMN_NAME').AsString); IndexFields.Next; end; finally @@ -114,7 +115,7 @@ while not Indexes.Eof do begin IndexMetadata := TableMetadata.IndexMetadatas.Add; - IndexMetadata.Name := Trim(Indexes.FieldByName('INDEX_NAME').AsString); + IndexMetadata.Name := Indexes.FieldByName('INDEX_NAME').AsString; IndexMetadata.Fields := GetIndexFields(IndexMetadata.Name); IndexMetadata.Options := []; @@ -141,6 +142,7 @@ var Fields: TDataSet; FieldMetadata: TInstantFieldMetadata; + FieldDataType: TInstantDataType; begin Fields := Broker.AcquireDataSet(GetSelectFieldsSQL(TableMetadata.Name)); try @@ -148,18 +150,25 @@ try while not Fields.Eof do begin - FieldMetadata := TableMetadata.FieldMetadatas.Add; - FieldMetadata.Name := Trim(Fields.FieldByName('COLUMN_NAME').AsString); - FieldMetadata.DataType := ColumnTypeToDataType( - Trim(Fields.FieldByName('COLUMN_TYPENAME').AsString), + if ColumnTypeToDataType( + Fields.FieldByName('COLUMN_TYPENAME').AsString, Fields.FieldByName('COLUMN_SUBTYPE').AsInteger, - Fields.FieldByName('COLUMN_SCALE').AsInteger); - FieldMetadata.Options := []; - if Fields.FieldByName('COLUMN_NULLABLE').AsInteger <> 1 then - FieldMetadata.Options := FieldMetadata.Options + [foRequired]; - if TableMetadata.IndexMetadatas.IsFieldIndexed(FieldMetadata) then - FieldMetadata.Options := FieldMetadata.Options + [foIndexed]; - FieldMetadata.Size := Fields.FieldByName('COLUMN_LENGTH').AsInteger; + Fields.FieldByName('COLUMN_SCALE').AsInteger, FieldDataType) then + begin + FieldMetadata := TableMetadata.FieldMetadatas.Add; + FieldMetadata.Name := Fields.FieldByName('COLUMN_NAME').AsString; + FieldMetadata.DataType := FieldDataType; + FieldMetadata.Options := []; + if Fields.FieldByName('COLUMN_NULLABLE').AsInteger <> 1 then + FieldMetadata.Options := FieldMetadata.Options + [foRequired]; + if TableMetadata.IndexMetadatas.IsFieldIndexed(FieldMetadata) then + FieldMetadata.Options := FieldMetadata.Options + [foIndexed]; + FieldMetadata.Size := Fields.FieldByName('COLUMN_LENGTH').AsInteger; + end + else + DoWarning(Format(SUnsupportedColumnSkipped, [ + TableMetadata.Name, Fields.FieldByName('COLUMN_NAME').AsString, + Fields.FieldByName('COLUMN_TYPENAME').AsString])); Fields.Next; end; finally @@ -183,7 +192,7 @@ while not Tables.Eof do begin TableMetadata := TableMetadatas.Add; - TableMetadata.Name := Trim(Tables.FieldByName('TABLE_NAME').AsString); + TableMetadata.Name := Tables.FieldByName('TABLE_NAME').AsString; // Call AddIndexMetadatas first, so that AddFieldMetadatas can see what // indexes are defined to correctly set the foIndexed option. AddIndexMetadatas(TableMetadata); @@ -199,26 +208,28 @@ end; function TInstantMSSqlCatalog.ColumnTypeToDataType(const ColumnType: string; - const ColumnSubType, FieldScale: Integer): TInstantDataType; + const ColumnSubType, FieldScale: Integer; + out DataType: TInstantDataType): Boolean; begin + Result := True; if SameText(ColumnType, 'int') then - Result := dtInteger + DataType := dtInteger else if SameText(ColumnType, 'float') then - Result := dtFloat + DataType := dtFloat else if SameText(ColumnType, 'money') then - Result := dtCurrency + DataType := dtCurrency else if SameText(ColumnType, 'bit') then - Result := dtBoolean + DataType := dtBoolean else if SameText(ColumnType, 'varchar') then - Result := dtString + DataType := dtString else if SameText(ColumnType, 'text') then - Result := dtMemo + DataType := dtMemo else if SameText(ColumnType, 'datetime') then - Result := dtDateTime + DataType := dtDateTime else if SameText(ColumnType, 'image') then - Result := dtBlob + DataType := dtBlob else - raise Exception.CreateFmt(SUnsupportedColumnType, [ColumnType]); + Result := False; end; function TInstantMSSqlCatalog.GetSelectFieldsSQL( @@ -304,7 +315,7 @@ 'SELECT ' + ' name AS TABLE_NAME ' + 'FROM sysobjects ' + - 'WHERE type = ''U'' ' + + 'WHERE type = ''U'' and OBJECTPROPERTY(id, N''IsMSShipped'') <> 1' + 'ORDER BY name'; end; Modified: trunk/Source/Core/InstantConsts.pas =================================================================== --- trunk/Source/Core/InstantConsts.pas 2006-02-05 16:40:22 UTC (rev 583) +++ trunk/Source/Core/InstantConsts.pas 2006-02-13 07:09:19 UTC (rev 584) @@ -180,7 +180,7 @@ SUnexpectedToken = 'Unexpected token ''%s''. Expected token ''%s'''; SUnknownAttributeClass = 'Unknown attribute class for attribute %s(''%s'')'; SUnspecifiedCommand = 'Command is not specified'; - SUnsupportedColumnType = 'ColumnType %s not supported'; + SUnsupportedColumnSkipped = 'Skipped column %s.%s. Unsupported type %s.'; SUnsupportedDataType = 'Unsupported datatype: %s'; SUnsupportedGraphicClass = 'Unsupported graphic class'; SUnsupportedGraphicStream = 'Unsupported graphic stream format'; Modified: trunk/Source/Core/InstantCustomDBEvolverFormUnit.pas =================================================================== --- trunk/Source/Core/InstantCustomDBEvolverFormUnit.pas 2006-02-05 16:40:22 UTC (rev 583) +++ trunk/Source/Core/InstantCustomDBEvolverFormUnit.pas 2006-02-13 07:09:19 UTC (rev 584) @@ -104,6 +104,7 @@ var RaiseError: Boolean); virtual; procedure CustomDBEvolverBeforeCommandSequenceExecute(Sender: TObject); virtual; procedure CustomDBEvolverAfterCommandSequenceExecute(Sender: TObject); virtual; + procedure CustomDBEvolverWarning(const Sender: TObject; const AWarningText: string); virtual; procedure BeforeBuildCommandSequence; virtual; public // Assign a connector before calling the Execute method, otherwise the @@ -222,6 +223,7 @@ OldScreenCursor := Screen.Cursor; Screen.Cursor := crHourglass; try + EvolutionLogMemo.Lines.Clear; BeforeBuildCommandSequence; GetCustomDBEvolver.BuildCommandSequence; SequenceToScreen; @@ -323,6 +325,7 @@ GetCustomDBEvolver.BeforeCommandSequenceExecute := CustomDBEvolverBeforeCommandSequenceExecute; GetCustomDBEvolver.AfterCommandSequenceExecute := CustomDBEvolverAfterCommandSequenceExecute; GetCustomDBEvolver.OnCommandExecuteError := CustomDBEvolverCommandExecuteError; + GetCustomDBEvolver.OnWarning := CustomDBEvolverWarning; end; procedure TInstantCustomDBEvolverForm.BeforeBuildCommandSequence; @@ -334,4 +337,10 @@ Close; end; +procedure TInstantCustomDBEvolverForm.CustomDBEvolverWarning( + const Sender: TObject; const AWarningText: string); +begin + Log('Warning: ' + AWarningText); +end; + end. Modified: trunk/Source/Core/InstantDBBuild.pas =================================================================== --- trunk/Source/Core/InstantDBBuild.pas 2006-02-05 16:40:22 UTC (rev 583) +++ trunk/Source/Core/InstantDBBuild.pas 2006-02-13 07:09:19 UTC (rev 584) @@ -58,6 +58,7 @@ private FConnector: TInstantConnector; FCommandSequence: TInstantDBBuildCommandSequence; + FOnWarning: TInstantWarningEvent; function GetAfterCommandExecute: TInstantDBBuildCommandNotifyEvent; function GetAfterCommandSequenceExecute: TNotifyEvent; function GetBeforeCommandExecute: TInstantDBBuildCommandNotifyEvent; @@ -71,6 +72,7 @@ function GetCommandExecuteError: TInstantDBBuildCommandErrorEvent; procedure SetCommandExecuteError( const Value: TInstantDBBuildCommandErrorEvent); + procedure DoWarning(const WarningText: string); protected function GetConnector: TInstantConnector; virtual; procedure InternalBuildCommandSequence; virtual; abstract; @@ -95,6 +97,8 @@ // data definition, not a very commonly available feature). property OnCommandExecuteError: TInstantDBBuildCommandErrorEvent read GetCommandExecuteError write SetCommandExecuteError; + procedure SourceSchemeWarningHandler(const Sender: TObject; + const AWarningText: string); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; @@ -112,6 +116,7 @@ // Reference to a Connector that points to the target database for // evolution. Default is InstantDefaultConnector. property Connector: TInstantConnector read GetConnector write SetConnector; + property OnWarning: TInstantWarningEvent read FOnWarning write FOnWarning; end; // Base class for database builders and evolvers. Abstract. @@ -483,6 +488,18 @@ end; end; +procedure TInstantCustomDBBuilder.SourceSchemeWarningHandler( + const Sender: TObject; const AWarningText: string); +begin + DoWarning(AWarningText); +end; + +procedure TInstantCustomDBBuilder.DoWarning(const WarningText: string); +begin + if Assigned(FOnWarning) then + FOnWarning(Self, WarningText); +end; + { TInstantCustomDBEvolver } function TInstantCustomDBEvolver.GetTargetModel: TInstantModel; @@ -636,7 +653,7 @@ procedure TInstantDBBuilder.InternalBuildCommandSequence; begin CommandSequence.Clear; - CommandSequence.SourceScheme := Connector.Broker.ReadDatabaseScheme; + CommandSequence.SourceScheme := Connector.Broker.ReadDatabaseScheme(SourceSchemeWarningHandler); CommandSequence.TargetScheme := Connector.CreateScheme(TargetModel); GenerateCommandSequence(CommandSequence); end; Modified: trunk/Source/Core/InstantDBEvolution.pas =================================================================== --- trunk/Source/Core/InstantDBEvolution.pas 2006-02-05 16:40:22 UTC (rev 583) +++ trunk/Source/Core/InstantDBEvolution.pas 2006-02-13 07:09:19 UTC (rev 584) @@ -64,7 +64,7 @@ procedure TInstantDBEvolver.InternalBuildCommandSequence; begin CommandSequence.Clear; - CommandSequence.SourceScheme := Connector.Broker.ReadDatabaseScheme; + CommandSequence.SourceScheme := Connector.Broker.ReadDatabaseScheme(SourceSchemeWarningHandler); CommandSequence.TargetScheme := Connector.CreateScheme(TargetModel); GenerateSchemeDiff(CommandSequence); end; Modified: trunk/Source/Core/InstantPersistence.pas =================================================================== --- trunk/Source/Core/InstantPersistence.pas 2006-02-05 16:40:22 UTC (rev 583) +++ trunk/Source/Core/InstantPersistence.pas 2006-02-13 07:09:19 UTC (rev 584) @@ -53,6 +53,9 @@ Classes, Contnrs, SysUtils, DB, InstantClasses, InstantCommand, InstantConsts; type + TInstantWarningEvent = procedure (const Sender: TObject; + const AWarningText: string) of object; + TInstantMetadatas = class; TInstantMetadata = class(TInstantCollectionItem) @@ -407,8 +410,10 @@ TInstantCatalog = class private FScheme: TInstantScheme; + FOnWarning: TInstantWarningEvent; protected function GetFeatures: TInstantCatalogFeatures; virtual; + procedure DoWarning(const WarningText: string); public // Creates an instance and binds it to the specified TInstantScheme object. constructor Create(const AScheme: TInstantScheme); @@ -423,6 +428,10 @@ // says that the catalog support everything; derived classes might not // support all features. property Features: TInstantCatalogFeatures read GetFeatures; + // Triggered when the catalog has something to report about its activity, + // typically during InitTableMetadatas, which is not a fatal error. + property OnWarning: TInstantWarningEvent + read FOnWarning write FOnWarning; end; // A TInstantCatalog that gathers its info from a TInstantModel. @@ -444,6 +453,7 @@ TInstantScheme = class(TInstantStreamable) private + FOnWarning: TInstantWarningEvent; FCatalog: TInstantCatalog; FTableMetadataCollection: TInstantTableMetadatas; FBlobStreamFormat: TInstantStreamFormat; @@ -453,7 +463,10 @@ function GetTableMetadatas(Index: Integer): TInstantTableMetadata; function GetTableMetadataCount: Integer; procedure SetCatalog(const Value: TInstantCatalog); + procedure CatalogWarningEventHandler(const Sender: TObject; + const AWarningText: string); protected + procedure DoWarning(const AWarningText: string); function AttributeTypeToDataType( AttributeType: TInstantAttributeType): TInstantDataType; virtual; property TableMetadataCollection: TInstantTableMetadatas read GetTableMetadataCollection; @@ -467,6 +480,9 @@ property BlobStreamFormat: TInstantStreamFormat read FBlobStreamFormat write FBlobStreamFormat default sfBinary; property IdDataType: TInstantDataType read FIdDataType write FIdDataType default dtString; property IdSize: Integer read FIdSize write FIdSize default InstantDefaultFieldSize; + // Triggered when the scheme has something to report about its activity, + // typically during database building/evolution, which is not a fatal error. + property OnWarning: TInstantWarningEvent read FOnWarning write FOnWarning; end; TInstantAttributeMap = class(TInstantNamedList) @@ -1737,8 +1753,9 @@ // database scheme (which may differ from the model-derived scheme). // If the broker doesn't have a catalog, calling this method will raise // an exception. Call IsCatalogSupported if you need to know in advance - // whether you can safely call ReadDatabaseSchema or not. - function ReadDatabaseScheme: TInstantScheme; virtual; + // whether you can safely call ReadDatabaseScheme or not. + function ReadDatabaseScheme( + const AWarningEventHandler: TInstantWarningEvent): TInstantScheme; virtual; // Returns True if the broker supports creating a valid catalog. If this // method returns False, it means that calling CreateCatalog will yield nil, // and calling ReadDatabaseSchema will raise an exception. @@ -4107,6 +4124,12 @@ Result := InstantAttributeTypeToDataType(AttributeType, BlobStreamFormat); end; +procedure TInstantScheme.CatalogWarningEventHandler(const Sender: TObject; + const AWarningText: string); +begin + DoWarning(AWarningText); +end; + constructor TInstantScheme.Create; begin inherited Create; @@ -4122,6 +4145,12 @@ inherited; end; +procedure TInstantScheme.DoWarning(const AWarningText: string); +begin + if Assigned(FOnWarning) then + FOnWarning(Self, AWarningText); +end; + function TInstantScheme.FindTableMetadata( const AName: string): TInstantTableMetadata; begin @@ -4151,7 +4180,10 @@ FreeAndNil(FCatalog); FCatalog := Value; if Assigned(FCatalog) then + begin + FCatalog.OnWarning := CatalogWarningEventHandler; FCatalog.InitTableMetadatas(TableMetadataCollection); + end; end; { TInstantAttributeMap } @@ -10219,10 +10251,12 @@ Result := TInstantQuery.Create(Connector); end; -function TInstantBroker.ReadDatabaseScheme: TInstantScheme; +function TInstantBroker.ReadDatabaseScheme( + const AWarningEventHandler: TInstantWarningEvent): TInstantScheme; begin Result := TInstantScheme.Create; try + Result.OnWarning := AWarningEventHandler; Result.Catalog := CreateCatalog(Result); if Result.Catalog = nil then raise Exception.CreateFmt(SUndefinedCatalog, [ClassName]); @@ -15500,6 +15534,12 @@ FScheme := AScheme; end; +procedure TInstantCatalog.DoWarning(const WarningText: string); +begin + if Assigned(FOnWarning) then + FOnWarning(Self, WarningText); +end; + function TInstantCatalog.GetFeatures: TInstantCatalogFeatures; begin Result := [cfReadTableInfo, cfReadColumnInfo, cfReadIndexInfo]; |
