Menu
▾
▴
[Instantobjects-cvscommit] SF.net SVN: instantobjects: [761] trunk/Source/Core/InstantBrokers.pas
|
From: <jcm...@us...> - 2007-02-24 19:37:20
|
Revision: 761
http://svn.sourceforge.net/instantobjects/revision/?rev=761&view=rev
Author: jcmoraisjr
Date: 2007-02-24 11:37:18 -0800 (Sat, 24 Feb 2007)
Log Message:
-----------
Included svn eol-style and mime-type properties.
Modified Paths:
--------------
trunk/Source/Core/InstantBrokers.pas
Property Changed:
----------------
trunk/Source/Core/InstantBrokers.pas
Modified: trunk/Source/Core/InstantBrokers.pas
===================================================================
--- trunk/Source/Core/InstantBrokers.pas 2007-02-24 19:35:00 UTC (rev 760)
+++ trunk/Source/Core/InstantBrokers.pas 2007-02-24 19:37:18 UTC (rev 761)
@@ -1,6067 +1,6067 @@
-(*
- * InstantObjects
- * Broker and Connector Classes
- *)
-
-(* ***** BEGIN LICENSE BLOCK *****
- * Version: MPL 1.1
- *
- * The contents of this file are subject to the Mozilla Public License Version
- * 1.1 (the "License"); you may not use this file except in compliance with
- * the License. You may obtain a copy of the License at
- * http://www.mozilla.org/MPL/
- *
- * 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 Original Code is: Seleqt InstantObjects
- *
- * The Initial Developer of the Original Code is: Seleqt
- *
- * Portions created by the Initial Developer are Copyright (C) 2001-2003
- * the Initial Developer. All Rights Reserved.
- *
- * Contributor(s):
- * Carlo Barazzetta, Andrea Petrelli, Nando Dessena, Steven Mitchell,
- * Joao Morais, Cesar Coll, Uberto Barbini, David Taylor, Hanedi Salas,
- * Riceball Lee, David Moorhouse
- *
- * ***** END LICENSE BLOCK ***** *)
-
-unit InstantBrokers;
-
-{$IFDEF LINUX}
-{$I '../InstantDefines.inc'}
-{$ELSE}
-{$I '..\InstantDefines.inc'}
-{$ENDIF}
-
-interface
-
-uses
- SysUtils, Classes, Db, InstantPersistence, InstantTypes, InstantMetadata,
- InstantConsts, InstantClasses, Contnrs, InstantCommand;
-
-type
- TInstantBrokerCatalog = class;
- TInstantConnectionBasedConnector = class;
- TInstantCustomRelationalBroker = class;
- TInstantCustomRelationalQuery = class;
- TInstantCustomRelationalQueryClass = class of TInstantCustomRelationalQuery;
- TInstantCustomResolver = class;
- TInstantLinkResolver = class;
- TInstantNavigationalBroker = class;
- TInstantNavigationalLinkResolver = class;
- TInstantNavigationalResolver = class;
- TInstantNavigationalResolverClass = class of TInstantNavigationalResolver;
- TInstantRelationalConnector = class;
- TInstantRelationalTranslator = class;
- TInstantRelationalTranslatorClass = class of TInstantRelationalTranslator;
- TInstantSQLBroker = class;
- TInstantSQLBrokerCatalog = class;
- TInstantSQLGenerator = class;
- TInstantSQLGeneratorClass = class of TInstantSQLGenerator;
- TInstantSQLLinkResolver = class;
- TInstantSQLResolver = class;
- TInstantStatementCache = class;
-
- PObjectRow = ^TObjectRow;
- TObjectRow = record
- Row: Integer;
- Instance: TObject;
- end;
-
- PInstantOperationInfo = ^TInstantOperationInfo;
- TInstantOperationInfo = record
- Success: Boolean;
- Conflict: Boolean;
- end;
-
- TInstantBrokerOperation = procedure(AObject: TInstantObject;
- const AObjectId: string; Map: TInstantAttributeMap;
- ConflictAction: TInstantConflictAction = caFail;
- Info: PInstantOperationInfo = nil) of object;
- TInstantGetDataSetEvent = procedure(Sender: TObject;
- const CommandText: string; var DataSet: TDataset) of object;
- TInstantInitDataSetEvent = procedure(Sender: TObject;
- const CommandText: string; DataSet: TDataSet) of object;
- TInstantNavigationalResolverOperation = procedure(AObject: TInstantObject;
- AttributeMetadata: TInstantAttributeMetadata) of object;
-
-
- TInstantCustomRelationalBroker = class(TInstantBroker)
- private
- FStatementCache: TInstantStatementCache;
- FStatementCacheCapacity: Integer;
- procedure DisposeMap(AObject: TInstantObject; const AObjectId: string;
- Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction;
- Info: PInstantOperationInfo);
- function GetConnector: TInstantRelationalConnector;
- function PerformOperation(AObject: TInstantObject; const AObjectId: string;
- OperationType: TInstantOperationType; Operation: TInstantBrokerOperation;
- ConflictAction: TInstantConflictAction): Boolean;
- procedure RetrieveMap(AObject: TInstantObject; const AObjectId: string;
- Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction;
- Info: PInstantOperationInfo);
- procedure StoreMap(AObject: TInstantObject; const AObjectId: string;
- Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction;
- Info: PInstantOperationInfo);
- function GetStatementCache: TInstantStatementCache;
- procedure SetStatementCacheCapacity(const Value: Integer);
- protected
- property StatementCache: TInstantStatementCache read GetStatementCache;
- function EnsureResolver(Map: TInstantAttributeMap): TInstantCustomResolver;
- virtual; abstract;
- function GetDBMSName: string; virtual;
- function GetSQLDelimiters: string; virtual;
- function GetSQLQuote: Char; virtual;
- function GetSQLWildcard: string; virtual;
- function InternalDisposeObject(AObject: TInstantObject;
- ConflictAction: TInstantConflictAction): Boolean; override;
- function InternalRetrieveObject(AObject: TInstantObject;
- const AObjectId: string; ConflictAction: TInstantConflictAction): Boolean;
- override;
- function InternalStoreObject(AObject: TInstantObject;
- ConflictAction: TInstantConflictAction): Boolean; override;
- public
- constructor Create(AConnector: TInstantConnector); override;
- destructor Destroy; override;
- function Execute(const AStatement: string; AParams: TParams = nil): Integer;
- virtual;
- property Connector: TInstantRelationalConnector read GetConnector;
- property DBMSName: string read GetDBMSName;
- property SQLDelimiters: string read GetSQLDelimiters;
- property SQLQuote: Char read GetSQLQuote;
- property SQLWildcard: string read GetSQLWildCard;
- property StatementCacheCapacity: Integer read FStatementCacheCapacity
- write SetStatementCacheCapacity;
- end;
-
- TInstantNavigationalBroker = class(TInstantCustomRelationalBroker)
- private
- FResolverList: TObjectList;
- function GetResolverCount: Integer;
- function GetResolverList: TObjectList;
- function GetResolvers(Index: Integer): TInstantnavigationalResolver;
- property ResolverList: TObjectList read GetResolverList;
- protected
- function CreateResolver(const TableName: string):
- TInstantNavigationalResolver; virtual; abstract;
- function EnsureResolver(Map: TInstantAttributeMap): TInstantCustomResolver;
- override;
- function FindResolver(const TableName: string):
- TInstantNavigationalResolver;
- property ResolverCount: Integer read GetResolverCount;
- property Resolvers[Index: Integer]: TInstantNavigationalResolver
- read GetResolvers;
- public
- destructor Destroy; override;
- end;
-
- //Backwards compatibility
- TInstantRelationalBroker = TInstantNavigationalBroker;
-
- TInstantSQLBroker = class(TInstantCustomRelationalBroker)
- private
- FGenerator: TInstantSQLGenerator;
- FResolverList: TObjectList;
- function GetResolverList: TObjectList;
- function GetResolverCount: Integer;
- function GetResolvers(Index: Integer): TInstantSQLResolver;
- function GetGenerator: TInstantSQLGenerator;
- protected
- function CreateResolver(Map: TInstantAttributeMap): TInstantSQLResolver;
- virtual; abstract;
- function EnsureResolver(AMap: TInstantAttributeMap): TInstantCustomResolver;
- override;
- procedure InternalBuildDatabase(Scheme: TInstantScheme); override;
- property ResolverList: TObjectList read GetResolverList;
- procedure AssignDataSetParams(DataSet : TDataSet; AParams: TParams);
- virtual;
- function CreateDataSet(const AStatement: string; AParams: TParams = nil):
- TDataSet; virtual; abstract;
- public
- destructor Destroy; override;
- function AcquireDataSet(const AStatement: string; AParams: TParams = nil):
- TDataSet; virtual;
- procedure ReleaseDataSet(const ADataSet: TDataSet); virtual;
- function DataTypeToColumnType(DataType: TInstantDataType;
- Size: Integer): string; virtual; abstract;
- function FindResolver(AMap: TInstantAttributeMap): TInstantSQLResolver;
- class function GeneratorClass: TInstantSQLGeneratorClass; virtual;
- property Generator: TInstantSQLGenerator read GetGenerator;
- property ResolverCount: Integer read GetResolverCount;
- property Resolvers[Index: Integer]: TInstantSQLResolver read GetResolvers;
- end;
-
- TInstantRelationalConnector = class(TInstantConnector)
- private
- FOnGetDataSet: TInstantGetDataSetEvent;
- FOnInitDataSet: TInstantInitDataSetEvent;
- protected
- procedure DoGetDataSet(const CommandText: string; var DataSet: TDataSet);
- procedure DoInitDataSet(const CommandText: string; DataSet: TDataSet);
- function GetBroker: TInstantCustomRelationalBroker;
- procedure GetDataSet(const CommandText: string; var DataSet: TDataSet);
- virtual;
- function GetDBMSName: string; virtual;
- procedure InitDataSet(const CommandText: string; DataSet: TDataSet);
- virtual;
- function InternalCreateScheme(Model: TInstantModel): TInstantScheme;
- override;
- public
- property Broker: TInstantCustomRelationalBroker read GetBroker;
- property DBMSName: string read GetDBMSName;
- published
- property OnGetDataSet: TInstantGetDataSetEvent read FOnGetDataSet
- write FOnGetDataSet;
- property OnInitDataSet: TInstantInitDataSetEvent read FOnInitDataSet
- write FOnInitDataSet;
- end;
-
- TInstantConnectionBasedConnector = class(TInstantRelationalConnector)
- private
- FConnection: TCustomConnection;
- FLoginPrompt: Boolean;
- procedure DoAfterConnectionChange;
- procedure DoBeforeConnectionChange;
- function GetConnection: TCustomConnection;
- function GetLoginPrompt: Boolean;
- procedure SetConnection(Value: TCustomConnection);
- procedure SetLoginPrompt(const Value: Boolean);
- protected
- procedure AssignLoginOptions; virtual;
- procedure AfterConnectionChange; virtual;
- procedure BeforeConnectionChange; virtual;
- procedure CheckConnection;
- function GetConnected: Boolean; override;
- procedure InternalConnect; override;
- procedure InternalDisconnect; override;
- procedure Notification(AComponent: TComponent; Operation: TOperation);
- override;
- public
- property Connection: TCustomConnection read GetConnection
- write SetConnection;
- function HasConnection: Boolean;
- constructor Create(AOwner: TComponent); override;
- published
- property LoginPrompt: Boolean read GetLoginPrompt write SetLoginPrompt
- default True;
- end;
-
- TInstantCustomResolver = class(TInstantStreamable)
- private
- FBroker: TInstantCustomRelationalBroker;
- protected
- function KeyViolation(AObject: TInstantObject; const AObjectId: string;
- E: Exception): EInstantKeyViolation;
- procedure InternalDisposeMap(AObject: TInstantObject;
- Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction;
- Info: PInstantOperationInfo); virtual;
- procedure InternalRetrieveMap(AObject: TInstantObject;
- const AObjectId: string; Map: TInstantAttributeMap;
- ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo);
- virtual;
- procedure InternalStoreMap(AObject: TInstantObject;
- Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction;
- Info: PInstantOperationInfo); virtual;
- public
- constructor Create(ABroker: TInstantCustomRelationalBroker);
- procedure DisposeMap(AObject: TInstantObject; Map: TInstantAttributeMap;
- ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo);
- procedure DisposeObject(AObject: TInstantObject; Conflict:
- TInstantConflictAction);
- procedure RetrieveMap(AObject: TInstantObject; const AObjectId: string;
- Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction;
- Info: PInstantOperationInfo);
- procedure StoreMap(AObject: TInstantObject; Map: TInstantAttributeMap;
- ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo);
- procedure StoreObject(AObject: TInstantObject; Conflict:
- TInstantConflictAction);
- property Broker: TInstantCustomRelationalBroker read FBroker;
- end;
-
- TInstantNavigationalResolver = class(TInstantCustomResolver)
- private
- FDataSet: TDataSet;
- FFreeDataSet: Boolean;
- FNavigationalLinkResolvers: TObjectList;
- FTableName: string;
- function CheckConflict(AObject: TInstantObject; const AObjectId: string;
- ConflictAction: TInstantConflictAction): Boolean;
- procedure ClearAttribute(AObject: TInstantObject;
- AttributeMetadata: TInstantAttributeMetadata);
- function FieldByName(const FieldName: string): TField;
- procedure FreeDataSet;
- function GetBroker: TInstantNavigationalBroker;
- function GetDataSet: TDataSet;
- function GetNavigationalLinkResolvers: TObjectList;
- function GetObjectClassName: string;
- function GetObjectId: string;
- procedure PerformOperation(AObject: TInstantObject;
- Map: TInstantAttributeMap; Operation:
- TInstantNavigationalResolverOperation);
- procedure ReadAttribute(AObject: TInstantObject;
- AttributeMetadata: TInstantAttributeMetadata);
- procedure ResetAttribute(AObject: TInstantObject;
- AttributeMetadata: TInstantAttributeMetadata);
- procedure SetDataSet(Value: TDataset);
- procedure WriteAttribute(AObject: TInstantObject;
- AttributeMetadata: TInstantAttributeMetadata);
- protected
- procedure Append; virtual;
- procedure Cancel; virtual;
- procedure ClearBlob(Attribute: TInstantBlob); virtual;
- procedure ClearBoolean(Attribute: TInstantBoolean); virtual;
- procedure ClearDateTime(Attribute: TInstantDateTime); virtual;
- procedure ClearDate(Attribute: TInstantDate); virtual;
- procedure ClearTime(Attribute: TInstantTime); virtual;
- procedure ClearInteger(Attribute: TInstantInteger); virtual;
- procedure ClearFloat(Attribute: TInstantFloat); virtual;
- procedure ClearCurrency(Attribute: TInstantCurrency); virtual;
- procedure ClearMemo(Attribute: TInstantMemo); virtual;
- procedure ClearPart(Attribute: TInstantPart); virtual;
- procedure ClearParts(Attribute: TInstantParts); virtual;
- procedure ClearReference(Attribute: TInstantReference); virtual;
- procedure ClearReferences(Attribute: TInstantReferences); virtual;
- procedure ClearString(Attribute: TInstantString); virtual;
- procedure Close; virtual;
- function CreateDataSet: TDataSet; virtual; abstract;
- function CreateNavigationalLinkResolver(const ATableName: string):
- TInstantNavigationalLinkResolver; virtual; abstract;
- function CreateLocateVarArray(const AObjectClassName, AObjectId: string):
- Variant;
- procedure Delete; virtual;
- procedure Edit; virtual;
- function GetLinkDatasetResolver(const ATableName: string):
- TInstantNavigationalLinkResolver;
- function FieldHasObjects(Field: TField): Boolean; virtual;
- function FindLinkDatasetResolver(const ATableName: string):
- TInstantNavigationalLinkResolver;
- procedure InternalDisposeMap(AObject: TInstantObject;
- Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction;
- Info: PInstantOperationInfo); override;
- procedure InternalRetrieveMap(AObject: TInstantObject;
- const AObjectId: string; Map: TInstantAttributeMap;
- ConflictAction: TInstantConflictAction;
- Info: PInstantOperationInfo); override;
- procedure InternalStoreMap(AObject: TInstantObject;
- Map: TInstantAttributeMap;
- ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo);
- override;
- function Locate(const AObjectClassName, AObjectId: string): Boolean;
- virtual; abstract;
- procedure Open; virtual;
- procedure Post; virtual;
- procedure ReadBlob(Attribute: TInstantBlob); virtual;
- procedure ReadBoolean(Attribute: TInstantBoolean); virtual;
- procedure ReadDateTime(Attribute: TInstantDateTime); virtual;
- procedure ReadDate(Attribute: TInstantDate); virtual;
- procedure ReadTime(Attribute: TInstantTime); virtual;
- procedure ReadInteger(Attribute: TInstantInteger); virtual;
- procedure ReadFloat(Attribute: TInstantFloat); virtual;
- procedure ReadCurrency(Attribute: TInstantCurrency); virtual;
- procedure ReadMemo(Attribute: TInstantMemo); virtual;
- procedure ReadPart(Attribute: TInstantPart); virtual;
- procedure ReadParts(Attribute: TInstantParts); virtual;
- procedure ReadReference(Attribute: TInstantReference); virtual;
- procedure ReadReferences(Attribute: TInstantReferences); virtual;
- procedure ReadString(Attribute: TInstantString); virtual;
- procedure ResetAttributes(AObject: TInstantObject;
- Map: TInstantAttributeMap);
- procedure SetObjectUpdateCount(AObject: TInstantObject; Value: Integer);
- function TranslateError(AObject: TInstantObject; E: Exception): Exception;
- virtual;
- procedure WriteBlob(Attribute: TInstantBlob); virtual;
- procedure WriteBoolean(Attribute: TInstantBoolean); virtual;
- procedure WriteDateTime(Attribute: TInstantDateTime); virtual;
- procedure WriteDate(Attribute: TInstantDate); virtual;
- procedure WriteTime(Attribute: TInstantTime); virtual;
- procedure WriteFloat(Attribute: TInstantFloat); virtual;
- procedure WriteCurrency(Attribute: TInstantCurrency); virtual;
- procedure WriteInteger(Attribute: TInstantInteger); virtual;
- procedure WriteMemo(Attribute: TInstantMemo); virtual;
- procedure WritePart(Attribute: TInstantPart); virtual;
- procedure WriteParts(Attribute: TInstantParts); virtual;
- procedure WriteReference(Attribute: TInstantReference); virtual;
- procedure WriteReferences(Attribute: TInstantReferences); virtual;
- procedure WriteString(Attribute: TInstantString); virtual;
- property DataSet: TDataset read GetDataSet write SetDataSet;
- property NavigationalLinkResolvers: TObjectList read
- GetNavigationalLinkResolvers;
- public
- constructor Create(ABroker: TInstantNavigationalBroker;
- const ATableName: string);
- destructor Destroy; override;
- property Broker: TInstantNavigationalBroker read GetBroker;
- property ObjectClassName: string read GetObjectClassName;
- property ObjectId: string read GetObjectId;
- property TableName: string read FTableName;
- end;
-
- //Backwards compatibility
- TInstantResolver = TInstantNavigationalResolver;
-
- TInstantSQLResolver = class(TInstantCustomResolver)
- private
- FMap: TInstantAttributeMap;
- FDeleteSQL: string;
- FDeleteConcurrentSQL: string;
- FInsertSQL: string;
- FSelectSQL: string;
- FUpdateSQL: string;
- FUpdateConcurrentSQL: string;
- FSelectExternalSQL: string;
- FSelectExternalPartSQL: string;
- FDeleteExternalSQL: string;
- FInsertExternalSQL: string;
- procedure AddIntegerParam(Params: TParams; const ParamName: string;
- Value: Integer);
- procedure AddStringParam(Params: TParams; const ParamName, Value: string);
- // Adds an "Id" param, whose data type and size depends on connector
- // settings.
- procedure AddIdParam(Params: TParams; const ParamName, Value: string);
- procedure CheckConflict(Info: PInstantOperationInfo;
- AObject: TInstantObject);
- function ExecuteStatement(const AStatement: string; AParams: TParams;
- Info: PInstantOperationInfo; ConflictAction: TInstantConflictAction;
- AObject: TInstantObject): Integer;
- function GetDeleteConcurrentSQL: string;
- function GetDeleteSQL: string;
- function GetInsertSQL: string;
- function GetSelectSQL: string;
- function GetUpdateConcurrentSQL: string;
- function GetUpdateSQL: string;
- function GetBroker: TInstantSQLBroker;
- function GetSelectExternalSQL: string;
- function GetSelectExternalPartSQL: string;
- function GetDeleteExternalSQL: string;
- function GetInsertExternalSQL: string;
- protected
- procedure AddAttributeParam(Attribute: TInstantAttribute;
- Params: TParams); virtual;
- procedure AddAttributeParams(Params: TParams; AObject: TInstantObject;
- Map: TInstantAttributeMap);
- procedure AddBaseParams(Params: TParams; AClassName, AObjectId: string;
- AUpdateCount: Integer = -1);
- procedure AddConcurrencyParam(Params: TParams; AUpdateCount: Integer);
- function AddParam(Params: TParams; const ParamName: string;
- ADataType: TFieldType): TParam;
- procedure AddPersistentIdParam(Params: TParams; APersistentId: string);
- procedure InternalDisposeMap(AObject: TInstantObject;
- Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction;
- Info: PInstantOperationInfo); override;
- procedure InternalRetrieveMap(AObject: TInstantObject;
- const AObjectId: string; Map: TInstantAttributeMap;
- ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo);
- override;
- procedure InternalStoreMap(AObject: TInstantObject;
- Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction;
- Info: PInstantOperationInfo); override;
- procedure ReadAttribute(AObject: TInstantObject; const AObjectId: string;
- AttributeMetadata: TInstantAttributeMetadata; DataSet: TDataSet); virtual;
- procedure ReadAttributes(AObject: TInstantObject; const AObjectId: string;
- Map: TInstantAttributeMap; DataSet: TDataSet);
- function ReadBlobField(DataSet: TDataSet; const FieldName: string): string;
- virtual;
- function ReadBooleanField(DataSet: TDataSet; const FieldName: string):
- Boolean; virtual;
- function ReadDateTimeField(DataSet: TDataSet; const FieldName: string):
- TDateTime; virtual;
- function ReadDateField(DataSet: TDataSet; const FieldName: string):
- TDateTime; virtual;
- function ReadTimeField(DataSet: TDataSet; const FieldName: string):
- TDateTime; virtual;
- function ReadFloatField(DataSet: TDataSet; const FieldName: string): Double;
- virtual;
- function ReadCurrencyField(DataSet: TDataSet; const FieldName: string):
- Currency; virtual;
- function ReadIntegerField(DataSet: TDataSet; const FieldName: string):
- Integer; virtual;
- function ReadMemoField(DataSet: TDataSet; const FieldName: string): string;
- virtual;
- function ReadStringField(DataSet: TDataSet; const FieldName: string):
- string; virtual;
- procedure RemoveConcurrencyParam(Params: TParams);
- procedure RemovePersistentIdParam(Params: TParams);
- function TranslateError(AObject: TInstantObject;
- E: Exception): Exception; virtual;
- public
- constructor Create(ABroker: TInstantSQLBroker; AMap: TInstantAttributeMap);
- property Broker: TInstantSQLBroker read GetBroker;
- property DeleteConcurrentSQL: string read GetDeleteConcurrentSQL write FDeleteConcurrentSQL;
- property DeleteSQL: string read GetDeleteSQL write FDeleteSQL;
- property DeleteExternalSQL: string read GetDeleteExternalSQL write FDeleteExternalSQL;
- property InsertSQL: string read GetInsertSQL write FInsertSQL;
- property InsertExternalSQL: string read GetInsertExternalSQL
- write FInsertExternalSQL;
- property Map: TInstantAttributeMap read FMap;
- property SelectSQL: string read GetSelectSQL write FSelectSQL;
- property SelectExternalSQL: string read GetSelectExternalSQL
- write FSelectExternalSQL;
- property SelectExternalPartSQL: string read GetSelectExternalPartSQL
- write FSelectExternalPartSQL;
- property UpdateConcurrentSQL: string read GetUpdateConcurrentSQL
- write FUpdateConcurrentSQL;
- property UpdateSQL: string read GetUpdateSQL write FUpdateSQL;
- end;
-
- // TInstantLinkResolver class defines common interface for handling
- // access to container attributes with external storage
- TInstantLinkResolver = class(TInstantStreamable)
- private
- FResolver: TInstantCustomResolver;
- function GetBroker: TInstantCustomRelationalBroker;
- function GetResolver: TInstantCustomResolver;
- protected
- procedure InternalStoreAttributeObjects(Attribute: TInstantContainer);
- virtual;
- procedure InternalClearAttributeLinkRecords; virtual;
- procedure InternalDisposeDeletedAttributeObjects(
- Attribute: TInstantContainer); virtual;
- procedure InternalReadAttributeObjects(Attribute: TInstantContainer;
- const AObjectId: string); virtual;
- public
- constructor Create(AResolver: TInstantCustomResolver);
- procedure StoreAttributeObjects(Attribute: TInstantContainer);
- procedure ClearAttributeLinkRecords;
- procedure DisposeDeletedAttributeObjects(Attribute: TInstantContainer);
- procedure ReadAttributeObjects(Attribute: TInstantContainer;
- const AObjectId: string);
- property Broker: TInstantCustomRelationalBroker read GetBroker;
- property Resolver: TInstantCustomResolver read GetResolver;
- end;
-
- // TInstantNavigationalLinkResolver is an abstract class that
- // defines the interface for handling access to container attributes
- // with external storage for navigational brokers.
- // Each navigational broker needs to provide a concrete class descendent.
- // See the BDE broker as an example.
- TInstantNavigationalLinkResolver = class(TInstantLinkResolver)
- private
- FDataSet: TDataSet;
- FFreeDataSet: Boolean;
- FTableName: string;
- function FieldByName(const FieldName: string): TField;
- procedure FreeDataSet;
- function GetBroker: TInstantNavigationalBroker;
- function GetDataSet: TDataSet;
- function GetResolver: TInstantNavigationalResolver;
- procedure SetDataSet(Value: TDataset);
- protected
- procedure Append; virtual;
- procedure Cancel; virtual;
- procedure Close; virtual;
- function CreateDataSet: TDataSet; virtual; abstract;
- procedure Delete; virtual;
- procedure Edit; virtual;
- function Eof: Boolean; virtual;
- procedure First; virtual;
- procedure InternalStoreAttributeObjects(Attribute: TInstantContainer); override;
- procedure InternalClearAttributeLinkRecords; override;
- procedure InternalDisposeDeletedAttributeObjects(
- Attribute: TInstantContainer); override;
- procedure InternalReadAttributeObjects(Attribute: TInstantContainer;
- const AObjectId: string); override;
- procedure Next; virtual;
- procedure Open; virtual;
- procedure Post; virtual;
- procedure SetDatasetParentRange(const AParentClass, AParentId: string);
- virtual; abstract;
- property DataSet: TDataset read GetDataSet write SetDataSet;
- public
- constructor Create(AResolver: TInstantNavigationalResolver;
- const ATableName: string);
- destructor Destroy; override;
- property Broker: TInstantNavigationalBroker read GetBroker;
- property Resolver: TInstantNavigationalResolver read GetResolver;
- property TableName: string read FTableName;
- end;
-
- // TInstantSQLLinkResolver class defines interface for handling
- // access to container attributes with external storage for
- // SQL brokers. Due to the generic nature of SQL this class is used
- // directly and no descendant classes are needed for SQL brokers.
- TInstantSQLLinkResolver = class(TInstantLinkResolver)
- private
- FAttributeOwner: TInstantObject;
- FTableName: string;
- function GetBroker: TInstantSQLBroker;
- function GetResolver: TInstantSQLResolver;
- property TableName: string read FTableName;
- protected
- procedure InternalStoreAttributeObjects(Attribute: TInstantContainer);
- override;
- procedure InternalClearAttributeLinkRecords; override;
- procedure InternalDisposeDeletedAttributeObjects(
- Attribute: TInstantContainer); override;
- procedure InternalReadAttributeObjects(Attribute: TInstantContainer; const
- AObjectId: string); override;
- public
- constructor Create(AResolver: TInstantSQLResolver; const ATableName: string;
- AObject: TInstantObject);
- property AttributeOwner: TInstantObject read FAttributeOwner;
- property Broker: TInstantSQLBroker read GetBroker;
- property Resolver: TInstantSQLResolver read GetResolver;
- end;
-
- TInstantStatement = class
- private
- FStatementImplementation: TComponent;
- public
- constructor Create(const AStatementImplementation: TComponent);
- destructor Destroy; override;
- property StatementImplementation: TComponent read FStatementImplementation;
- end;
-
- TInstantStatementCache = class(TComponent)
- private
- FStatements: TStringList;
- FCapacity: Integer;
- procedure DeleteStatement(const Index: Integer);
- procedure DeleteAllStatements;
- procedure Shrink;
- procedure SetCapacity(const Value: Integer);
- protected
- procedure Notification(AComponent: TComponent; Operation: TOperation);
- override;
- public
- constructor Create(AOwner: TComponent); override;
- property Capacity: Integer read FCapacity write SetCapacity;
- destructor Destroy; override;
- function GetStatement(const StatementText: string): TInstantStatement;
- function AddStatement(const StatementText: string;
- const StatementImplementation: TComponent): Integer;
- function RemoveStatement(const StatementText: string): Boolean;
- end;
-
- // A TInstantCatalog that gathers its info from an existing database (through
- // a TInstantBroker). The broker knows how to read the metadata information
- // depending on which particular database is used as back-end. This is an
- // abstract class. A concrete derived class for each supported back-end
- // must be developed.
- TInstantBrokerCatalog = class(TInstantCatalog)
- private
- FBroker: TInstantBroker;
- function GetBroker: TInstantBroker;
- public
- // Creates an instance and binds it to the specified TInstantScheme object.
- // ABroker is written to the Broker property.
- constructor Create(const AScheme: TInstantScheme;
- const ABroker: TInstantBroker); virtual;
- // A reference to the broker through which the metadata info is read.
- property Broker: TInstantBroker read GetBroker;
- end;
-
- // A TInstantBrokerCatalog that works with a SQL broker only.
- TInstantSQLBrokerCatalog = class(TInstantBrokerCatalog)
- private
- function GetBroker: TInstantSQLBroker;
- public
- property Broker: TInstantSQLBroker read GetBroker;
- end;
-
- TInstantSQLGenerator = class(TObject)
- private
- FBroker: TInstantSQLBroker;
- protected
- function BuildList(Map: TInstantAttributeMap; Additional: array of string;
- StringFunc: TInstantStringFunc = nil; const Delimiter: string = ','):
- string;
- function BuildAssignment(const AName: string): string;
- function BuildAssignmentList(Map: TInstantAttributeMap;
- Additional: array of string): string;
- function BuildConcurrencyCriteria: string;
- function BuildPersistentIdCriteria: string;
- function BuildFieldList(Map: TInstantAttributeMap;
- Additional: array of string): string; overload;
- function BuildFieldList(const S: string): string; overload;
- function BuildParam(const AName: string): string; virtual;
- function BuildParamList(Map: TInstantAttributeMap;
- Additional: array of string): string;
- function BuildWhereStr(Fields: array of string): string;
- function EmbraceField(const FieldName: string): string; virtual;
- function EmbraceTable(const TableName: string): string; virtual;
- function GetDelimiters: string; virtual;
- function InternalGenerateAddFieldSQL(Metadata: TInstantFieldMetadata):
- string; virtual;
- function InternalGenerateAlterFieldSQL(OldMetadata,
- NewMetadata: TInstantFieldMetadata): string; virtual;
- function InternalGenerateCreateIndexSQL(Metadata: TInstantIndexMetadata):
- string; virtual;
- function InternalGenerateCreateTableSQL(Metadata: TInstantTableMetadata):
- string; virtual;
- function InternalGenerateDeleteConcurrentSQL(Map: TInstantAttributeMap):
- string; virtual;
- function InternalGenerateDeleteSQL(Map: TInstantAttributeMap): string;
- virtual;
- function InternalGenerateDeleteExternalSQL(Map: TInstantAttributeMap):
- string; virtual;
- function InternalGenerateDropFieldSQL(Metadata: TInstantFieldMetadata):
- string; virtual;
- function InternalGenerateDropIndexSQL(Metadata: TInstantIndexMetadata):
- string; virtual;
- function InternalGenerateDropTableSQL(Metadata: TInstantTableMetadata):
- string; virtual;
- function InternalGenerateInsertSQL(Map: TInstantAttributeMap): string;
- virtual;
- function InternalGenerateInsertExternalSQL(Map: TInstantAttributeMap):
- string; virtual;
- function InternalGenerateSelectSQL(Map: TInstantAttributeMap): string;
- virtual;
- function InternalGenerateSelectExternalSQL(Map: TInstantAttributeMap):
- string; virtual;
- function InternalGenerateSelectExternalPartSQL(Map: TInstantAttributeMap):
- string; virtual;
- function InternalGenerateSelectTablesSQL: string; virtual;
- function InternalGenerateUpdateConcurrentSQL(Map: TInstantAttributeMap):
- string; virtual;
- function InternalGenerateUpdateFieldCopySQL(OldMetadata, NewMetadata:
- TInstantFieldMetadata): string; virtual;
- function InternalGenerateUpdateSQL(Map: TInstantAttributeMap): string;
- virtual;
- property Delimiters: string read GetDelimiters;
- property Broker: TInstantSQLBroker read FBroker;
- public
- constructor Create(ABroker: TInstantSQLBroker);
- function GenerateAddFieldSQL(Metadata: TInstantFieldMetadata): string;
- function GenerateAlterFieldSQL(OldMetadata,
- NewMetadata: TInstantFieldMetadata): string;
- function GenerateCreateIndexSQL(Metadata: TInstantIndexMetadata): string;
- function GenerateCreateTableSQL(Metadata: TInstantTableMetadata): string;
- function GenerateDeleteConcurrentSQL(Map: TInstantAttributeMap): string;
- function GenerateDeleteSQL(Map: TInstantAttributeMap): string;
- function GenerateDeleteExternalSQL(Map: TInstantAttributeMap): string;
- function GenerateDropFieldSQL(Metadata: TInstantFieldMetadata): string;
- function GenerateDropIndexSQL(Metadata: TInstantIndexMetadata): string;
- function GenerateDropTableSQL(Metadata: TInstantTableMetadata): string;
- function GenerateInsertSQL(Map: TInstantAttributeMap): string;
- function GenerateInsertExternalSQL(Map: TInstantAttributeMap): string;
- function GenerateSelectSQL(Map: TInstantAttributeMap): string;
- function GenerateSelectExternalSQL(Map: TInstantAttributeMap): string;
- function GenerateSelectExternalPartSQL(Map: TInstantAttributeMap): string;
- function GenerateSelectTablesSQL: string;
- function GenerateUpdateConcurrentSQL(Map: TInstantAttributeMap): string;
- function GenerateUpdateFieldCopySQL(OldMetadata, NewMetadata:
- TInstantFieldMetadata): string;
- function GenerateUpdateSQL(Map: TInstantAttributeMap): string;
- end;
-
- TInstantCustomRelationalQuery = class(TInstantQuery)
- private
- function GetConnector: TInstantRelationalConnector;
- protected
- function GetStatement: string; virtual;
- procedure InternalGetInstantObjectRefs(List: TInstantObjectReferenceList);
- virtual;
- procedure InternalRefreshObjects; override;
- procedure SetStatement(const Value: string); virtual;
- procedure TranslateCommand; override;
- class function TranslatorClass: TInstantRelationalTranslatorClass; virtual;
- public
- function CreateTranslator: TInstantRelationalTranslator;
- property Statement: string read GetStatement write SetStatement;
- property Connector: TInstantRelationalConnector read GetConnector;
- end;
-
- TInstantQueryTranslator = class(TInstantIQLTranslator)
- private
- FQuery: TInstantQuery;
- function GetQuery: TInstantQuery;
- protected
- function CreateCommand: TInstantIQLCommand; override;
- function GetResultClassName: string; override;
- public
- constructor Create(AQuery: TInstantQuery);
- property Query: TInstantQuery read GetQuery;
- end;
-
- TInstantRelationalTranslator = class(TInstantQueryTranslator)
- private
- FCriteriaList: TStringList;
- FTablePathList: TStringList;
- procedure AddJoin(const FromPath, FromField, ToPath, ToField: string);
- function ConcatPath(const APathText, AttribName: string): string;
- procedure DestroyCriteriaList;
- procedure DestroyTablePathList;
- function ExtractTarget(const PathStr: string): string;
- function RootAttribToFieldName(const AttribName: string): string;
- function GetClassTablePath: string;
- function GetCriteriaCount: Integer;
- function GetCriteriaList: TStringList;
- function GetCriterias(Index: Integer): string;
- function GetObjectClassMetadata: TInstantClassMetadata;
- function GetQuery: TInstantCustomRelationalQuery;
- function GetTablePathAliases(Index: Integer): string;
- function GetTablePathCount: Integer;
- function GetTablePathList: TStringList;
- function GetTablePaths(Index: Integer): string;
- function PathToTablePath(const PathText: string): string;
- function PathToTarget(const PathText: string;
- out TablePath, FieldName: string): TInstantAttributeMetadata;
- function Qualify(const TablePath, FieldName: string): string;
- function QualifyPath(const PathText: string): string;
- function ReplaceWildcard(const Str: string): string;
- function TablePathToAlias(const TablePath: string): string;
- procedure WriteAnd(Writer: TInstantIQLWriter);
- function WriteCriterias(Writer: TInstantIQLWriter; IncludeWhere: Boolean):
- Boolean;
- procedure WriteTables(Writer: TInstantIQLWriter);
- property CriteriaList: TStringList read GetCriteriaList;
- property TablePathList: TStringList read GetTablePathList;
- function GetConnector: TInstantRelationalConnector;
- protected
- function AddCriteria(const Criteria: string): Integer;
- function AddTablePath(const TablePath: string): Integer;
- procedure BeforeTranslate; override;
- procedure Clear; override;
- procedure CollectObjects(AObject: TInstantIQLObject;
- AClassType: TInstantIQLObjectClass; AList: TList);
- procedure CollectPaths(AObject: TInstantIQLObject; APathList: TList);
- function GetDelimiters: string; virtual;
- function GetQuote: Char; virtual;
- function GetWildcard: string; virtual;
- function HasConnector: Boolean;
- function IncludeOrderFields: Boolean; virtual;
- function IndexOfCriteria(const Criteria: string): Integer;
- function IndexOfTablePath(const TablePath: string): Integer;
- function InternalGetObjectClassMetadata: TInstantClassMetadata; virtual;
- function IsRootAttribute(const AttributeName: string): Boolean;
- function IsPrimary(AObject: TInstantIQLObject): Boolean;
- procedure MakeJoins(Path: TInstantIQLPath);
- procedure MakeTablePaths(Path: TInstantIQLPath);
- function TranslateClassRef(ClassRef: TInstantIQLClassRef;
- Writer: TInstantIQLWriter): Boolean; virtual;
- function TranslateClause(Clause: TInstantIQLClause;
- Writer: TInstantIQLWriter): Boolean; virtual;
- function TranslateConstant(Constant: TInstantIQLConstant;
- Writer: TInstantIQLWriter): Boolean; virtual;
- function TranslateFunction(AFunction: TInstantIQLFunction;
- Writer: TInstantIQLWriter): Boolean; virtual;
- function TranslateFunctionName(const FunctionName: string;
- Writer: TInstantIQLWriter): Boolean; virtual;
- function TranslateKeyword(const Keyword: string; Writer: TInstantIQLWriter):
- Boolean; override;
- function TranslateObject(AObject: TInstantIQLObject;
- Writer: TInstantIQLWriter): Boolean; override;
- function TranslatePath(Path: TInstantIQLPath; Writer: TInstantIQLWriter):
- Boolean; virtual;
- function TranslateSpecifier(Specifier: TInstantIQLSpecifier;
- Writer: TInstantIQLWriter): Boolean; virtual;
- property ClassTablePath: string read GetClassTablePath;
- property Connector: TInstantRelationalConnector read GetConnector;
- property CriteriaCount: Integer read GetCriteriaCount;
- property Criterias[Index: Integer]: string read GetCriterias;
- property Delimiters: string read GetDelimiters;
- property ObjectClassMetadata: TInstantClassMetadata
- read GetObjectClassMetadata;
- property Quote: Char read GetQuote;
- property TablePathAliases[Index: Integer]: string read GetTablePathAliases;
- property TablePathCount: Integer read GetTablePathCount;
- property TablePaths[Index: Integer]: string read GetTablePaths;
- property Wildcard: string read GetWildcard;
- public
- destructor Destroy; override;
- function QuoteString(const Str: string): string;
- property Query: TInstantCustomRelationalQuery read GetQuery;
- end;
-
- TInstantNavigationalQuery = class(TInstantCustomRelationalQuery)
- private
- FObjectRowList: TList;
- function CreateObject(Row: Integer): TObject;
- procedure DestroyObjectRowList;
- function GetObjectRowList: TList;
- function GetObjectRowCount: Integer;
- function GetObjectRows(Index: Integer): PObjectRow;
- procedure InitObjectRows(List: TList; FromIndex, ToIndex: Integer);
- property ObjectRowList: TList read GetObjectRowList;
- protected
- function GetActive: Boolean; override;
- function GetDataSet: TDataSet; virtual;
- function GetRowCount: Integer; virtual;
- function GetRowNumber: Integer; virtual;
- function InternalAddObject(AObject: TObject): Integer; override;
- procedure InternalClose; override;
- procedure InternalGetInstantObjectRefs(List: TInstantObjectReferenceList);
- override;
- function InternalGetObjectCount: Integer; override;
- function InternalGetObjects(Index: Integer): TObject; override;
- function InternalIndexOfObject(AObject: TObject): Integer; override;
- procedure InternalInsertObject(Index: Integer; AObject: TObject); override;
- procedure InternalOpen; override;
- procedure InternalRefreshObjects; override;
- procedure InternalReleaseObject(AObject: TObject); override;
- function InternalRemoveObject(AObject: TObject): Integer; override;
- function IsSequenced: Boolean; virtual;
- function ObjectFetched(Index: Integer): Boolean; override;
- function RecNoOfObject(AObject: TInstantObject): Integer; virtual;
- procedure SetRowNumber(Value: Integer); virtual;
- property DataSet: TDataSet read GetDataSet;
- property ObjectRowCount: Integer read GetObjectRowCount;
- property ObjectRows[Index: Integer]: PObjectRow read GetObjectRows;
- public
- destructor Destroy; override;
- property RowCount: Integer read GetRowCount;
- property RowNumber: Integer read GetRowNumber write SetRowNumber;
- end;
-
- //Backwards compatibility
- TInstantRelationalQuery = TInstantNavigationalQuery;
-
- TInstantSQLQuery = class(TInstantCustomRelationalQuery)
- private
- FObjectReferenceList: TInstantObjectReferenceList;
- FParamsObject: TParams;
- FStatement: string;
- procedure DestroyObjectReferenceList;
- function GetObjectReferenceCount: Integer;
- function GetObjectReferenceList: TInstantObjectReferenceList;
- function GetParamsObject: TParams;
- procedure InitObjectReferences(DataSet: TDataSet);
- protected
- function GetActive: Boolean; override;
- function AcquireDataSet(const AStatement: string; AParams: TParams):
- TDataSet; virtual;
- procedure ReleaseDataSet(const DataSet: TDataSet);
- function GetParams: TParams; override;
- function GetStatement: string; override;
- function InternalAddObject(AObject: TObject): Integer; override;
- procedure InternalClose; override;
- procedure InternalGetInstantObjectRefs(List: TInstantObjectReferenceList);
- override;
- function InternalGetObjectCount: Integer; override;
- function InternalGetObjects(Index: Integer): TObject; override;
- function InternalIndexOfObject(AObject: TObject): Integer; override;
- procedure InternalInsertObject(Index: Integer; AObject: TObject); override;
- procedure InternalOpen; override;
- procedure InternalReleaseObject(AObject: TObject); override;
- function InternalRemoveObject(AObject: TObject): Integer; override;
- procedure SetParams(Value: TParams); override;
- function ObjectFetched(Index: Integer): Boolean; override;
- procedure SetStatement(const Value: string); override;
- property ObjectReferenceCount: Integer read GetObjectReferenceCount;
- property ObjectReferenceList: TInstantObjectReferenceList read
- GetObjectReferenceList;
- property ParamsObject: TParams read GetParamsObject;
- public
- destructor Destroy; override;
- end;
-
- TInstantRelationalConnectionDef = class(TInstantConnectionDef)
- end;
-
- TInstantConnectionBasedConnectionDef = class(TInstantRelationalConnectionDef)
- private
- FLoginPrompt: Boolean;
- protected
- function CreateConnection(AOwner: TComponent): TCustomConnection; virtual;
- abstract;
- procedure InitConnector(Connector: TInstantConnector); override;
- public
- constructor Create(Collection: TCollection); override;
- published
- property LoginPrompt: Boolean read FLoginPrompt write FLoginPrompt
- default True;
- end;
-
-var
- InstantLogProc: procedure (const AString: string) of object;
-
-implementation
-
-uses
-{$IFDEF MSWINDOWS}
- Windows,
-{$ENDIF}
-{$IFDEF LINUX}
- Types,
-{$ENDIF}
-{$IFDEF D6+}
- Variants,
- DateUtils,
-{$ENDIF}
- TypInfo, InstantUtils, InstantRtti;
-
-const
- ConcurrencyParamName = 'IO_Concur';
- PersistentIdParamName = 'IO_PersId';
-
-{$IFDEF IO_STATEMENT_LOGGING}
-procedure InstantLogStatement(const Caption, AStatement: string;
- AParams: TParams = nil);
-var
- S: string;
- g: Integer;
-begin
- S := Caption + AStatement;
- if Assigned(AParams) then
- begin
- for g := 0 to AParams.Count - 1 do begin
- S := S + sLineBreak + ' ' +
- AParams[g].Name + ': ' + GetEnumName(TypeInfo(TFieldType),
- Ord(AParams[g].DataType)) +
- ' = ' + AParams[g].AsString;
- end;
- end;
-{$IFDEF MSWINDOWS}
- OutputDebugString(PChar(S));
-{$ENDIF}
- if Assigned(InstantLogProc) then
- InstantLogProc(S);
-end;
-{$ENDIF}
-
-function CreateObjectFromDataSet(AClass: TClass; DataSet: TDataSet): TObject;
-var
- I: Integer;
- FieldName: string;
-begin
- if AClass = nil then
- raise Exception.Create(SUnassignedClass)
- else if AClass.InheritsFrom(TInstantObject) then
- Result := TInstantObjectClass(AClass).Create
- else
- Result := AClass.Create;
- for I := 0 to Pred(DataSet.FieldCount) do
- begin
- FieldName := StringReplace(
- DataSet.Fields[I].FieldName, '_', '.', [rfReplaceAll]);
- InstantSetProperty(Result, FieldName, DataSet.Fields[I].Value);
- end;
-end;
-
-{ TInstantCustomRelationalBroker }
-
-constructor TInstantCustomRelationalBroker.Create(AConnector: TInstantConnector);
-begin
- inherited;
- FStatementCacheCapacity := 0;
-end;
-
-destructor TInstantCustomRelationalBroker.Destroy;
-begin
- FreeAndNil(FStatementCache);
- inherited;
-end;
-
-procedure TInstantCustomRelationalBroker.DisposeMap(AObject: TInstantObject;
- const AObjectId: string; Map: TInstantAttributeMap;
- ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo);
-begin
- EnsureResolver(Map).DisposeMap(AObject, Map, ConflictAction, Info);
-end;
-
-function TInstantCustomRelationalBroker.Execute(const AStatement: string;
- AParams: TParams): Integer;
-begin
- Result := 0;
-end;
-
-function TInstantCustomRelationalBroker.GetConnector: TInstantRelationalConnector;
-begin
- Result := inherited Connector as TInstantRelationalConnector;
-end;
-
-function TInstantCustomRelationalBroker.GetDBMSName: string;
-begin
- Result := '';
-end;
-
-function TInstantCustomRelationalBroker.GetSQLDelimiters: string;
-begin
- Result := '';
-end;
-
-function TInstantCustomRelationalBroker.GetSQLQuote: Char;
-begin
- Result := '"';
-end;
-
-function TInstantCustomRelationalBroker.GetSQLWildcard: string;
-begin
- Result := '%';
-end;
-
-function TInstantCustomRelationalBroker.GetStatementCache: TInstantStatementCache;
-begin
- if not Assigned(FStatementCache) then
- begin
- FStatementCache := TInstantStatementCache.Create(nil);
- FStatementCache.Capacity := FStatementCacheCapacity;
- end;
- Result := FStatementCache;
-end;
-
-function TInstantCustomRelationalBroker.InternalDisposeObject(
- AObject: TInstantObject; ConflictAction: TInstantConflictAction): Boolean;
-begin
- Result := PerformOperation(AObject, AObject.Id, otDispose, DisposeMap,
- ConflictAction);
-end;
-
-function TInstantCustomRelationalBroker.InternalRetrieveObject(
- AObject: TInstantObject; const AObjectId: string;
- ConflictAction: TInstantConflictAction): Boolean;
-begin
- Result := PerformOperation(AObject, AObjectId, otRetrieve, RetrieveMap,
- ConflictAction);
-end;
-
-function TInstantCustomRelationalBroker.InternalStoreObject(
- AObject: TInstantObject; ConflictAction: TInstantConflictAction): Boolean;
-begin
- Result := PerformOperation(AObject, AObject.Id, otStore, StoreMap,
- ConflictAction);
-end;
-
-function TInstantCustomRelationalBroker.PerformOperation(
- AObject: TInstantObject; const AObjectId: string;
- OperationType: TInstantOperationType; Operation: TInstantBrokerOperation;
- ConflictAction: TInstantConflictAction): Boolean;
-
- function OperationRequired(Map: TInstantAttributeMap): Boolean;
- var
- I: Integer;
- Attrib: TInstantAttribute;
- begin
- case OperationType of
- otStore:
- begin
- Result := not AObject.IsPersistent;
- if not Result then
- for I := 0 to Pred(Map.Count) do
- begin
- Attrib := AObject.AttributeByName(Map[I].Name);
- Result := Attrib.IsMandatory or Attrib.IsChanged;
- if Result then
- Exit;
- end;
- end;
- otRetrieve, otDispose:
- Result := True;
- else
- Result := False;
- end;
- end;
-
-var
- I: Integer;
- RootMap, Map: TInstantAttributeMap;
- Info: TInstantOperationInfo;
-begin
- with Info do
- begin
- Success := False;
- Conflict := False;
- end;
- with AObject.Metadata do
- begin
- RootMap := StorageMaps.RootMap;
- Operation(AObject, AObjectId, RootMap, ConflictAction, @Info);
- Result := Info.Success;
- if Result then
- for I := 0 to Pred(StorageMaps.Count) do
- begin
- Map := StorageMaps[I];
- if (Map <> RootMap) and (Info.Conflict or OperationRequired(Map)) then
- Operation(AObject, AObjectId, Map);
- end;
- end;
-end;
-
-procedure TInstantCustomRelationalBroker.RetrieveMap(AObject: TInstantObject;
- const AObjectId: string; Map: TInstantAttributeMap;
- ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo);
-begin
- EnsureResolver(Map).RetrieveMap(AObject, AObjectId, Map, ConflictAction, Info);
-end;
-
-procedure TInstantCustomRelationalBroker.SetStatementCacheCapacity(const Value: Integer);
-begin
- FStatementCacheCapacity := Value;
- if FStatementCacheCapacity = 0 then
- FreeAndNil(FStatementCache)
- else if Assigned(FStatementCache) then
- FStatementCache.Capacity := FStatementCacheCapacity;
-end;
-
-procedure TInstantCustomRelationalBroker.StoreMap(AObject: TInstantObject;
- const AObjectId: string; Map: TInstantAttributeMap;
- ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo);
-
- // Always storing fixes #880713
- {function MustStoreMap: Boolean;
- var
- I: Integer;
- Attrib: TInstantAttribute;
- begin
- Result := Map.IsRootMap;
- if Result then
- Exit;
- for I := 0 to Pred(Map.Count) do
- begin
- Attrib := AObject.AttributeByName(Map[I].Name);
- Result := Attrib.IsMandatory or not Attrib.IsDefault;
- if Result then
- Exit;
- end;
- Result := False;
- end;}
-
-var
- Resolver: TInstantCustomResolver;
- {MustStore: Boolean;}
-begin
- {MustStore := MustStoreMap;}
- {if MustStore or AObject.IsPersistent then
- begin}
- Resolver := EnsureResolver(Map);
- {if MustStore then}
- Resolver.StoreMap(AObject, Map, ConflictAction, Info)
- {else if AObject.IsPersistent then
- Resolver.DisposeMap(AObject, Map, ConflictAction, Info);
- end;}
-end;
-
-{ TInstantNavigationalBroker }
-
-destructor TInstantNavigationalBroker.Destroy;
-begin
- FResolverList.Free;
- inherited;
-end;
-
-function TInstantNavigationalBroker.EnsureResolver(
- Map: TInstantAttributeMap): TInstantCustomResolver;
-var
- TableName: string;
-begin
- TableName := Map.Name;
- Result := FindResolver(TableName);
- if not Assigned(Result) then
- begin
- Result := CreateResolver(TableName);
- ResolverList.Add(Result);
- end;
-end;
-
-function TInstantNavigationalBroker.FindResolver(
- const TableName: string): TInstantNavigationalResolver;
-var
- I: Integer;
-begin
- for I := 0 to Pred(ResolverCount) do
- begin
- Result := Resolvers[I];
- if SameText(TableName, Result.TableName) then
- Exit;
- end;
- Result := nil;
-end;
-
-function TInstantNavigationalBroker.GetResolverCount: Integer;
-begin
- Result := ResolverList.Count;
-end;
-
-function TInstantNavigationalBroker.GetResolverList: TObjectList;
-begin
- if not Assigned(FResolverList) then
- FResolverList := TObjectList.Create;
- Result := FResolverList;
-end;
-
-function TInstantNavigationalBroker.GetResolvers(
- Index: Integer): TInstantNavigationalResolver;
-begin
- Result := ResolverList[Index] as TInstantNavigationalResolver;
-end;
-
-destructor TInstantSQLBroker.Destroy;
-begin
- FGenerator.Free;
- FResolverList.Free;
- inherited;
-end;
-
-{ TInstantSQLBroker }
-
-function TInstantSQLBroker.AcquireDataSet(const AStatement: string;
- AParams: TParams): TDataSet;
-var
- CachedStatement: TInstantStatement;
-begin
- Result := nil;
- if FStatementCacheCapacity <> 0 then
- begin
- CachedStatement := StatementCache.GetStatement(AStatement);
- if Assigned(CachedStatement) then
- begin
- Result := TDataSet(CachedStatement.StatementImplementation);
- AssignDataSetParams(Result, AParams);
- end;
- end;
- if not Assigned(Result) then
- begin
- Result := CreateDataSet(AStatement, AParams);
- try
- if Assigned(AParams) and (FStatementCacheCapacity <> 0) then
- StatementCache.AddStatement(AStatement, Result);
- except
- if FStatementCacheCapacity <> 0 then
- StatementCache.RemoveStatement(AStatement);
- Result.Free;
- raise;
- end;
- end;
-end;
-
-procedure TInstantSQLBroker.AssignDataSetParams(DataSet: TDataSet; AParams: TParams);
-begin
- raise EInstantError.CreateFmt(SMissingImplementation, ['AssignDataSetParams', ClassName]);
-end;
-
-function TInstantSQLBroker.EnsureResolver(
- AMap: TInstantAttributeMap): TInstantCustomResolver;
-begin
- Result := FindResolver(AMap);
- if not Assigned(Result) then
- begin
- Result := CreateResolver(AMap);
- ResolverList.Add(Result)
- end;
-end;
-
-function TInstantSQLBroker.FindResolver(
- AMap: TInstantAttributeMap): TInstantSQLResolver;
-var
- I: Integer;
-begin
- for I := 0 to Pred(ResolverCount) do
- begin
- Result := Resolvers[I];
- if Result.Map = AMap then
- Exit;
- end;
- Result := nil;
-end;
-
-class function TInstantSQLBroker.GeneratorClass: TInstantSQLGeneratorClass;
-begin
- Result := TInstantSQLGenerator;
-end;
-
-function TInstantSQLBroker.GetGenerator: TInstantSQLGenerator;
-begin
- if not Assigned(FGenerator) then
- FGenerator := GeneratorClass.Create(Self);
- Result := FGenerator;
-end;
-
-function TInstantSQLBroker.GetResolverCount: Integer;
-begin
- Result := ResolverList.Count;
-end;
-
-function TInstantSQLBroker.GetResolverList: TObjectList;
-begin
- if not Assigned(FResolverList) then
- FResolverList := TObjectList.Create;
- Result := FResolverList;
-end;
-
-function TInstantSQLBroker.GetResolvers(
- Index: Integer): TInstantSQLResolver;
-begin
- Result := ResolverList[Index] as TInstantSQLResolver;
-end;
-
-procedure TInstantSQLBroker.InternalBuildDatabase(Scheme: TInstantScheme);
-var
- I, J: Integer;
- TableMetadata: TInstantTableMetadata;
- IndexMetadata: TInstantIndexMetadata;
-begin
- if not Assigned(Scheme) then
- Exit;
- with Scheme do
- begin
- for I := 0 to Pred(TableMetadataCount) do
- begin
- TableMetadata := TableMetadatas[I];
- try
- Execute(Generator.GenerateDropTableSQL(TableMetadata));
- except
- end;
- Execute(Generator.GenerateCreateTableSQL(TableMetadata));
- with TableMetadata do
- begin
- for J := 0 to Pred(IndexMetadatas.Count) do
- begin
- IndexMetadata := IndexMetadatas[J];
- if not (ixPrimary in IndexMetadata.Options) then
- Execute(Generator.GenerateCreateIndexSQL(IndexMetadata));
- end;
- end;
- end;
- end;
-end;
-
-procedure TInstantSQLBroker.ReleaseDataSet(const ADataSet: TDataSet);
-begin
- if FStatementCacheCapacity <> 0 then
- ADataSet.Close
- else
- ADataSet.Free;
-end;
-
-{ TInstantRelationalConnector }
-
-procedure TInstantRelationalConnector.DoGetDataSet(const CommandText: string;
- var DataSet: TDataSet);
-begin
- if Assigned(FOnGetDataSet) then
- FOnGetDataSet(Self, CommandText, DataSet)
- else
- GetDataSet(CommandText, DataSet);
-end;
-
-procedure TInstantRelationalConnector.DoInitDataSet(
- const CommandText: string; DataSet: TDataSet);
-begin
- if Assigned(FOnInitDataSet) then
- FOnInitDataSet(Self, CommandText, DataSet)
- else
- InitDataSet(CommandText, DataSet);
-end;
-
-function TInstantRelationalConnector.GetBroker: TInstantCustomRelationalBroker;
-begin
- Result := inherited Broker as TInstantCustomRelationalBroker;
-end;
-
-procedure TInstantRelationalConnector.GetDataSet(const CommandText: string;
- var DataSet: TDataSet);
-begin
-end;
-
-function TInstantRelationalConnector.GetDBMSName: string;
-begin
- Result := Broker.DBMSName;
-end;
-
-procedure TInstantRelationalConnector.InitDataSet(const CommandText: string;
- DataSet: TDataSet);
-begin
-end;
-
-function TInstantRelationalConnector.InternalCreateScheme(
- Model: TInstantModel): TInstantScheme;
-begin
- Result := TInstantScheme.Create;
- try
- Result.IdDataType := IdDataType;
- Result.IdSize := IdSize;
- Result.BlobStreamFormat := BlobStreamFormat;
- Result.Catalog := TInstantModelCatalog.Create(Result, Model);
- except
- FreeAndNil(Result);
- raise;
- end;
-end;
-
-constructor TInstantConnectionBasedConnector.Create(AOwner: TComponent);
-begin
- inherited;
- FLoginPrompt := True;
-end;
-
-{ TInstantConnectionBasedConnector }
-
-procedure TInstantConnectionBasedConnector.AfterConnectionChange;
-begin
-end;
-
-procedure TInstantConnectionBasedConnector.AssignLoginOptions;
-begin
- if HasConnection then
- begin
- FConnection.LoginPrompt := FLoginPrompt;
- end;
-end;
-
-procedure TInstantConnectionBasedConnector.BeforeConnectionChange;
-begin
-end;
-
-procedure TInstantConnectionBasedConnector.CheckConnection;
-begin
- InstantCheckConnection(FConnection);
-end;
-
-procedure TInstantConnectionBasedConnector.DoAfterConnectionChange;
-begin
- if Assigned(FConnection) then
- FConnection.FreeNotification(Self);
- AfterConnectionChange;
-end;
-
-procedure TInstantConnectionBasedConnector.DoBeforeConnectionChange;
-begin
- try
- BeforeConnectionChange;
- finally
- if Assigned(FConnection) then
- FConnection.RemoveFreeNotification(Self);
- end;
-end;
-
-function TInstantConnectionBasedConnector.GetConnected: Boolean;
-begin
- if HasConnection then
- Result := Connection.Connected
- else
- Result := inherited GetConnected;
-end;
-
-function TInstantConnectionBasedConnector.GetConnection: TCustomConnection;
-begin
- if not (csDesigning in ComponentSt...
[truncated message content] |
